Friday, December 15, 2006

Drag 'n Drop Files from explorer to VB

This piece of code allows to make programs in Visual Basic 6, to have a drag and drop support of files directly from the folders. This is an alternative to the old File Open mechanism. This is way cooler...Code tested on Windows XP and on Visual Basic 6. Any information about other versions of windows or vb? Leave a comment...

Download the code from planet source code.

The Code
The main part of the code is the module, here is the module code:

Private Const WM_DROPFILES = &H233
'&H233 is the windows message id for the drop files message.
'It is the value of the uMsg parameter in the window procedure call.

Private Const GWL_WNDPROC = (-4)
'The index parameter to the SetWindowLong function
'that specifies to change a windows message handler procedure.

Private Declare Sub DragAcceptFiles Lib "shell32.dll" _
(ByVal hwnd As Long, ByVal fAccept As Long)
'DragAcceptFiles enables or disables a form or window to accept files.
'fAccept = 1 Enables.

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
'DragQueryFile gives the information to us about the dropped file.
'lpStr outputs the filename.

Private Declare Sub DragFinish Lib "shell32.dll" _
(ByVal HDROP As Long)
'This function frees the resources used during the drag operation

Private PrevProc As Long
'Variable to store the address of the default window procedure

Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
(ByVal hwnd As Long, ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long

Private 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

Private Function HookForm(ByVal hwnd As Long)
PrevProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf WindowProc)
'Setting our new windowProc function, now all message to window goes through WindowProc.
'Return value is the address of the previous function. ie,
'the AddressOf default window proc function

End Function
'Our Custom WindowProc Function
Private Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If uMsg = WM_DROPFILES Then 'If we have got a drop
Dropped wParam 'wparam stores the Hdrop handle
End If
WindowProc = CallWindowProc(PrevProc, hwnd, uMsg, wParam, lParam)
'Call the default window procedure !IMPORTANT
End Function

'Remove our default window procedure.
Private Function UnHookForm(ByVal hwnd As Long)
If PrevProc <> 0 Then
SetWindowLong hwnd, GWL_WNDPROC, PrevProc
PrevProc = 0
End If
End Function

''' interface api '''
Public Sub EnableDragDrop(ByVal hwnd As Long)
DragAcceptFiles hwnd, 1
HookForm (hwnd)
End Sub

Public Sub DisableDragDrop(ByVal hwnd As Long)
DragAcceptFiles hwnd, 0
UnHookForm hwnd
End Sub

Public Sub Dropped(ByVal HDROP As Long)
Dim strFilename As String * 511
Call DragQueryFile(HDROP, 0, strFilename, 511) 'Get the filename.

'!! replace with your function below ....
Form1.GotADrop (strFilename)
End Sub

... and here is the form code ...

Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
(ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _
ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Private Sub Command1_Click()
ShellExecute Me.hwnd, "", "", "", "", 1
End Sub

Private Sub Form_Load()
EnableDragDrop Me.hwnd
End Sub

Public Sub GotADrop(ByVal strfile As String)
Label1.Caption = strfile
End Sub

Private Sub Form_Unload(Cancel As Integer)
DisableDragDrop Me.hwnd
End Sub

Thats all folks
Enjoy drag 'n drop...


Anonymous said...

Some time back I was looking for this, now I just happen to run into it. Thanks, great bit of code! Happy to see Visual Basic 6 hasn't died yet. :)

Anonymous said...

Hey... nice one

But I have a strange problem.
I have edited the code, and I got an compile error. I pressed the debug button, but I was enable to edit the code. If I press END, the VB6 ends, without even saving the project

Arun Prabhakar said...

Please mention which part of the code you changed...

Only then I can suggest what went wrong ...

Anonymous said...

Why not simply OLEDragDrop? Most of the controls that we may use to show the File/Folder name (such as Text box) support this method. So ...

txtFileName.Text = Data.Files(1)

That's it! Why so much of API work?

By the way, can you please write a code that will demonstrate how to make the VB control as Drag source for Windows Explorer? I mean how to make the Drag-n-Drop from VB to Explorer?

So, for example, I have listed all files in a specific folder in ListView control. Now I open a folder from My Computer etc. etc. then I drag the Listview item into that folder, can you write a code that will notify the VB application which Folder its dragged to? This will help me to simply write a FileCopy code accompanied with Kill to emulate Move file from one folder to another via my VB application. Please let me know your opinion on this.



Anonymous said...

I tried to change the code so I could drop files on a textbox and not only the whole frame in order to have multiple filepaths displayed, but VB always crashes when I try to drop something. Does this only work on frames?

Anon: Could you explain that a bit more? "txtFileName.Text = Data.Files(1)" doesn't really help me.. at all.

Murad said...

This is really a great solutions. It runs fine in XP, and bit strugling in windows 7.

In Windows 7 when I ran the application as an admin it didnt work but when I ran the application with out admin prevs it worked. Could you please help me how to solve this issue.