VB 将长路径转为短路径 & 获取剪粘板中的文件的列表

来源：互联网发布：编程思想有哪些编辑：程序博客网时间：2024/06/06 08:57

将长路径转为短路径

Private Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
Private Function ShortPath(ByVal FileName As String) As String
Dim S As String
On Error GoTo exitFunc:
S = String(255, " ")
GetShortPathName FileName, S, 255
ShortPath = Left(S, InStr(S, Chr(0)) - 1)
exitFunc:
End Function

获取剪粘板中的图片文件的列表

Private Const CF_HDROP = 15

Private Type POINT
          x   As Long
          y   As Long
End Type

Private Type DROPFILES
          pFiles   As Long
          pt   As POINT
          fNC   As Long
          fWide   As Long
End Type

Private Declare Function GlobalSize Lib "kernel32" _
        (ByVal hMem As Long) As Long
Private Declare Function GlobalLock Lib "kernel32" _
        (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32" _
        (ByVal hMem As Long) As Long

Private Declare Function OpenClipboard Lib "user32" _
        (ByVal hwnd As Long) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function GetClipboardData Lib "user32" _
        (ByVal wFormat As Long) As Long

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
        (Destination As Any, Source As Any, ByVal Length As Long)

Public mvarfilelist As String

Public Function ShowFilesOnClipboard() As String
        Dim lHandle     As Long
        Dim lpResults     As Long
        Dim lRet     As Long
        Dim df     As DROPFILES
        Dim strDest     As String
        Dim lBufferSize     As Long
        Dim arBuffer()     As Byte
        Dim vNames     As Variant
        Dim i     As Long
        ShowFilesOnClipboard = ""

        If OpenClipboard(0) Then
              lHandle = GetClipboardData(CF_HDROP)
              '   If   you   don't   find   a   CF_HDROP,   you   don't   want   to   process   anything
              If lHandle > 0 Then
                    lpResults = GlobalLock(lHandle)

                    lBufferSize = GlobalSize(lpResults)
                    ReDim arBuffer(0 To lBufferSize)

                    CopyMemory df, ByVal lpResults, Len(df)
                    Call CopyMemory(arBuffer(0), ByVal lpResults + df.pFiles, _
                                                    (lBufferSize - Len(df)))

                    If df.fWide = 1 Then
                          '   it   is   wide   chars--unicode
                          strDest = arBuffer
                    Else
                          strDest = StrConv(arBuffer, vbUnicode)
                    End If
                    GlobalUnlock lHandle
                    vNames = Split(strDest, vbNullChar)
                    i = 0
                    While Len(vNames(i)) > 0
                          ShowFilesOnClipboard = ShowFilesOnClipboard & "<img src='file:///" & ShortPath(vNames(i)) & "'><br>"
                          i = i + 1
                    Wend
              End If
        End If
        CloseClipboard
End Function