Detect directory(ies) on OLE DragDrop event

As the title says, I need to detect if a user has selected directories (one or multiple) on OLE dragdrop.

A thread for vb.net explains using file.exist, but in our usage case, users might be dragging a filename with unsupported characters (foreign or accented letters). So we need to explicitly detect it's a directory, rather determine that via inference.

Tnx for the help.

Hello, unfortunately VB6 drag drop doesn't support Unicode.

Take a look to this post.
And this thread.
And also this project.

PS: I didn't test anything of that, I'm just pointing what I found.

It supports Unicode if you used the DataObject->IDataObject trick to bypass VB's handling of it.

Obviously I recommend the 3rd link you posted since in addition to native Unicode support it will also let you get the fancy new drag images, but if you have lots of legacy code modifying the existing event might be preferable.

Code:

---

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
Private Declare Function MessageBoxW Lib "user32" (ByVal hWnd As LongPtr, ByVal lpText As LongPtr, ByVal lpCaption As LongPtr, ByVal uType As Long) As Long

Private Sub Form_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
        Dim pIDO As IDataObject
        CopyMemory pIDO, ByVal ObjPtr(Data) + 16, 4
        Dim psia As IShellItemArray
        SHCreateShellItemArrayFromDataObject pIDO, IID_IShellItemArray, psia
        If (psia Is Nothing) = False Then
            Dim pEnum As IEnumShellItems
            Dim si As IShellItem
            Dim lpName As LongPtr
            psia.EnumItems pEnum
            Do While pEnum.Next(1, si, 0) = S_OK
                si.GetDisplayName SIGDN_FILESYSPATH, lpName
                MessageBoxW Me.hWnd, lpName, 0, 0
                CoTaskMemFree lpName
            Loop
        Else
            Debug.Print "No psia"
        End If
        CopyMemory pIDO, 0&, 4
End Sub
Private Function LPWSTRtoStr(lPtr As LongPtr, Optional ByVal fFree As Boolean = True) As String
SysReAllocStringW VarPtr(LPWSTRtoStr), lPtr
If fFree Then
    Call CoTaskMemFree(lPtr)
End If
End Function

---

This works to show Unicode file names. I passed lpName to MessageBoxW to display Unicode properly, but the included LPWStrToStr function will put it into a VB string for further use with Unicode APIs. Uses oleexp.tlb and mIID.bas (included with oleexp.tlb).

Appreciate the good suggestions for making the project unicode compatible. That's a longterm goal, but involves modifying a lot more than we want to do right now.

Is there a way to detect that a DragDrog contains a directory, eg, the original request?

This seems to work:

Code:

---

Private Sub Form_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim c As Long
   
    For c = 1 To Data.Files.Count
        If FolderExists(Data.Files(c)) Then
            Debug.Print Data.Files(c)
        End If
    Next
End Sub

Private Function FolderExists(ByVal nFolderPath As String) As Boolean
    On Error Resume Next
    FolderExists = (GetAttr(nFolderPath) And vbDirectory) = vbDirectory
    Err.Clear
End Function

---

Quote:

---

Originally Posted by murspieg1

Appreciate the good suggestions for making the project unicode compatible. That's a longterm goal, but involves modifying a lot more than we want to do right now.

Is there a way to detect that a DragDrog contains a directory, eg, the original request?

---

I don't see how you could reliably check if something is a directory if you can't pass its actual name to a 'is directory' function or even 'exists' function. I guess you could take my code and just modify it to check attributes... i.e.

Code:

---

        Dim pIDO As IDataObject
        CopyMemory pIDO, ByVal ObjPtr(Data) + 16, 4
        Dim psia As IShellItemArray
        SHCreateShellItemArrayFromDataObject pIDO, IID_IShellItemArray, psia
        If (psia Is Nothing) = False Then
            Dim pEnum As IEnumShellItems
            Dim si As IShellItem
            Dim lpName As LongPtr
            psia.EnumItems pEnum
            Do While pEnum.Next(1, si, 0) = S_OK
                Dim dwatr As SFGAO_Flags
                si.GetAttributes SFGAO_FOLDER Or SFGAO_STREAM, dwatr
                If ((dwatr And SFGAO_FOLDER) = SFGAO_FOLDER) And ((dwatr And SFGAO_STREAM) = 0) Then
                    'is folder
                End If
            Loop
        Else
            Debug.Print "No psia"
        End If
        CopyMemory pIDO, 0&, 4

---

(The check for SFGAO_STREAM is because SFGAO_FOLDER alone will include zip and cab files)

But then you're going to have trouble matching it up to the name VB gives. I don't know if they're in the same order. You don't have to support Unicode everywhere but if you need to find out if a path exists or is a folder, you can't use ???? in place of its actual name.

@Eduardo- The archive attribute isn't a reliable way to determine if something is a folder or not; and it doesn't seem to work even for regular ANSI if changed to vbDirectory.

Quote:

---

Originally Posted by fafalone

@Eduardo- The archive attribute isn't a reliable way to determine if something is a folder or not; and it doesn't seem to work even for regular ANSI if changed to vbDirectory.

---

Yes, I came back to edit the post and change the code because I remembered that there were issues, not sure about if what you said about files with the vbDirectory attribute is covered (is that possible?).