[VB6] API File Drag from multiple paths w/o native OLE or dragsource, SHDoDragDrop

[fafalone]

API File Dragging


Project Updated to Revision 3 on May 5th, 2020

It took many months of wasting hours, giving up, and revisiting to finally get a working solution, and the only previous VB solution was monstrously complex. I understand very few people will find this useful, but wanted to share anyway due to the lack of answers I found while trying to get it working and the simplicity over other solutions.

NEW: A NOTE ON DRAG IMAGES
The project hasn't been updated, but I wanted to add on some new information about the drag image. As you may have noted, multiple files just have the number without the icon unless you drag over certain apps, and the modern drag image doesn't show at all in the source control. These are both caused by the same thing: a modern drag source like ours is also supposed to use the latest drop target functionality. If you register your control as a drop target with the modern methods (see this project), the 100%-identical-to-Explorer image for multiple files will show from the start now and carry over to Explorer. You don't need to actually allow drop functionality; a registered drop target whose effect is DROP_EFFECT_NONE is just as good.

Background
DragDrop functionality is easy if you're using, say, VB's ListView, but what if you're using a ListView created via CreateWindowEx that has no OLEStartDrag/OLESetData with pre-provided DataObject, and want to start a drag operation that can be dragged around Windows Explorer (or any drop target accepting dropped files)? Previous solutions have used the DoDragDrop API and then had to implement their own IDataObject and IDropSource interfaces, and I had yet to see one that supported multiple paths. Turns out that unless you require other-than-default behavior, you accomplish a full drag-to-explorer operation in just a few lines of code. The SHDoDragDrop API provides both a default drag source and a default drag icon showing the number of files, just like Explorer. It also supports the action options menu if you drag with the right button. And no further action is required, the receiving program handles the operation.

The included sample project doesn't use any subclassed/CreateWindowEx ListViews, but does show how you can initiate the operation from any arbitary point in code given a list of files.

This project originally used an API to create the IDataObject. The latest version uses a far superior method, but it requires Windows Vista or newer. If you need to retain Windows XP support, you can use the legacy method with an undocumented API. Simply replace the 2 IShellItemArray lines with a call to this API:

Public Declare Function SHCreateFileDataObject Lib "shell32" Alias "#740" (ByVal pidlFolder As Long, ByVal cidl As Long, ByVal apidl As Long, pDataInner As Any, ppDataObj As oleexp.IDataObject) As Long

Call SHCreateFileDataObject(VarPtr(0&), cpidl, VarPtr(apidl(0)), ByVal 0&, iData)

Also see below for voxy's post on how to add even more formats manually by using the IDataObject.SetData method.

Requirements
Windows Vista or newer. If you replace the IDataObject creation method with the legacy method posted above, Windows XP or newer.
Attached project references oleexp.tlb v4.0 or higher. The legacy method requires only one of the several typelibs that include an IDataObject definition.

For the purposes of the below code, we'll assume you have your own routine to enumerate the full paths of the files that are selected. This code will typically be for a Begin Drag notification, such as LVN_BEGINDRAG.

Public Sub InitDrag(sSelFullPath() As String)
Dim hr0 As Long
Dim iData As IDataObject
Dim psia As IShellItemArray
Dim apidl() As Long
Dim cpidl As Long
Dim rpidl As Long
Dim pidlDesk As Long
Dim lRetDD As Long
Dim i As Long
Dim AllowedEffects As DROPEFFECTS

'EnumSelectedFiles - Whatever routine you have to get your selected files list, a standard routine like
'  Do
'     i = ListView_GetNextItem(hLVS, i, LVNI_SELECTED)
'     If (i <> LVI_NOITEM) Then
ReDim apidl(UBound(sSelFullPath)) 'sSelFullPath would then contain the full path to the file, C:\folder\file.ext, //Computer/folder/file.ext
For i = 0 To UBound(apidl)
       apidl(i) = GetPIDLFromPathW(sSelFullPath(i)) 'support function to return fully qualified pidls for each file, see below
Next i
cpidl = UBound(apidl) + 1

oleexp.SHCreateShellItemArrayFromIDLists cpidl, VarPtr(apidl(0)), psia
If psia Is Nothing Then
    Debug.Print "Failed to create IShellItemArray"
    Exit Sub
End If

psia.BindToHandler 0&, BHID_DataObject, IID_IDataObject, iData
If iData Is Nothing Then
    Debug.Print "Failed to created IDataObject"
    Exit Sub
End If
            
AllowedEffects = DROPEFFECT_COPY Or DROPEFFECT_MOVE Or DROPEFFECT_LINK

hr0 = SHDoDragDrop(0&, ObjPtr(iData), 0, AllowedEffects, lRetDD) 'theoretically you can supply your own IDropSource implementation, but I never got it working

Debug.Print "hr0=" & hr0 & ",lRet=" & lRetDD 'hr0 contains the HRESULT of the call, and lRetDD is the result of the operation, see the full DROPEFFECT description for all possible values
Call CoTaskMemFree(pidlDesk)
For i = 0 To UBound(apidl)
    Call CoTaskMemFree(apidl(i))
Next i
Set iData = Nothing

End Sub
'If instead this is in a WndProc, you'll probably want to cancel the notification by returning 1 and exiting before a DefWndProc call.

'Supporting declares and functions:
Public Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long) ' Frees memory allocated by the shell
Public Declare Function SHDoDragDrop Lib "shell32" (ByVal hWnd As Long, ByVal pdtObj As Long, ByVal pdsrc As Long, ByVal dwEffect As Long, pdwEffect As Long) As Long
Public Declare Function ILCreateFromPathW Lib "shell32" (ByVal pwszPath As Long) As Long
Public Function GetPIDLFromPathW(sPath As String) As Long
   GetPIDLFromPathW = ILCreateFromPathW(StrPtr(sPath))
End Function
Public Function IID_IDataObject() As UUID
'0000010e-0000-0000-C000-000000000046
Static IID As UUID
 If (IID.Data1 = 0) Then Call DEFINE_UUID(IID, &H10E, CInt(&H0), CInt(&H0), &HC0, &H0, &H0, &H0, &H0, &H0, &H0, &H46)
  IID_IDataObject = IID
End Function
Public Function BHID_DataObject() As UUID
'{0xB8C0BD9F, 0xED24, 0x455C, 0x83,0xE6, 0xD5,0x39,0x0C,0x4F,0xE8,0xC4}
Static iid As UUID
 If (iid.Data1 = 0) Then Call DEFINE_UUID(iid, &HB8C0BD9F, &HED24, &H455C, &H83, &HE6, &HD5, &H39, &HC, &H4F, &HE8, &HC4)
 BHID_DataObject = iid
End Function
Public Sub DEFINE_UUID(Name As UUID, l As Long, w1 As Integer, w2 As Integer, B0 As Byte, b1 As Byte, b2 As Byte, B3 As Byte, b4 As Byte, b5 As Byte, b6 As Byte, b7 As Byte)
  With Name
    .Data1 = l
    .Data2 = w1
    .Data3 = w2
    .Data4(0) = B0
    .Data4(1) = b1
    .Data4(2) = b2
    .Data4(3) = B3
    .Data4(4) = b4
    .Data4(5) = b5
    .Data4(6) = b6
    .Data4(7) = b7
  End With
End Sub

If you want to, you can specify your own drag image. For XP, see http://www.mvps.org/emorcillo/en/cod...ropimage.shtml
For Vista+, after you've created your IDataObject but before calling SHDoDragDrop, use this code:

Dim idsh As IDragSourceHelper2
Set idsh = New DragDropHelper

If hDragThumbnail Then
    Dim sdi As SHDRAGIMAGE
    sdi.hbmpDragImage = hBitmap
    sdi.sizeDragImage.cx = width
    sdi.sizeDragImage.cy = height
    sdi.ptOffset.X = 24
    sdi.ptOffset.Y = 24
    sdi.crColorKey = CLR_NONE
    
    idsh.SetFlags DSH_ALLOWDROPDESCRIPTIONTEXT
    idsh.InitializeFromBitmap sdi, iData
End If

You can get the HBITMAP any number of ways. For example, if you wanted to get it from an image file, you could do:

Dim pFact As IShellItemImageFactory

oleexp.SHCreateItemFromParsingName StrPtr(PathToThumbnailFile), Nothing, IID_IShellItemImageFactory, pFact
pFact.GetImage width, height, SIIGBF_THUMBNAILONLY, hBitmap

UPDATE: Since I posted this project 5 years ago, I've found a more stable way to create the IDataObject. You shouldn't be using SHCreateDataObject or SHCreateFileDataObject.
Instead, once you have your array of pidls, use the function SHCreateShellItemArrayFromIDLists. That creates an IShellItemArray object, and once you have that object, you can use its method BindToHandler to create the IDataObject with ShellItemArray.BindToHandler 0&, BHID_DataObject, IID_IDataObject, iData. Note that olelib and OLEGuids do not contain IShellItemArray, so you'd need oleexp (and Vista+).

I've updated the attached project and code in this post to use this new method.