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

最新推荐文章于 2019-08-21 01:02:02 发布

原创最新推荐文章于 2019-08-21 01:02:02 发布 · 1.7k 阅读

0 ·

CC 4.0 BY-SA版权

文章标签：

#vb #function #string #user #byte #file

这段VB代码演示了如何将长路径转换为短路径，并展示了如何获取剪贴板中图片文件的列表。通过`GetShortPathName`函数实现长路径转短路径，通过处理CF_HDROP格式的剪贴板数据来获取文件列表。

摘要生成于 C知道，由 DeepSeek-R1 满血版支持，前往体验 >

将长路径转为短路径

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