dcsimg
Results 1 to 28 of 28

Thread: Dragging Virtual Files in VB6

  1. #1

    Thread Starter
    Junior Member
    Join Date
    Apr 2009
    Posts
    22

    Dragging Virtual Files in VB6

    Hi, I have the need to write code that acts as a drag source for a virtual file. Thanks to Raymond Chen's good post on virtual file dragging (https://blogs.msdn.microsoft.com/old...8-00/?p=23083/) , I have an idea of how to approach it in C, but trying to convert that to VB6 may be a bit of a bear.

    My general approach is to Implement DataObject and then provide GetFormat and GetData functions to provide the virtual file with an HGLOBAL as he outlined, but I'm not sure this will work quite as well as I hope.

    Has anyone done this before or have any advice on my approach? If someone has been down this painful path before I'd rather leverage

    Thanks!

  2. #2
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    2,060

    Re: Dragging Virtual Files in VB6

    It really depends on what you're doing.
    Drag to where? What is the source of these virtual files? Are they represented in a shell extension already?
    It will not in fact work as well as you expect if you have to implement IDataObject yourself... I've never been able to get either major dragdrop API to work with a class implementation of IDataObject, and the only method I've seen that does work was a ridiculously complex object virtualization approach or a data handler like in JP Hamilton's shell programming book, but that was still for normal files and didn't work with DoDragDrop or SHDoDragDrop. So where's it going-- if you're not dragging out to unknown applications so need those APIs, and are just working in your own app, you could probably use one of those existing codebases. If you do need those APIs, I'd approach it by setting a temp file, letting Windows create the IDataObject for you, then using SHDoDragDrop, which doesn't require your own drop source implementation. You can add whatever formats you need to the object.

  3. #3

    Thread Starter
    Junior Member
    Join Date
    Apr 2009
    Posts
    22

    Re: Dragging Virtual Files in VB6

    Quote Originally Posted by fafalone View Post
    It really depends on what you're doing.
    So in this case, there's a hardware device (a printer) that has a virtual file system which is accessible via a custom protocol. I'm writing an explorer like interface for this device in VB6 as part of a much larger application that manages these devices. I have a list of the files stored on the printer in a listview. When the user picks one up to drag it to an explorer window, I want to offer up the filenames and sizes (which I have in the listview), but not get the actual data from the device (which is slow) until they drop it. Specifically, making FILEGROUPDESCRIPTOR available via the CFSTR_FILEDESCRIPTOR data type, and then only provide CFSTR_FILECONTENTS when that actual data is requested by explorer.

    I wasn't going to try to implement IDataObject, but rather vb6's DataObject, and hope that the maping from IDataObject correctly travels backwards if you choose to Implement that interface when I offer it up during the OleStartDrag and have a custom GetFormat and GetData to do all the work. I can't seem to find any examples of anyone doing that though, so I'm not sure it's even feasible.

  4. #4
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    2,060

    Re: Dragging Virtual Files in VB6

    In this scenario you're going to have very limited options to avoid implementing a data object yourself. I'm very confused by the method you were thinking about.... when OleStartDrag fires, you have an already-created object, and it sounds like you want to take a VB DataObject, cast it to an IDataObject (a single line call, very easy).... but then, I'm not even sure you could get the address of its functions to swap out.

    The operation you're doing is very similar to what zip/rar programs do; they don't extract until you drop, and do so very simply, using a fake CF_HDROP then producing the file on demand.

    You don't have to implement IDataObject to do this, you can use a trick I came up with to avoid that: you call SHCreateDataObject will all null parameters. Then, you'll set the HDROP to the temp file where you *will* create the file once the user drops (when your drag source is ready to send DRAGDROP_S_DROP). You do need your own drop source implementation, but that works fine in VB. It's going to take some refinement to get right, but that seems to be the basic principle this kind of operation uses.
    This also avoids having to go back and forth with a VB DataObject all together; it's a pure API operation.

    So here's some basic guidance if you want to work on it while I do, as there's all sorts of nasty hangups... you have to swap class subs for module functions, for some reason you have to use ByVal ObjPtr for the IDO but ByVal As IDRopSource for your dropsource, or VB crashes...
    cDropSource:
    Code:
    Option Explicit
    
    Implements IDropSource
    'interface IDropSource : stdole.IUnknown {
    '    HRESULT QueryContinueDrag(
    '        [in] LONG fEscapePressed,
    '        [in] LONG grfKeyState);
    '    HRESULT GiveFeedback(
    '        [in] DROPEFFECTS dwEffect);
    '}
    Private m_pOldGiveFeedback As Long
    Private m_pOldQueryContinueDrag As Long
     
    Public Sub IDropSource_QueryContinueDrag(ByVal fEscapePressed As BOOL, ByVal grfKeyState As Long) 'As Long
    'Placeholder
    End Sub
    Public Sub IDropSource_GiveFeedback(ByVal dwEffect As Long) ' As Long
    'Placeholder
    End Sub
    
    
    
    Private Sub Class_Initialize()
    'both functions need to return values
     
    
    Dim pVtable As IDropSource
    Set pVtable = Me
    
    m_pOldQueryContinueDrag = SwapVtableEntry(ObjPtr(pVtable), _
                                        4, _
                                        AddressOf QueryContinueDragVB)
    
    m_pOldGiveFeedback = SwapVtableEntry(ObjPtr(pVtable), _
                                        5, _
                                        AddressOf GiveFeedbackVB)
     
    End Sub
    
    Private Sub Class_Terminate()
    
    Dim pVtable As IDropSource
    Set pVtable = Me
    
    m_pOldQueryContinueDrag = SwapVtableEntry(ObjPtr(pVtable), _
                                        4, _
                                        m_pOldQueryContinueDrag)
    m_pOldGiveFeedback = SwapVtableEntry(ObjPtr(pVtable), _
                                        5, _
                                        m_pOldGiveFeedback)
    
    End Sub
    Then for a .bas module...
    Code:
    Public Declare Function VirtualProtect Lib "kernel32" (ByVal lpAddress As Long, ByVal dwSize As Long, ByVal flNewProtect As Long, lpflOldProtect As Long) As Long
    Public Const PAGE_EXECUTE_READWRITE As Long = &H40&
    Public Declare Function SHCreateDataObject Lib "shell32" (ByVal pidlFolder As Long, ByVal cidl As Long, ByVal apidl As Long, pdtInner As Any, riid As UUID, ppv As Any) As Long
    Public Declare Function SHDoDragDrop Lib "shell32" (ByVal hwnd As Long, ByVal pdtobj As Long, ByVal pdsrc As IDropSource, ByVal dwEffect As Long, pdwEffect As Long) As Long
    Public Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
    Public Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
    Public Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
    Public Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
    Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
    Public Declare Function RegisterClipboardFormatW Lib "user32" (ByVal lpszFormat As Long) As Long
    
    Public Const MK_CONTROL = 8
    Public Const MK_LBUTTON = 1
    Public Const MK_MBUTTON = &H10
    Public Const MK_RBUTTON = 2
    Public Const MK_SHIFT = 4
    Public Const MK_XBUTTON1 = &H20
    Public Const MK_XBUTTON2 = &H40
    
    Public Function GiveFeedbackVB(ByVal this As IDropSource, ByVal dwEffect As Long) As Long
    Debug.Print "gfvb.entry"
    GiveFeedbackVB = DRAGDROP_S_USEDEFAULTCURSORS
    
    End Function
    Public Function QueryContinueDragVB(ByVal this As IDropSource, ByVal fEscapePressed As Long, ByVal grfKeyState As Long) As Long
    Debug.Print "qcdvb.entry|"
       If fEscapePressed Then
          QueryContinueDragVB = DRAGDROP_S_CANCEL
          Exit Function
        End If
       If grfKeyState <> MK_LBUTTON Then
            Debug.Print "DROP" 'Here is where you generate the file the hDROP points to 
          QueryContinueDragVB = DRAGDROP_S_DROP
          Exit Function
       End If
     QueryContinueDragVB = S_OK
    
    
    End Function
    Public Function SwapVtableEntry(pObj As Long, EntryNumber As Integer, ByVal lpfn As Long) As Long
    
        Dim lOldAddr As Long
        Dim lpVtableHead As Long
        Dim lpfnAddr As Long
        Dim lOldProtect As Long
    
        CopyMemory lpVtableHead, ByVal pObj, 4
        lpfnAddr = lpVtableHead + (EntryNumber - 1) * 4
        CopyMemory lOldAddr, ByVal lpfnAddr, 4
    
        Call VirtualProtect(lpfnAddr, 4, PAGE_EXECUTE_READWRITE, lOldProtect)
        CopyMemory ByVal lpfnAddr, lpfn, 4
        Call VirtualProtect(lpfnAddr, 4, lOldProtect, lOldProtect)
    
        SwapVtableEntry = lOldAddr
    
    End Function
    Public Sub IDO_AddHDROP(ido As oleexp.IDataObject, sFiles() As String)
    Dim i As Long
    Dim fmt As FORMATETC
    Dim stg As STGMEDIUM
    'Dim objClsid As GUIDA
    Dim s As String
       Dim df As oleexp.DROPFILES
       Dim hGlobal As Long
       Dim lpGlobal As Long
       Dim hr As Long
    
    's = Join(sFiles, vbNullChar)
    's = s & vbNullChar & vbNullChar
    For i = 0 To UBound(sFiles)
      s = s & sFiles(i) & vbNullChar
    Next
    s = s & vbNullChar
      
    
    hGlobal = GlobalAlloc(GHND, Len(df) + Len(s))
    
    If hGlobal Then
        lpGlobal = GlobalLock(hGlobal)
    
        ' Build DROPFILES structure in global memory.
        df.pFiles = Len(df)
        Call CopyMemory(ByVal lpGlobal, df, Len(df))
        Call CopyMemory(ByVal (lpGlobal + Len(df)), ByVal s, Len(s))
        Call GlobalUnlock(hGlobal)
    
    fmt.cfFormat = CF_HDROP
    fmt.dwAspect = DVASPECT_CONTENT
    fmt.lIndex = -1
    fmt.pDVTARGETDEVICE = 0
    fmt.TYMED = TYMED_HGLOBAL
    
    stg.TYMED = TYMED_HGLOBAL
    stg.Data = lpGlobal
    
    ido.SetData fmt, stg, 1
    End If
    End Sub
    In QueryContinueDrag is the trigger to create the file.

    Then calling (with Private pDataObj1 As oleexp.IDataObject). Start where you would normally start a drag, and create some variables to note which file you'll need to create later.

    Code:
    If (pDataObj1 Is Nothing) = False Then
        Set pDataObj1 = Nothing
    End If
    Call SHCreateDataObject(0&, 0&, 0&, ByVal 0&, IID_IDataObject, pDataObj1)
    Dim hr As Long
    Dim lp As DROPEFFECTS
    Dim sfi() As String
    ReDim sfi(0)
    sfi(0) = App.Path & "\file.tmp" 'it's more proper to use the TEMP folder, and the attendant temp file name APIs, but i was just doing proof of concept
    IDO_AddHDROP pDataObj1, sfi
    Dim pds As cDropSource
    Set pds = New cDropSource
    
        hr = SHDoDragDrop(Me.hwnd, ObjPtr(pDataObj1), pds, DROPEFFECT_COPY, lp)
    Debug.Print "SHDDD hr=" & hr
    Tested it and it worked. This method has obvious limitations, but it's probably the only way around a full custom implementation, but WinRAR and 7-zip both use this method. Note that this uses my oleexp.tlb typelib; also the mIID module, though just for the IID_IDataObject call if you wanted to punch it out.
    So the last issue to cover is when to delete the temp file; obviously the easiest is just to flag for delete on reboot (using MoveFileEx), but there's other solutions too if you need it deleted earlier.

    PS- I don't think everything in the code above supports Unicode, I have to go now but I'll fix that later if need be. You'll probably want to refine the trigger code too, to check for the right button drags, and confirm the operation is still DROPEFFECT_COPY. Also, Chen also has an article on the above method, and makes the point that other methods will have less broad support, should you ever be dropping on applications other than Explorer.

  5. #5

    Thread Starter
    Junior Member
    Join Date
    Apr 2009
    Posts
    22

    Re: Dragging Virtual Files in VB6

    Wow! Cool stuff! I'll give this a try. Thanks!

  6. #6
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    2,060

    Re: Dragging Virtual Files in VB6

    So I wound up testing what I thought your initial approach was; I created a blank IDataObject like in my code above, then did the same type of VTable swap call as done in the class module, but for IDataObject tiself, and to my surprise it actually worked. So it looks like it may be possible to offer your original plan of CFSTR_FILEGROUPDESCRIPTOR as well, without a full implementation (or dealing with VB DataObject, though if you've got code setting that up already, it would probably be possible to start with an IDO from that); I'll dig into it a bit further.

  7. #7
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    2,060

    Re: Dragging Virtual Files in VB6

    Good news, after a few hiccups I got the method with CFSTR_FILEGROUPDESCRIPTOR/CFSTR_FILECONTENTS to work as well. This is probably the better method for this.
    Attached is a demo, you can drag it right into Explorer and it creates the file. I combined the first article you linked to with the IDataObject techniques of the temp-file version.

    Here's the highlights from the code to show the methodology (this is incomplete, download the demo project for the full, runnable code):
    Code:
    Private Sub Command1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim hr As Long
    Dim lp As DROPEFFECTS
    
    Call SHCreateDataObject(0&, 0&, 0&, ByVal 0&, IID_IDataObject, pDataObj)
    IDO_AddFileGroupDescriptor pDataObj, sCurFileName
    
    
    m_pOldGetData = SwapVtableEntry(ObjPtr(pDataObj), 4, AddressOf GetDataVB)
    m_pOldQueryGetData = SwapVtableEntry(ObjPtr(pDataObj), 6, AddressOf QueryGetDataVB)
    
    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)
    
    End Sub
    Code:
    Public Sub IDO_AddFileGroupDescriptor(pdo As oleexp.IDataObject, sFilename As String)
    Dim fmt As FORMATETC
    Dim stg As STGMEDIUM
    Dim hGlobal As Long, lpGlobal As Long
    Dim tFGD As FILEGROUPDESCRIPTORW
     
    ZeroMemory tFGD, LenB(tFGD)
    
    tFGD.cItems = 1
    With tFGD.fgd(0)
        .dwFlags = FD_UNICODE 'Other flags we set when returning on drop; they're ignored if set here
        CopyMemory .cFileName(0), ByVal StrPtr(sFilename), LenB(sFilename)
    End With
    
    hGlobal = GlobalAlloc(GHND, LenB(tFGD))
    If hGlobal Then
        lpGlobal = GlobalLock(hGlobal)
        CopyMemory ByVal lpGlobal, tFGD, LenB(tFGD)
        Call GlobalUnlock(hGlobal)
        stg.TYMED = TYMED_HGLOBAL
        stg.Data = lpGlobal
        fmt.cfFormat = CF_FILEGROUPDESCRIPTORW
        fmt.dwAspect = DVASPECT_CONTENT
        fmt.lindex = -1&
        fmt.TYMED = TYMED_HGLOBAL
        
        pdo.SetData fmt, stg, 1
    End If
    End Sub
    
    Public Function GetDataVB(ByVal this As IDataObject, pformatetcIn As FORMATETC, pmedium As STGMEDIUM) As Long
    Debug.Print "GetDataVB"
    Dim hGlobal As Long, lpGlobal As Long
    
        GetDataVB = DV_E_FORMATETC
        
        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
            Dim tFGD As FILEGROUPDESCRIPTORW
            
            ZeroMemory tFGD, LenB(tFGD)
            
            tFGD.cItems = 1&
            tFGD.fgd(0).dwFlags = FD_UNICODE Or FD_PROGRESSUI Or FD_FILESIZE
            tFGD.fgd(0).nFileSizeLow = LenB(sContentTest)  '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
            CopyMemory tFGD.fgd(0).cFileName(0), ByVal StrPtr(sCurFileName), LenB(sCurFileName)
            dbg_printbytes tFGD.fgd(0).cFileName, , True
            
            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
            
        End If
        
        If ((pformatetcIn.cfFormat And CF_FILECONTENTS) = CF_FILECONTENTS) Then
            Debug.Print "CF_FILECONTENTS Pre-request, tymed=" & pformatetcIn.TYMED & ",aspect=" & pformatetcIn.dwAspect & ",idx=" & pformatetcIn.lindex
        End If
        If ((pformatetcIn.cfFormat And CF_FILECONTENTS) = CF_FILECONTENTS) And _
           (pformatetcIn.dwAspect = DVASPECT_CONTENT) And _
           ((pformatetcIn.TYMED And TYMED_HGLOBAL) = TYMED_HGLOBAL) And _
           (pformatetcIn.lindex = 0) Then
            Debug.Print "CF_FILECONTENTS Requested"
           'This fires when you drop on a valid target
           'The file contents have now been offically requested for copying
           'For larger files it may be possible to use IStream, but for now just as
           'proof of concept we'll load it into an hGlobal like Raymond's article
           
            hGlobal = GlobalAlloc(GMEM_MOVEABLE, LenB(sContentTest))
            If hGlobal Then
                lpGlobal = GlobalLock(hGlobal)
                CopyMemory ByVal lpGlobal, ByVal StrPtr(sContentTest), LenB(sContentTest)
                Call GlobalUnlock(hGlobal)
                
                pmedium.TYMED = TYMED_HGLOBAL
                pmedium.Data = lpGlobal
                
                GetDataVB = S_OK
            End If
            
        End If
        
    End Function
    
    Public Function QueryGetDataVB(ByVal this As IDataObject, pformatetc As FORMATETC) As Long
    Debug.Print "QueryGetDataVB"
        QueryGetDataVB = DV_E_FORMATETC
    
        'CF_FILEGROUPDESCRIPTORW
        If ((pformatetc.cfFormat) = CF_FILEGROUPDESCRIPTORW) And _
           (pformatetc.dwAspect = DVASPECT_CONTENT) And _
           (pformatetc.TYMED = TYMED_HGLOBAL) Then
            Debug.Print "Query for CF_FGD"
            QueryGetDataVB = S_OK
    
        End If
    
        'CF_FILECONTENTS
        If ((pformatetc.cfFormat) = CF_FILECONTENTS) And _
           (pformatetc.dwAspect = DVASPECT_CONTENT) And _
           (pformatetc.TYMED = TYMED_HGLOBAL) Then
            Debug.Print "Query for CF_FC, idx=" & pformatetc.lindex
            QueryGetDataVB = S_OK
    
        End If
        
    End Function
    This demo also uses oleexp (only required in the IDE btw, you don't need to distribute it with a compiled app); but no need for mIID I just put IID_IDataObject in the form. This version also doesn't need a custom drop source, the project just uses the default one created by SHDoDragDrop when no custom one is passed. If you absolutely need a VB or ComCtlLib DataObject, see here for how to get the IDataObject from it-- it would replace the SHCreateDataObject call; but I'm unsure of if/how well this would work. Lastly, this version supports Unicode filenames.

    NOTE: I just looked at things in a clipboard analyzer, and for some reason *a lot* of formats are coming up with data that was never placed (duplicate data of the formats that were placed), and it's not the few irrelevant blank entries from the IDO creating API. So while the project does work to dragdrop a virtual file, there's' some bugs to work out.
    Other issue: When dropped, Explorer seems to be making several queries for the content, with the expected TYMED=TYMED_HGLOBAL, but none of these result in file creation. Then at the very end, it makes a contents request with TYMED = TYMED_HGLOBAL Or TYMED_ISTREAM Or TYMED_ISTORAGE (13). Only responding to that results in file creation. So I'm concerned your slow printer data will take 4x as long with useless copies; and I'm hesitant to set a response to 13 only until I verify the same behavior on other Windows versions (only tested on 7 so far).

    Update 1: The second issue was easily fixable; all the requests before the last one were for the wrong lindex value, so adding a lindex = 0& check ensures the contents are only read once. DL the revision below or just add And (pformatetcIn.lindex = 0) to the CF_FILECONTENTS check in GetDataVB.
    Update 2: Fixed the first issue by narrowing the scope of both GetDataVB and QueryGetDataVB. There's no longer any extraneous formats that will interfere, just the SHCreateDataObject relics which don't matter.

    Attachment removed: See newer version in CodeBank: [VB6] Virtual File Drag Drop

  8. #8
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    4,677

    Re: Dragging Virtual Files in VB6

    I'm a bit late to the party on this one, but I've got drag-drop code I've used for years. I suppose you could say it drags "Virtual" Files. Basically, it drags anything you place into a ListView.

    Here's a video of the little test project I pulled together:




    I've also attached that little "test" project. I'm sure this could be cleaned up more, and there may be ways to do it that are better. But this has worked for me for years, and I just haven't been motivated to dive back into it.

    JonathanHunt, maybe it'll help you.

    Good Luck,
    Elroy
    Attached Files Attached Files
    Any software I post in these forums written by me is provided “AS IS” without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. Please understand that I’ve been programming since the mid-1970s and still have some of that code. My contemporary VB6 project is approaching 1,000 modules. In addition, I have a “VB6 random code folder” that is overflowing. I’ve been at this long enough to truly not know with absolute certainty from whence every single line of my code has come, with much of it coming from programmers under my employ who signed intellectual property transfers. I have not deliberately attempted to remove any licenses and/or attributions from any software. If someone finds that I have inadvertently done so, I sincerely apologize, and, upon notice and reasonable proof, will re-attach those licenses and/or attributions. To all, peace and happiness.

  9. #9
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    2,060

    Re: Dragging Virtual Files in VB6

    @Elroy, I'm not sure I see how that can be modified to create a file from data that's not gathered until the user drops on Explorer etc? The data is on a slow external device, so should only be read when the mouse button is released and Explorer requests the file contents.
    It also only worked once then stopped working due to a high DPI issue :/

  10. #10
    PowerPoster
    Join Date
    Jun 2013
    Posts
    3,834

    Re: Dragging Virtual Files in VB6

    Quote Originally Posted by Elroy View Post
    I'm a bit late to the party on this one, but I've got drag-drop code I've used for years. I suppose you could say it drags "Virtual" Files.
    You missed the point on this one, since a "Virtual File" in this context means something,
    you put into a DragOperation from Memory (as e.g. Image-Content you've stored in a DB-Table-Blob or other things like that)...

    @the OP and fafalone
    An Ole-IStream-compatible Storage-Object instead of the (IMO not really well-fitting in Chens example) "HGlobal-Blob",
    would be the more elegant solution for that...

    ...since in the context of cfFileGroupW-Handling you could treat both, virtual and non-virtual Files nearly identically by:
    - using SHCreateStreamOnFile(FilePath, STGM_READ) for real files
    - using CreateStreamOnHGlobal(0, 1) for virtual ones

    When the DataObject-GetData-cfFileContents-callback is triggered, one only has to provide the Stream-Pointer then -
    (adjusting the STGMedium-type) as e.g. implemented in the RC5-cDataObject.Files-Class this way:
    Code:
    Friend Function GetStreamForFile(Idx As Long, STM As STGMEDIUM) As Long
      If Idx < 0 Or Idx >= mCol.Count Then
        GetStreamForFile = DV_E_FORMATETC
      ElseIf Streams(Idx) Is Nothing Then
        GetStreamForFile = DV_E_FORMATETC
      Else
        STM.TyMed = TYMED_ISTREAM
        STM.Data = ObjPtr(Streams(Idx))
        MemCopy Streams(Idx), 0&, 4 'zeroing using a weak release
      End If
    End Function
    Using an IStream might also help with providing "Data in chunks, in a delayed fashion, using your own protocol"
    (when one is using his own implementation of an IStream-interface).

    Olaf

  11. #11
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    2,060

    Re: Dragging Virtual Files in VB6

    IStream is definitely the way to go for longer operations; I just had the string/hglobal there for a quick proof of concept, but it's easy enough to either use RC5 for a stream, or just pure API with CreateStreamOnHGlobal and switching to TYMED_ISTREAM. I'll update the project I posted to try that a little later.

  12. #12
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    4,677

    Re: Dragging Virtual Files in VB6

    Yeah, I didn't read everything in detail. I just knew I had this code, and thought I'd offer it. JonathanHunt, if it's not what you need, ignore it. Fafalone is an excellent coder and will offer you some good advice. Olaf is also an excellent code, but he'll often be hawking his RC5 as the answer. I just hope this thread isn't a foreshadowing of RC5's future.

    Best of Luck To You,
    Elroy
    Any software I post in these forums written by me is provided “AS IS” without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. Please understand that I’ve been programming since the mid-1970s and still have some of that code. My contemporary VB6 project is approaching 1,000 modules. In addition, I have a “VB6 random code folder” that is overflowing. I’ve been at this long enough to truly not know with absolute certainty from whence every single line of my code has come, with much of it coming from programmers under my employ who signed intellectual property transfers. I have not deliberately attempted to remove any licenses and/or attributions from any software. If someone finds that I have inadvertently done so, I sincerely apologize, and, upon notice and reasonable proof, will re-attach those licenses and/or attributions. To all, peace and happiness.

  13. #13
    PowerPoster
    Join Date
    Jun 2013
    Posts
    3,834

    Re: Dragging Virtual Files in VB6

    Quote Originally Posted by Elroy View Post
    Olaf is also an excellent code, but he'll often be hawking his RC5 as the answer.
    Well, I didn't in this case (just posted a code-snippet for fafalone, which "I know is working" -
    and which contained a hint, that he has to be careful with the IStream-instance-refcounting.

    Quote Originally Posted by Elroy View Post
    I just hope this thread isn't a foreshadowing of RC5's future.
    As for an RC5-example (which might be useful for others in the given context of Virtual File-Dragging,
    but probably not for the OP, because he wants a "delayed providing of the virtual file-data at Drop-Time")...

    The RC5-support for virtual dragging (currently) requires providing the ByteArray-FileContent at DragStart.

    Into a VB6-Class, named cwSimpleDrag (a Widget-Implementation)
    Code:
    Option Explicit 'a simple Widget, which renders an Image, and allows dragging that image as a virtual File
     
    Private WithEvents W As cWidgetBase
     
    Private Sub Class_Initialize()
      Set W = Cairo.WidgetBase
          W.MousePointer = IDC_HAND
    End Sub
    
    Public Property Get Widget() As cWidgetBase: Set Widget = W: End Property
    Public Property Get Widgets() As cWidgets: Set Widgets = W.Widgets: End Property
     
    Private Sub W_MouseMove(Button As Integer, Shift As Integer, ByVal x As Single, ByVal y As Single)
      If W.DragDetect Then W.StartDrag
    End Sub
    
    Private Sub W_DragStartSrc(Data As cDataObject, AllowedEffects As WidgetDropEffects, ByVal xMousePosOnWidget As Single, ByVal yMousePosOnWidget As Single, DragImage As cCairoSurface, xOffsDragImage As Long, yOffsDragImage As Long)
      AllowedEffects = DROPEFFECT_COPY
      Set DragImage = Cairo.ImageList("SomeImg") 'use a stored Img-resource as the DragImage
      xOffsDragImage = 24: yOffsDragImage = -10
     
      Dim B() As Byte 'we will add ByteArray-content as a virtual file
      DragImage.WriteContentToPngByteArray B 'in this case, we'll serialize the Img-resource of the DragImage
      Data.Files.AddVirtualFile "SomeImg.png", B 'and add the ByteArray under a certain name as a virtual file
    End Sub
    
    Private Sub W_Paint(CC As cCairoContext, ByVal xAbs As Single, ByVal yAbs As Single, ByVal dx_Aligned As Single, ByVal dy_Aligned As Single, UserObj As Object)
      CC.RenderSurfaceContent "SomeImg", 0, 0, 48, 48
    End Sub
    And this code into a *.bas-Module - requiring to start your Project from Sub Main():
    Code:
    Option Explicit
    
    Public Form As cWidgetForm
     
    Sub Main()
      Cairo.ImageList.AddIconFromResourceFile "SomeImg", "shell32", 167
     
      'create a Cairo-Form and a simple Widget on it
      Set Form = Cairo.WidgetForms.Create(vbFixedDialog, "Drag Virtual-File", , 240, 180)
          Form.Widgets.Add New cwSimpleDrag, "SimpleDrag", 90, 40, 48, 48
          Form.Show
          
      Cairo.WidgetForms.EnterMessageLoop
    End Sub
    HTH

    Olaf
    Last edited by Shaggy Hiker; Sep 16th, 2018 at 10:00 AM.

  14. #14
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    2,060

    Re: Dragging Virtual Files in VB6

    So I'm not familiar with how one might go about creating the IStream for a virtual file... if one uses CreateStreamOnHGlobal, doesn't that already require the data has been copied into memory? e.g. changing the CF_FILECONTENTS response in GetDataVB to

    With the IStream declared as Public pStrm As oleexp.IStream and Set pStrm = Nothing after SHDoDragDrop...
    Code:
            hGlobal = GlobalAlloc(GMEM_MOVEABLE, LenB(sContentTest))
            If hGlobal Then
                lpGlobal = GlobalLock(hGlobal)
                CopyMemory ByVal lpGlobal, ByVal StrPtr(sContentTest), LenB(sContentTest)
                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)
                
                GetDataVB = S_OK
            End If
    Now this works and creates the same file as the other method, showing how easy it is to switch to an IStream once you have one... but really what difference is there since the data was read into the hGlobal the stream was created on?
    Is anyone more familiar with creating an IStream on data like this?

  15. #15
    PowerPoster
    Join Date
    Jun 2013
    Posts
    3,834

    Re: Dragging Virtual Files in VB6

    Quote Originally Posted by fafalone View Post
    Now this works and creates the same file as the other method, showing how easy it is to switch to an IStream once you have one...
    but really what difference is there since the data was read into the hGlobal the stream was created on?
    I was arguing from the point of view of a "full encapsulation of File-Dragging in Class-wrappers".

    Internal wrapper-code will become "more tidy", once you have an IStream-encapsulating class:
    - which can either work with File-Streams for the normal case of "non-virtual-files",
    - or alternatively with InMemory-Streams for the "virtual FileMode"

    And as written already in #10, one can create an InMem-IStream
    (without using the GlobalAlloc, GlobalLock, GlobalUnlock-APIs)
    by simply passing a Zero-Pointer as the hGlobal-Handle:
    hr = CreateStreamOnHGlobal(ByVal 0&, 1&, pStrm)

    If that is done within an IStream-encapsulating class, you could then pass this Stream-Class-instance
    (with an yet empty stream) to the outside in an Event or using your own Callback-Interface...
    The user could then use convenient Stream-Methods to fill-in the Data - even in chunks if needed.

    Olaf

  16. #16
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    2,060

    Re: Dragging Virtual Files in VB6

    When you create an 'InMem-IStream', is that a normal IStream you'd add data to presumably with .Write, or is it a class that Implements IStream so you supply the data to Read when its called? If it's the latter wouldn't you just instantiate with New ?

    Edit: Looked at a few examples, using .Write, but that's still in effect the same thing, loading all the data, just into an IStream instead of global memory. At this point we should probably ask some clarification by the OP concerning how the file contents are read to figure out the best approach.

    CF_FILECONTENTS response with .Write of the contents string placed in a byte array..
    Code:
                Call CreateStreamOnHGlobal(ByVal 0&, 1&, pStrm)
                If (pStrm Is Nothing) = False Then
                    Dim crSize As Currency
                    crSize = UBound(btContents) + 1
    
                    pStrm.SetSize crSize
                    pStrm.Write btContents(0), UBound(btContents) + 1
                    
                    pmedium.TYMED = TYMED_ISTREAM
                    pmedium.Data = ObjPtr(pStrm)
                    
                    GetDataVB = S_OK
                End If
    Still creates the same file so that's good at least

  17. #17
    PowerPoster
    Join Date
    Jun 2013
    Posts
    3,834

    Re: Dragging Virtual Files in VB6

    Quote Originally Posted by fafalone View Post
    When you create an 'InMem-IStream', is that a normal IStream you'd add data to presumably with .Write, or is it a class that Implements IStream so you supply the data to Read when its called? If it's the latter wouldn't you just instantiate with New ?
    Both ways will work.

    And yes, a VBClass which implements the IStream-Interface would then be instantiated via New...
    If the OP needs the most flexibility, and wants to read his real data as late as possible,
    this would probably be the best approach.

    Olaf

  18. #18
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    2,060

    Re: Dragging Virtual Files in VB6

    If it's an IStream implementing class created by New, do you still need CreateStreamOnHGlobal?


    ----------
    Apparently there's also one more option for virtual file transfers, using IStorage, per this article. Not initially sure how to set the data, but in case OP or anyone is using structured storage I ported it to VB...
    where Public pStg As IStorage
    Code:
            Dim plb As ILockBytes
            Set plb = CreateILockBytesOnHGlobal(0&, 1&)
    
            If (plb Is Nothing) = False Then
                Set pStg = StgCreateDocfileOnILockBytes(plb, STGM_READWRITE Or STGM_SHARE_EXCLUSIVE Or STGM_CREATE Or STGM_DIRECT, 0&)
                'Fill storage...
                Set plb = Nothing
    
                pmedium.TYMED = TYMED_ISTORAGE
                pmedium.Data = ObjPtr(pStg)
            End If
    The APIs are already in the TLB.

  19. #19
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    2,060

    Arrow Re: Dragging Virtual Files in VB6

    Here's a new version of my demo...
    -Has all 4 methods so far (the IStorage one doesn't work as is, but the others you can just switch which block is active-- only 1 at a time)
    -Swaps out for a custom EnumFormatEtc using SHCreateStdEnumFmtEtc*; this streamlines things a bit and hides the unused formats-- now just CFSTR_FILEGROUPDESCRIPTORW and CFSTR_FILECONTENTS show, and requests for invalid GetData's are reduced
    -Manually doing the FormatEtc also allows eliminating IDO_AddFileGroupDescriptor
    -Includes a template class to manually implement IStream (courtesy of the MemoryStream.cls class from VBAccelerator's GDI+ Wrapper)

    * - This API has a note about being unavailable in the future, but no maximum supported version is listed so there shouldn't be an issue, if someone on Win10 could verify? Or point out a better option... OleRegEnumFormatEtc requires adding registry entries, and manually implementing it would be a pain.



    Posted one more update to correct a bug that caused an app crash in the compiled exe when the IStream methods had the stream released (see posts below)

    Removed. Grab the latest version from my new CodeBank entry on this: [VB6] Virtual File Drag Drop

  20. #20

    Thread Starter
    Junior Member
    Join Date
    Apr 2009
    Posts
    22

    Re: Dragging Virtual Files in VB6

    Quote Originally Posted by fafalone View Post
    Here's a new version of my demo...
    This works perfectly! Thank you very much! I modified things slightly to allow multiple virtual files in one operation by creating a larger FILEGROUPDESCRIPTORW with more elements, populating all the file descriptors, and then reacting to the different values pformatetcIn.lindex to provide the data for each file.

    Very cool stuff!
    Last edited by JonathanHunt; Sep 17th, 2018 at 08:07 AM.

  21. #21
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    2,060

    Re: Dragging Virtual Files in VB6

    How did you add additional files to the descriptor? One of Chen's articles addressed that briefly but used a union, which I wasn't sure how to convert into VB, or if that applied to more than 1 file.

    Also, which method are you using, because I just found an issue with the IStream methods, it's crashing when the stream is released (Set pStrm = Nothing or if that's removed, on exit), but only in the compiled EXE.

  22. #22

    Thread Starter
    Junior Member
    Join Date
    Apr 2009
    Posts
    22

    Re: Dragging Virtual Files in VB6

    For the purpose of proof of concept I made this. In the real solution I'll build up a byte array with the Item Count at the start and then all the FILEDESCRIPTORWs in memory order since VB isn't really suited to forming non-fixed length typed arrays.

    Code:
    Private Type FILEGROUPDESCRIPTORW2
        cItems As Long
        fgd(0 To 1) As FILEDESCRIPTORW
    End Type
    I used method 2b. I didn't check the compiled exe yet, I've just started the integration. If that's the case though, I may just change to the HGlobal, as I don't plan to truly stream the data anyway. I do still have to figure out how to signal if the data retrieval fails. I'm guessing returning S_FALSE from GETDATA should do it.

  23. #23
    PowerPoster
    Join Date
    Jun 2013
    Posts
    3,834

    Re: Dragging Virtual Files in VB6

    Quote Originally Posted by fafalone View Post
    ... I just found an issue with the IStream methods, it's crashing when the stream is released (Set pStrm = Nothing or if that's removed, on exit), but only in the compiled EXE.
    I gave a hint for that in the short code-snippet I've posted in #10 already...
    about "weak releasing" your own Stream-Variable, after you've handed it over into the STM.Data as an ObjPtr -
    (because the process who was calling GetData is now taking over responsibility for releasing the IStream-instance).
    If you don't do that, then you will try to "double-release" (at the VB6-end) a Zombie-Object.

    If the hand-over via ObjPtr never happens, then such a weak-release is not necessary of course on the instance-variable.

    Olaf

  24. #24
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    2,060

    Re: Dragging Virtual Files in VB6

    That seems to have worked, thanks Olaf.

    Code:
                pmedium.TYMED = TYMED_ISTREAM
                pmedium.Data = ObjPtr(pStrm)
                CopyMemory pStrm, 0&, 4&
                GetDataVB = S_OK
    @JonathanHunt, add the bolded line for 2a and 2b to prevent the crash in the exe. To signal a failure, it looks like the most appropriate return code is STG_E_MEDIUMFULL, per MS:
    GetData must check all fields in the FORMATETC structure. It is important that GetData render the requested aspect and, if possible, use the requested medium. If the data object cannot comply with the information specified in the FORMATETC, the method should return DV_E_FORMATETC. If an attempt to allocate the medium fails, the method should return STG_E_MEDIUMFULL. It is important to fill in all of the fields in the STGMEDIUM structure.


    Edit: I was curious after you pointed out the problem was a double-release, so wanted to find out if incrementing the reference counter would work too. Turns out it does. So if you want to keep the object around without zeroing it, another possibility is
    Code:
                Dim pUnk As oleexp.IUnknown
                Set pUnk = pStrm
                pUnk.AddRef

  25. #25
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    2,060

    Re: Dragging Virtual Files in VB6

    Quote Originally Posted by JonathanHunt View Post
    For the purpose of proof of concept I made this. In the real solution I'll build up a byte array with the Item Count at the start and then all the FILEDESCRIPTORWs in memory order since VB isn't really suited to forming non-fixed length typed arrays.
    (...)
    Yeah I see what you meant here... I've tried it a few different ways, and keep getting weird errors and/or file names filled with Chinese characters. Not a clue what the problem would be...
    I set it to a straight byte array, which can be read back into FILEDESCRIPTOR just fine, so shouldn't it be byte-for-byte identical?

    Code:
    Public Type FILEGROUPDESCRIPTOREXW
        cItems As Long
        fgd() As Byte
    End Type
    Public arFD() As FILEDESCRIPTORW
    
                Dim tFGDM As FILEGROUPDESCRIPTOREXW
                ReDim arFD(nFiles - 1)
                ReDim tFGDM.fgd(nFiles * LenB(arFD(0)))
    
                tFGDM.cItems = nFiles
                
                arFD(0).dwFlags = FD_UNICODE Or FD_PROGRESSUI Or FD_FILESIZE
                arFD(0).nFileSizeLow = LenB(sContentTest2)
                CopyMemory arFD(0).cFileName(0), ByVal StrPtr(sCurFileName2), LenB(sCurFileName2)
     
                arFD(1).dwFlags = FD_UNICODE Or FD_PROGRESSUI Or FD_FILESIZE
                arFD(1).nFileSizeLow = LenB(sContentTest3)
                CopyMemory arFD(1).cFileName(0), ByVal StrPtr(sCurFileName3), LenB(sCurFileName3)
     
                arFD(2).dwFlags = FD_UNICODE Or FD_PROGRESSUI Or FD_FILESIZE
                arFD(2).nFileSizeLow = LenB(sContentTest4)
                CopyMemory arFD(2).cFileName(0), ByVal StrPtr(sCurFileName4), LenB(sCurFileName4)
                dbg_printbytes arFD(2).cFileName, , True
                
                Dim lOffset As Long
                CopyMemory tFGDM.fgd(0), arFD(0), LenB(arFD(0))
                lOffset = LenB(arFD(0))
                CopyMemory tFGDM.fgd(lOffset), arFD(1), LenB(arFD(1))
                lOffset = lOffset + LenB(arFD(1))
                CopyMemory tFGDM.fgd(lOffset), arFD(2), LenB(arFD(2))
                
                Dim fdt As FILEDESCRIPTORW
                CopyMemory fdt, tFGDM.fgd(lOffset), LenB(arFD(2))
                dbg_printbytes fdt.cFileName, , True
                Debug.Print "cb=" & fdt.nFileSizeLow
    That last block check returns both the name and size correctly.

  26. #26

    Thread Starter
    Junior Member
    Join Date
    Apr 2009
    Posts
    22

    Re: Dragging Virtual Files in VB6

    Here's how I went about it for the real solution - this is iterating over items in a listview and building the FILEGROUPDESCRIPTORW for the list directly into a byte array. There's a little extra code here and there but you can see the main point.


    Code:
    Private Function BuildFileDescriptorTable() As Boolean
        
        Dim typFileDesc() As FILEDESCRIPTORW
        Dim objLI As ListItem
        Dim lngCnt As Long
        Dim strName As String
        Dim bytOutput() As Byte
        Dim lngFileDescLen As Long
        Dim lngIndex As Long
        Dim lngPtr As Long
        Dim strNames() As String
        
        BuildFileDescriptorTable = False
        
        For Each objLI In lstFiles.ListItems
        
            If objLI.Selected Then
                
                ReDim Preserve typFileDesc(0 To lngCnt) As FILEDESCRIPTORW
                ReDim Preserve strNames(0 To lngCnt) As String
                
                strName = objLI.Text
                
                ZeroMemory typFileDesc(lngCnt), LenB(typFileDesc(lngCnt))
                
                typFileDesc(lngCnt).dwFlags = FD_UNICODE Or FD_PROGRESSUI Or FD_FILESIZE
                typFileDesc(lngCnt).nFileSizeLow = objFiles.Item(strName).Item("size")
                
                CopyMemory typFileDesc(lngCnt).cFileName(0), ByVal StrPtr(strName), LenB(strName)
                strNames(lngCnt) = strDisplayedDrive & COLON & strName
    
                lngCnt = lngCnt + 1
            End If
        Next objLI
        
        If lngCnt = 0 Then
            Exit Function
        End If
        
        lngFileDescLen = Len(typFileDesc(0))
        
        ' This would normally be -1 but we add 3 for the long at the start with the count (4 bytes)
        ReDim bytOutput(0 To (lngFileDescLen * lngCnt) + 3)
        
        CopyMemory bytOutput(0), lngCnt, 4
        lngPtr = 4
        
        For lngIndex = 0 To lngCnt - 1
            SafteyCheck bytOutput, lngPtr, lngFileDescLen
            CopyMemory bytOutput(lngPtr), typFileDesc(lngIndex), lngFileDescLen
            lngPtr = lngPtr + lngFileDescLen
        Next lngIndex
        
        SetFileData bytOutput, strNames, lngCnt
        
        BuildFileDescriptorTable = True
        
    End Function

  27. #27

    Thread Starter
    Junior Member
    Join Date
    Apr 2009
    Posts
    22

    Re: Dragging Virtual Files in VB6

    Quote Originally Posted by fafalone View Post
    Code:
    Public Type FILEGROUPDESCRIPTOREXW
        cItems As Long
        fgd() As Byte
    End Type
    I think that when you place a variable length array in a type, what you actually get is a safearray structure rather than the actual data. Only fixed arrays are placed directly in memory. That's why I had to build the entire structure in a byte array including the count.

    Just for fun, I want to see if I can somehow inform explorer about the progress of my file transfers. I get a progress box now but until I close out the stream, it just stays at 0%. I wonder if I can somehow tell it how we are progressing.

  28. #28
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    2,060

    Re: Dragging Virtual Files in VB6

    You set the size to the total file size right? FILEDESCRIPTOR.nFileSizeLow (and .nFileSizeHigh if needed)? If you already have that *and* pStrm.SetSize, try it with only the latter, then with only the former.. and can't hurt to see if the #1 hGlobal method shows progress with just the group descriptor nFileSizeLow

    Edit: It looks like the best thing to do is eliminate the IStream.SetSize calls. I inserted an artificial delay before .WRite, and the progress window shows. SetSize is hugely problematic too... it's throwing out of memory errors even though .Write doesn't (so if .Write can allocate it, how's it out of memory?)
    So you can have updates after each file just as is... but within a file... I tried writing in chunks but it still stayed at 0 the whole time then raced to 100 in the last second before closing.
    I think you'll need to roll your own progress window... you can use the Explorer default one, see here.

    Edit2: Rolling your own progress is definitely the way to go. First, remove the FD_PROGRESSUI flags and add cProgressWindow.cls (linked above). I'm going to post an updated demo later/tomorrow since there's a lot of rough edges to smooth, but the basic idea goes like this:
    In Form1
    Code:
    Private WithEvents cPrg As cProgressWindow
    Public Sub Startprg(sText As String)
    cPrg.SetLine 1, sText
    cPrg.OpenProgressWindow PROGDLG_AUTOTIME Or PROGDLG_MODAL, Me.hWnd
    End Sub
    Public Sub Updateprg(i As Long, t As Long)
    cPrg.UpdateProgress i, t
    End Sub
    Public Sub ClosePrg()
    cPrg.CloseProgressWindow
    End Sub
    
    
    'then when starting a drag on e.g. mousedown, before vtable swaps:
    Set cPrg = New cProgressWindow
    cPrg.SetTitle "Virtual File DragDrop"
    Then I modified Method 2b since that's what we've been using. There's actually a whole lot of modification unrelated to progress, so it's not compatible with the existing demo, but it will give you an idea of how to do the progress window, and I'll post the full updated demo later/tomorrow.
    Code:
            Call CreateStreamOnHGlobal(ByVal 0&, 1&, pStrm)
            If (pStrm Is Nothing) = False Then
                Dim crSize As Currency
                If (pformatetcIn.lindex >= 0&) And (pformatetcIn.lindex < nFiles) Then
    
                    crSize = ((UBound(FilesToDrag(pformatetcIn.lindex).btContents) + 1)) ' * 10000)
                    Debug.Print "Set stream size=" & crSize
    '                dbg_printbytes FilesToDrag(pformatetcIn.lindex).btContents, , True
    '                pStrm.SetSize crSize
                    With FilesToDrag(pformatetcIn.lindex)
                        Dim pBlock As Long
                        Dim nBytes As Long
                        Dim nPos As Long
                        nBytes = UBound(FilesToDrag(pformatetcIn.lindex).btContents) + 1
                        pBlock = 4096
                        Form1.Startprg "Copying " & FilesToDrag(pformatetcIn.lindex).sName
                        Do
                            If (nBytes - nPos) <= pBlock Then
                                pStrm.Write .btContents(nPos), nBytes - nPos
                                Exit Do
                            Else
                                pStrm.Write .btContents(nPos), pBlock
                                nPos = nPos + pBlock
                            End If
                            Sleep 10
                            Form1.Updateprg nPos, nBytes
                            DoEvents
                        Loop
                        Form1.ClosePrg
    
                    End With
                    pmedium.TYMED = TYMED_ISTREAM
                    pmedium.Data = ObjPtr(pStrm)Name:  vfdd.jpg
    Views: 57
    Size:  11.6 KB
                    CopyMemory pStrm, 0&, 4&
    
                    GetDataVB = S_OK
                End If
            End If
    Name:  vfdd.jpg
Views: 57
Size:  11.6 KB



    UPDATE: An updated demo with the custom progress window and better handling of multiple files has been posted in the CodeBank.
    [VB6] Virtual File Drag Drop

Posting Permissions

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



Featured


Click Here to Expand Forum to Full Width