Results 1 to 1 of 1

Thread: [VB6] Virtual File Drag Drop

  1. #1

    Thread Starter
    Join Date
    Jul 2010

    Lightbulb [VB6] Virtual File Drag Drop

    Virtual File DragDrop Demo 1.0

    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 supply 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!

    -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)

    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 too SHCreateDataObject:
    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:
    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)
        Set ppenumFormatEtc = Nothing
        EnumFormatEtcVB = E_NOTIMPL
    End If
    End Function
    For single files, returning the CFSTR_FILEGROUPDESCRIPTOR is straightfoward:
        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
                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.
            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
    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.
    Attached Files Attached Files

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts


Click Here to Expand Forum to Full Width