1 Attachment(s)
[VB6] Virtual File Drag Drop
About Project
This project started its life as an answer to a question in Dragging Virtual Files in VB6, and it caught my interest so it expanded into a working demo, then the scope kept increasing until it got to where it's worth being a full fledged Code Bank project.
Normal drag drop operations either require that the file exists in a normal folder already, or that the entire data to be dropped is placed in the IDataObject when it's created. If the file does not exist in the file system, and/or the data will take a long time to put together, it's desirable to only read the data when it has been dropped and another application, e.g. Explorer, requests the data. This is accomplished by using the CFSTR_FILEGROUPDESCRIPTOR and CFSTR_FILECONTENTS formats. CFSTR_FILECONTENTS can be generated entirely when IDataObject.GetData is called.
Now the normal way to do this, is to entirely implement IDataObject in a class, but for some reason most VB versions do not wind up working with the dragdrop APIs. So a trick is used to get around this; Windows can be forced into providing a nearly empty IDataObject, on which we can then use SwapVtableEntry for QueryGetData and GetData. Also swapping EnumFormatEtc allows us to show only our data types, and not the empty/invalid relics from the creation API (not that those impact anything).
Then the rest is simply a matter of correctly supplying the formats and data. Well, it turns out 'simply' doesn't quite describe it, especially for multiple files. VB does not play nice with variable arrays of user types in a user type, so the normal method for a single file is shown, then for multiple files building the entire thing in a byte array-- thanks to JonathanHunt for that method. To supply the data in response to a CFSTR_FILECONTENTS request, three different methods (and a partial template for a 4th) are included. Make sure to read notes when switching between them (in GetDataVB).
The method that looks the most powerful is the one enabled by default, and then also built into that method is a custom progress window routine, since the built-in one that uses FD_PROGRESSUI only updates in a per-file increment (so if it's 1 file it never even moves). The custom routine writes in 4kb chunks so progress can be displayed.
That covers the basics, be sure to read the various notes in the project, this is fairly complex stuff!
Requirements
-Windows Vista or newer (the basic concept works on XP, a rewrite to remove some Vista extras may be possible)
-oleexp.tlb (any version) (original olelib might work, though additional declares may be needed)
Concepts
Here's some sections of code that demonstrate the basic idea behind these techniques. These cannot be copied/pasted, the rest of the project is required. Please download the whole thing, these are just snippets.
Generating an IDataObject to use without having to Implement one in a class, by passing all null to SHCreateDataObject:
Code:
SetFmtEtc 1, TYMED_HGLOBAL 'Use IStream when using Methods 2a and 2b in GetDataVB
'Use hGlobal when using Method 1
Call SHCreateDataObject(0&, 0&, 0&, ByVal 0&, IID_IDataObject, pDataObj)
m_pOldGetData = SwapVtableEntry(ObjPtr(pDataObj), 4, AddressOf GetDataVB)
m_pOldQueryGetData = SwapVtableEntry(ObjPtr(pDataObj), 6, AddressOf QueryGetDataVB)
m_pOldEnumFormatEtc = SwapVtableEntry(ObjPtr(pDataObj), 9, AddressOf EnumFormatEtcVB)
hr = SHDoDragDrop(Me.hwnd, ObjPtr(pDataObj), 0&, DROPEFFECT_COPY, lp)
m_pOldGetData = SwapVtableEntry(ObjPtr(pDataObj), 4, m_pOldGetData)
m_pOldQueryGetData = SwapVtableEntry(ObjPtr(pDataObj), 6, m_pOldQueryGetData)
m_pOldEnumFormatEtc = SwapVtableEntry(ObjPtr(pDataObj), 9, m_pOldEnumFormatEtc)
Normally SwapVtableEntry is used in class modules that implement an interface, but it turns out it works equally well in this situation.
Controlling the formats listed as available, overriding the strays from SHCreateDataObject:
Code:
Public Sub SetFmtEtc(nFiles As Long, Optional ContentTymed As TYMED = TYMED_HGLOBAL)
Dim i As Long
ReDim arFmtEtc(nFiles)
arFmtEtc(0).cfFormat = CF_FILEGROUPDESCRIPTORW
arFmtEtc(0).dwAspect = DVASPECT_CONTENT
arFmtEtc(0).lindex = -1&
arFmtEtc(0).TYMED = TYMED_HGLOBAL
For i = 1 To nFiles
ReDim Preserve arFmtEtc(i)
arFmtEtc(i).cfFormat = CF_FILECONTENTS
arFmtEtc(i).dwAspect = DVASPECT_CONTENT
arFmtEtc(i).lindex = i - 1
arFmtEtc(i).TYMED = ContentTymed
Next i
End Sub
Public Function EnumFormatEtcVB(ByVal this As IDataObject, ByVal dwDirection As DATADIR, ppenumFormatEtc As IEnumFORMATETC) As Long
Debug.Print "EnumFormatEtcVB.Entry"
If dwDirection = DATADIR_GET Then
EnumFormatEtcVB = SHCreateStdEnumFmtEtc(UBound(arFmtEtc) + 1, VarPtr(arFmtEtc(0)), ppenumFormatEtc)
Else
Set ppenumFormatEtc = Nothing
EnumFormatEtcVB = E_NOTIMPL
End If
End Function
For single files, returning the CFSTR_FILEGROUPDESCRIPTOR is straightfoward:
Code:
ZeroMemory pmedium, LenB(pmedium)
If ((pformatetcIn.cfFormat) = CF_FILEGROUPDESCRIPTORW) And _
(pformatetcIn.dwAspect = DVASPECT_CONTENT) And _
(pformatetcIn.TYMED = TYMED_HGLOBAL) Then
Debug.Print "CF_FILEGROUPDESCRIPTORW Requested, idx=" & pformatetcIn.lindex
'This is the standard approach to drag a single file.
'Since the .fgd array is fixed at 1 element, and fixed dimensions work, we
'can use the normal FILEGROUPDESCRIPTORW type
Dim tFGD As FILEGROUPDESCRIPTORW
ZeroMemory tFGD, LenB(tFGD)
tFGD.cItems = 1&
tFGD.fgd(0).dwFlags = FD_UNICODE Or FD_FILESIZE 'Or FD_PROGRESSUI 'NOTE: The native progress UI will only update between multiple
' files, not within a single file as its written. If you do
' use this, do not also use the ProgressWindow class.
With FilesToDrag(0)
tFGD.fgd(0).nFileSizeLow = UBound(.btContents) + 1 'NOTE: When you change the source of the file make sure to set the size
' here; setting the size allows a progress bar.
'There's other items you can set, like attributes or a date stamp (to preserve an original; when omitted uses Now
'Attributes use the FILE_ATTRIBUTES enum, eg:
'tFGD.fgd(0).dwFlags = tFGD.fgd(0).dwFlags Or FD_ATTRIBUTES
'tFGD.fgd(0).dwFileAttributes = FILE_ATTRIBUTE_READONLY
End With
hGlobal = GlobalAlloc(GMEM_MOVEABLE, LenB(tFGD))
If hGlobal Then
lpGlobal = GlobalLock(hGlobal)
CopyMemory ByVal lpGlobal, tFGD, LenB(tFGD)
Call GlobalUnlock(hGlobal)
pmedium.TYMED = TYMED_HGLOBAL
pmedium.Data = lpGlobal
GetDataVB = S_OK
End If
Lastly, returning data when GetDataVB is called for CFSTR_FILECONTENTS. This is the simple one with IStream, the default in the project uses the more powerful one with the chunks/progress setup.
Code:
If (pformatetcIn.lindex >= 0&) And (pformatetcIn.lindex < nFiles) Then
hGlobal = GlobalAlloc(GMEM_MOVEABLE, UBound(FilesToDrag(pformatetcIn.lindex).btContents) + 1)
If hGlobal Then
lpGlobal = GlobalLock(hGlobal)
CopyMemory ByVal lpGlobal, FilesToDrag(pformatetcIn.lindex).btContents(0), UBound(FilesToDrag(pformatetcIn.lindex).btContents) + 1
Call GlobalUnlock(hGlobal)
hr = CreateStreamOnHGlobal(ByVal hGlobal, 1&, pStrm)
Debug.Print "CreateStreamOnHGlobal=0x" & Hex$(hr)
pStrm.Seek CCur(0), STREAM_SEEK_END
pmedium.TYMED = TYMED_ISTREAM
pmedium.Data = ObjPtr(pStrm)
CopyMemory pStrm, 0&, 4&
GetDataVB = S_OK
End If
End If
Bonus
More detailed control may be possible with a custom class that implements IStream manually. I found a template for this as MemoryStream.cls from vbAccelerator's GDI+ wrapper project, so the class is included in the zip but not yet included in the project.
Special Thanks
Thanks to JonathanHunt, who got this whole ball rolling, and supplied the method to build a multi-file descriptor in a byte array.
Thanks to Olaf (Schmidt) for showing me how to release an IStream such that the compiled exe no longer crashed when releasing it.
-----
twinBASIC 64bit compatible version at https://github.com/fafalone/MiscDemos
Re: [VB6] Virtual File Drag Drop
Thanks a much for your work!
Is any of above methods able to prepare "virtual" file in clipboard in a way allowing to paste it via Context menu -> "Paste" operation manually instead of "Drag & Drop"?
Re: [VB6] Virtual File Drag Drop
Sorry for the delay in my reply, have been on a hiatus from all computer related things.
And, yes there is! I've never posted the new version of the demo with it, but I did add such a thing, instead of calling SHDoDragDrop to do a drag, you simply use the OleSetClipboard API with the IDataObject instead. In the demo, it would be:
Code:
Dim hr As Long
Dim lp As DROPEFFECTS
nFiles = CLng(Text1.Text)
GenerateTestFileData nFiles
SetFmtEtc nFiles, TYMED_ISTREAM 'Use IStream when using Methods 2a and 2b in GetDataVB, hGlobal for Method 1
'Use hGlobal when using Method 1
Call SHCreateDataObject(0&, 0&, 0&, ByVal 0&, IID_IDataObject, pDataObjF)
m_pOldGetData = SwapVtableEntry(ObjPtr(pDataObjF), 4, AddressOf GetDataVB)
m_pOldQueryGetData = SwapVtableEntry(ObjPtr(pDataObjF), 6, AddressOf QueryGetDataVB)
m_pOldEnumFormatEtc = SwapVtableEntry(ObjPtr(pDataObjF), 9, AddressOf EnumFormatEtcVB)
OleSetClipboard pDataObjF
Re: [VB6] Virtual File Drag Drop
Re: [VB6] Virtual File Drag Drop
Great post @fafalone. Do you have similar implementation in C#?
Re: [VB6] Virtual File Drag Drop
Sorry I don't; not a big fan of .NET so avoid it whenever possible. I'm sure there's some framework class somewhere that does it. But you should be able to call the APIs directly if not; it's just a question of adapting the syntax and substituting language features where appropriate-- e.g. you wouldn't need the vtableswap/function pointers because c# will let you implement a COM interface with a return value without them.
