VB程序实现文件拖放功能

1.新建一个模块,写入以下代码:

Option Explicit

Public 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
'将消息传答窗口函数

Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, _
ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
'在窗口结构中为指定的窗口设置信息

Private IPrevWndProc As Long

Private hHookWindow As Long

Public Declare Sub DragAcceptFiles Lib "shell32.dll" (ByVal hWnd As Long, ByVal fAccept As Long)
'登记窗口是否接受托动文件的内容

Public Declare Sub DragFinish Lib "shell32.dll" (ByVal hDrop As Long) '释放分配用于托动文件的内容

Public 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
'返回托动的文件名

Public Const GWL_WNDPROC = (-4)

Public Const WM_DROPFILES = &H233

Public Sub SetHook(IHwnd As Long) '设置消息接法挂钩
If hHookWindow <> 0 Then Call ClearHook '如果已经挂钩则删除当前子类挂钩
hHookWindow = IHwnd '保存拖动文件的句柄
IPrevWndProc = SetWindowLong(hHookWindow, GWL_WNDPROC, AddressOf HookCallBack) '设置与该文件挂钩
'第三个参数告诉系统程序处理消息是用哪个函数
End Sub

Public Sub ClearHook() '删除子类消息挂钩
Dim IReturn As Long
'检查保证此程序有一个当前挂钩
If hHookWindow = 0 Then Exit Sub
If IsEmpty(hHookWindow) Then Exit Sub
If IsNull(hHookWindow) Then Exit Sub
IReturn = SetWindowLong(hHookWindow, GWL_WNDPROC, IPrevWndProc) '删除挂钩
End Sub

Function HookCallBack(ByVal hWnd As Long, ByVal IMsg As Long, ByVal wParam As Long, ByVal IParam As Long) _
As Long
Select Case hWnd
Case hHookWindow '如果消息是发给应用程序主窗体
MainFrm.MessageProc IMsg, wParam, IParam
'注意此处MainFrm为窗体名称,MessageProc为该窗体自身的消息处理函数
Case Else
End Select
HookCallBack = CallWindowProc(IPrevWndProc, hWnd, IMsg, wParam, IParam)
'将消息传递给消息处理栈中的下一个进程
End Function

2.在窗体上添加一个ListBox控件,命名为lstFiles,接着拖入2个按钮,命名为cmdAction,最后写入如下代码:

Option Explicit

Private Sub cmdAction_Click(Index As Integer)
Select Case Index
Case 0
lstFiles.Clear
Case 1
End
End Select
End Sub

Private Sub Form_Load()
Call SetHook(Me.hWnd)
Call DragAcceptFiles(Me.hWnd, True)
End Sub

Private Sub Form_Terminate()
Call ClearHook
End Sub

Public Sub MessageProc(IMsg As Long, wParam As Long, IParam As Long)
Dim nDropCount As Integer
Dim nLoopCtr As Integer
Dim IReturn As Long
Dim hDrop As Long
Dim sFileName As String
Select Case IMsg
Case WM_DROPFILES
hDrop = wParam '保存拖放文件的句柄
sFileName = Space$(255)
nDropCount = DragQueryFile(hDrop, -1, sFileName, 254) 'DragQueryFile 判定多少文件已拖放在窗体中
For nLoopCtr = 0 To nDropCount - 1
sFileName = Space$(255)
IReturn = DragQueryFile(hDrop, nLoopCtr, sFileName, 254)
lstFiles.AddItem Left$(sFileName, IReturn)
Next
Call DragFinish(hDrop) '释放内部拖放文件事件的句柄
End Select
End Sub

最后允许程序,就可以看到把其他程序拖入本程序,程序就能获得其绝对路径了.