[RESOLVED] Drag and Drop, vbCFFiles, know the destination folder

[LeandroA]

Hello, could make a drag and drop on a folder and get to know the fate of this folder to open a file in binary form.

if I use this method

Private Sub ListView1_OLEStartDrag(Data As ComctlLib.DataObject, AllowedEffects As Long)
    Dim i As Long
    
    For i = 1 To ListView1.ListItems.Count
    
        If ListView1.ListItems.Item(i).Selected = True Then
        
            Data.Files.Add ListView1.ListItems(i).Tag
            Data.SetData , vbCFFiles
            
        End If
        
    Next

End Sub

is necessary that the file already exists (ListView1.ListItems (i). Tag) but this makes me unable to continue modifying.

I NEEDS is to create it after doing the drag and drop.

Is this possible?

[Hack]

How can you drag and drop something that doesn't exist yet?

[LaVolpe]

See if this thread helps. Note that one of its posts jumps to a codebank example.

[LeandroA]

after long time of trying the only thing I do is this, but I could not find a way to get if the mouse points a specific folder within the window or the desktop.

Option Explicit
Private Declare Function GetForegroundWindow Lib "user32.dll" () As Long

Private Sub Form_Load()
    Picture1.OLEDragMode = 1
End Sub

Private Sub Picture1_OLECompleteDrag(Effect As Long)
    Dim hDestFolder As String
    Dim oSW As Object
    Dim SHDoc As Object
        
    Set oSW = CreateObject("Shell.Application").Windows
        
    hDestFolder = GetForegroundWindow
    
    For Each SHDoc In oSW
        Debug.Print SHDoc.hWnd
        If SHDoc.hWnd = hDestFolder Then
            MsgBox SHDoc.document.Folder.Self.Path
            Exit For
        End If
    Next

    Set oSW = Nothing
End Sub


Private Sub Picture1_OLEStartDrag(Data As DataObject, AllowedEffects As Long)
    Data.SetData , vbCFFiles
    AllowedEffects = vbDropEffectCopy
End Sub

definitely not the right way.
I know I can do what I've seen in FileZilla, when you drag a file from ftp to a local folder then download the file FileZilla.

some of the apis using FileZilla RevokeDragDrop , RegisterDragDrop.

[LeandroA]

Solved using ReadDirectoryChangesW

Option Explicit

Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function ReadDirectoryChangesW Lib "kernel32.dll" (ByVal hDirectory As Long, ByVal lpBuffer As Long, ByVal nBufferLength As Long, ByVal bWatchSubtree As Boolean, ByVal dwNotifyFilter As Long, lpBytesReturned As Long, ByVal lpOverlapped As Long, ByVal lpCompletionRoutine As Long) As Long
Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal Destination As Long, ByVal Source As Long, ByVal Length As Long)

Private Const FILE_SHARE_DELETE             As Long = &H4
Private Const FILE_SHARE_READ               As Long = &H1
Private Const FILE_SHARE_WRITE              As Long = &H2
Private Const FILE_LIST_DIRECTORY           As Long = &H1
Private Const OPEN_EXISTING                 As Long = &H3
Private Const FILE_FLAG_BACKUP_SEMANTICS    As Long = &H2000000
Private Const FILE_FLAG_OVERLAPPED          As Long = &H40000000
Private Const INVALID_HANDLE_VALUE          As Long = (-1)
Private Const FILE_NOTIFY_CHANGE_ALL        As Long = &H17F


Private Type OVERLAPPED
    Internal                        As Long
    InternalHigh                    As Long
    offset                          As Long
    OffsetHigh                      As Long
    hEvent                          As Long
End Type

Private Type FILE_NOTIFY_INFORMATION
    dwNextEntryOffset               As Long
    dwAction                        As Long
    dwFileNameLength                As Long
    wcFileName(1023)                As Byte
End Type


Private Type DriveChange
    hDrive                          As Long
    sDrive                          As String
    Buff(0 To 1024 * 9 - 1)         As Byte
End Type


Private aChange()           As DriveChange

Private MyFileName          As String

Private Sub Form_Load()
    MyFileName = "RemoteImagen.bmp"
    Picture1.OLEDragMode = 1
End Sub

Private Sub Picture1_OLECompleteDrag(Effect As Long)
    Debug.Print GetDestination(MyFileName)
    Kill App.Path & "\" & MyFileName
End Sub


Private Sub Picture1_OLEStartDrag(Data As DataObject, AllowedEffects As Long)
    Open App.Path & "\" & MyFileName For Binary As #1: Close #1
    
    Call StartWatching
    Data.SetData , vbCFFiles
    Data.Files.Add App.Path & "\" & MyFileName
    AllowedEffects = vbDropEffectCopy
End Sub

Public Sub StartWatching()
    Dim lRet As Long
    Dim sBuff As String * 255
    Dim arrDrive() As String
    Dim lPos As Long
    Dim i As Long
    Dim tOLAP As OVERLAPPED
    
    lRet = GetLogicalDriveStrings(255, sBuff)

    arrDrive = Split(Left$(sBuff, lRet - 1), Chr$(0))

    For i = 0 To UBound(arrDrive)
        lRet = CreateFile(arrDrive(i), FILE_LIST_DIRECTORY, FILE_SHARE_READ Or FILE_SHARE_DELETE Or FILE_SHARE_WRITE, 0&, OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS Or FILE_FLAG_OVERLAPPED, 0&)
    
        If lRet <> INVALID_HANDLE_VALUE Then
            ReDim Preserve aChange(lPos)
            aChange(lPos).hDrive = lRet
            aChange(lPos).sDrive = arrDrive(i)
            lPos = lPos + 1
        End If
    Next
    
    For i = 0 To UBound(aChange)
        Call ReadDirectoryChangesW(aChange(i).hDrive, VarPtr(aChange(i).Buff(0)), 9216, True, FILE_NOTIFY_CHANGE_ALL, 0&, VarPtr(tOLAP), 0&)
    Next
    
End Sub

Private Function GetDestination(ByVal sName As String) As String
    Dim i As Long
    Dim sData As String
    Dim lPos As Long
    Dim lRet As Long
    Dim tFNI As FILE_NOTIFY_INFORMATION
    Dim tOLAP As OVERLAPPED
    
    Dim SafeCounter As Long
    
    Do While SafeCounter < 1000

        For i = 0 To UBound(aChange)
            lPos = 0
            
            Do
                Call CopyMemory(VarPtr(tFNI), VarPtr(aChange(i).Buff(lPos)), Len(tFNI))
    
                sData = Left$(tFNI.wcFileName, tFNI.dwFileNameLength / 2)
     
                If InStr(sData, sName) Then
                    GetDestination = aChange(i).sDrive & sData
                    GoTo StopWatching
                End If
                
                If tFNI.dwNextEntryOffset = 0 Then Exit Do
                
                lPos = lPos + tFNI.dwNextEntryOffset
            Loop
            
            Call ReadDirectoryChangesW(aChange(i).hDrive, VarPtr(aChange(i).Buff(0)), 9216, True, FILE_NOTIFY_CHANGE_ALL, 0&, VarPtr(tOLAP), 0&)
        
            DoEvents
        Next
        SafeCounter = SafeCounter + 1
        
    Loop
    
    Debug.Print "Error or Cancel"
    
StopWatching:

    For i = 0 To UBound(aChange)
        Call CloseHandle(aChange(i).hDrive)
    Next
    
    Erase aChange
    
End Function