vbcad 发表于 2017-9-16 23:47:37

获得剪贴板中的文件列表（源码）

Private Declare Function OpenClipboard Lib "USER32" (ByVal hWnd As Long) As Long
Private Declare Function CloseClipboard Lib "USER32" () As Long
Private Declare Function IsClipboardFormatAvailable Lib "USER32" (ByVal wFormat As Long) As Long
Private Declare Function GetClipboardData Lib "USER32" (ByVal wFormat As Long) As Long
'Private Declare Function AbortDoc Lib "gdi32" (ByVal hdc As Long) As Long
'Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
'Private Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long
'Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
'Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function DragQueryFile Lib "shell32.dll" Alias "DragQueryFileA" (ByVal hDrop As Long, ByVal UINT As Long, ByVal lpStr As String, ByVal ch As Long) As Long
'Private Const CF_UNICODETEXT = 13
Private Const CF_HDROP = 15
Private Const MAX_PATH = 260
'Function getClipboardText() As String
'获得剪贴板中的文本
'    Dim lpData As Long
'    Dim nSize As Long
'    Dim hMem As Long
'    Dim s As String
'
'    OpenClipboard ByVal 0&
'    If IsClipboardFormatAvailable(CF_UNICODETEXT) Then
'      hMem = GetClipboardData(CF_UNICODETEXT)
'      lpData = GlobalLock(hMem)
'      nSize = GlobalSize(hMem)
'      s = String(nSize, 0)
'      CopyMemory ByVal StrPtr(s), ByVal lpData, ByVal nSize
'      GlobalUnlock hMem
'      getClipboardText = Left(s, InStr(s, Chr(0)) - 1)
'    End If
'    CloseClipboard
'End Function

Public Function GetClipboardFile() As String()
Dim hDrop As Long
Dim iFile As Long, sFiles() As String
Dim sBuff As String * MAX_PATH
Dim iPos As Long
ReDim sFiles(0)
'sBuff = String$(MAX_PATH, 0) '260,0
Call OpenClipboard(ByVal 0&) '打开剪贴板
If IsClipboardFormatAvailable(CF_HDROP) Then '如果剪贴板内容是文件
    hDrop = GetClipboardData(CF_HDROP) '获得句柄
    If Not hDrop = 0 Then '如果成功
       iFileCount = DragQueryFile(hDrop, -1&, "", 0) '文件数量

       If (iFileCount > 0) Then
          ReDim sFiles(1 To iFileCount) As String

          For iFile = 1 To iFileCount
             DragQueryFile hDrop, iFile - 1, sBuff, MAX_PATH
             iPos = InStr(sBuff, vbNullChar)
             If (iPos <> 0) Then
                sFiles(iFile) = Left$(sBuff, iPos - 1)
             Else
                sFiles(iFile) = sBuff
             End If
          Next

       End If
    End If
End If
CloseClipboard '关闭
GetClipboardFile = sFiles
End Function

liwen888888 发表于 2017-9-17 08:12:19

学习了，谢谢分享
页: [1]
查看完整版本: 获得剪贴板中的文件列表（源码）