Private Sub Form_Load()
'Subclass this form
HookForm Me
'Register this form as a Clipboardviewer
SetClipboardViewer Me.hwnd
End Sub
Private Sub Form_Unload(Cancel As Integer)
'Unhook the form
UnHookForm Me
End Sub
然后在工程中添加一个模块,在其中加入以下代码:
Private Type POINTAPI
x As Long
y As Long
End Type
Private Type SHFILEOPSTRUCT
hwnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAnyOperationsAborted As Long
hNameMappings As Long
lpszProgressTitle As String
End Type
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Declare Function SetClipboardViewer Lib "user32" (ByVal hwnd As Long) As Long
Declare Function IsClipboardFormatAvailable Lib "user32" (ByVal wFormat As Long) As Long
Declare Function CloseClipboard Lib "user32" () As Long
Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) _
As Long
Declare Function GlobalAlloc Lib "kernel32" ( _
ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Declare Function SetClipboardData Lib "user32" ( _
ByVal wFormat As Long, ByVal hMem As Long) As Long
Declare Function EmptyClipboard Lib "user32" () As Long
Declare Function RegisterClipboardFormat Lib "user32" Alias _
"RegisterClipboardFormatA" (ByVal lpString As String) As Long
Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) _
As Long
Declare Function GlobalUnlock Lib "kernel32" ( _
ByVal hMem As Long) As Long
Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
pDest As Any, pSource As Any, ByVal cbLength As Long)
Declare Function GetClipboardData Lib "user32" ( _
ByVal wFormat As Long) As Long
Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" ( _
ByVal lpData As Long) As Long
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 Declare Function DragQueryPoint Lib "shell32.dll" (ByVal _
hDrop As Long, lpPoint As POINTAPI) As Long
Public Const WM_DRAWCLIPBOARD = &H308
Public Const GWL_WNDPROC = (-4)
Dim PrevProc As Long
Const CF_HDROP = 15
Const MAX_PATH As Long = 260
Public Sub HookForm(F As Form)
PrevProc = SetWindowLong(F.hwnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub
Public Sub UnHookForm(F As Form)
SetWindowLong F.hwnd, GWL_WNDPROC, PrevProc
End Sub
Private Function TrimNull(ByVal StrIn As String) As String
Dim nul As Long
nul = InStr(StrIn, vbNullChar)
Select Case nul
Case Is > 1
TrimNull = Left(StrIn, nul - 1)
Case 1
TrimNull = ""
Case 0
TrimNull = Trim(StrIn)
End Select
End Function
Public Function GetFileClipboard() As String
Dim sData As String
Dim hDrop As Long
Dim nFiles As Long
Dim i As Long
Dim desc As String
Dim filename As String
Dim pt As POINTAPI
Dim tfStr As SHFILEOPSTRUCT
Dim Files() As String
If CBool(OpenClipboard(0)) Then
Dim hMemHandle As Long, lpData As Long
Dim nClipSize As Long
filename = Space(MAX_PATH)
For i = 0 To nFiles - 1
'根据获取的每一个文件执行文件拷贝操作
Call DragQueryFile(hDrop, i, filename, Len(filename))
Files(i) = TrimNull(filename)
strAllFile = strAllFile + Files(i)
strAllFile = strAllFile + "|"
Next i
GetFileClipboard = strAllFile
Call CloseClipboard
End If
End Function
Public Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
WindowProc = CallWindowProc(PrevProc, hwnd, uMsg, wParam, lParam)
If uMsg = WM_DRAWCLIPBOARD Then
'MsgBox "Clipboard changed ..."
If (IsClipboardFormatAvailable(CF_HDROP)) Then
Debug.Print GetFileClipboard
End If
End If
End Function