Need the expert advice

Just starting out? Need help? Post your questions and find answers here.
Everything
Enthusiast
Enthusiast
Posts: 224
Joined: Sat Jul 07, 2018 6:50 pm

Need the expert advice

Post by Everything »

Scenario:
A user drag one file from %file manager% and drop it on our application's window. Our application extract the name of the file.
We use standard IDataObject interface to determine the name of the file.

Problem:
IDataObject::GetData (with CF_HDROP + TYMED_HGLOBAL) can't handle file path longer than MAX_PATH (Win7x64)
I may be wrong but it seems that inside OLE some variable defined something like WCHAR cFileName[ MAX_PATH ]

Question:
Is there a workaround?

P.S.
Yes I know that Windows Explorer (at least if OS<Win8.x) can't work with long paths so let's assume that we use as a "drag source" any file manager that supports it. Obviously, our application also knows how to work with them.
Note that I am exclusively interested in drag&drop only (other methods work fine).
Also I'm not sure that standard methods are applicable here, so I hope for tips from people who are familiar with Windows OS internals. Any solutions including low-level APIs, hooks, etc. will do.
BarryG
Addict
Addict
Posts: 3294
Joined: Thu Apr 18, 2019 8:17 am

Re: Need the expert advice

Post by BarryG »

Everything wrote:A user drag one file from %file manager% and drop it on our application's window. Our application extract the name of the file.
We use standard IDataObject interface to determine the name of the file.
Why make it so hard? Just use the DragDrop library -> https://www.purebasic.com/documentation ... index.html

The lib will give you the dropped filenames -> https://www.purebasic.com/documentation ... files.html

Here's a quick example:

Code: Select all

OpenWindow(0,100,200,300,100,"Drag/Drop files onto this window",#PB_Window_SystemMenu)
EnableWindowDrop(0,#PB_Drop_Files,#PB_Drag_Copy)
Repeat
  Event=WaitWindowEvent()
  If Event=#PB_Event_WindowDrop
    Debug EventDropFiles()
  EndIf
Until Event=#PB_Event_CloseWindow
Everything
Enthusiast
Enthusiast
Posts: 224
Joined: Sat Jul 07, 2018 6:50 pm

Re: Need the expert advice

Post by Everything »

BarryG wrote:Just use the DragDrop library
DragDrop library use OLE internally so It is the same thing and have the same problems.
BTW a lot of PB functions on windows also will not work with long paths so I have to use pure WinAPI to deal with it. But that is another story.

I suspect that an error occurs outside our application (at OS level) and the path is already missing (corrupted) in the IDataObject when it is passed to our program.
BarryG
Addict
Addict
Posts: 3294
Joined: Thu Apr 18, 2019 8:17 am

Re: Need the expert advice

Post by BarryG »

Everything wrote:DragDrop library use OLE internally so It is the same thing and have the same problems.
Okay, but I dragged a file whose path and filename was 291 chars (MAX_PATH is 260, so 31 chars longer) and it works because Windows returns the short path name for it:

Code: Select all

OpenWindow(0,100,200,300,100,"Drag/Drop files onto this window",#PB_Window_SystemMenu)
EnableWindowDrop(0,#PB_Drop_Files,#PB_Drag_Copy)
Repeat
  Event=WaitWindowEvent()
  If Event=#PB_Event_WindowDrop
    file$=EventDropFiles()
    Debug file$
    Debug Len(file$)
  EndIf
Until Event=#PB_Event_CloseWindow
Output:

Code: Select all

C:\Temp\LONGFO~1\SECOND~1\THIRDL~1\FOURTH~1\FIFTHL~1\SIXTHL~1\SEVENT~1\EIGHTH~1\NINTHL~1\TENTHL~1\Eleventh\HUMANL~1.MP4
119
Original file path (291 chars) that I dragged onto the window of my code:

Code: Select all

C:\Temp\Long folder name\Second long folder name\Third long folder name\Fourth long folder name\Fifth long folder name\Sixth long folder name\Seventh long folder name\Eighth long folder name\Ninth long folder name\Tenth long folder name\Eleventh\Human League - Don't You Want Me • TopPop.mp4
Seems to be no issue here?
RASHAD
PureBasic Expert
PureBasic Expert
Posts: 4637
Joined: Sun Apr 12, 2009 6:27 am

Re: Need the expert advice

Post by RASHAD »

I just checked D&D using PB lib and OLE method (Win 10 x64)
No problem as BarryG mentioned

But I remember that there was a problem with the Path containing SPACE into it and it should be replaced with Underscore
Check for that.
Egypt my love
Everything
Enthusiast
Enthusiast
Posts: 224
Joined: Sat Jul 07, 2018 6:50 pm

Re: Need the expert advice

Post by Everything »

BarryG wrote:Seems to be no issue here?
In the Windows API, the maximum length for a path is MAX_PATH, which is defined as 260 characters.
With "\\?\" prefix extended-length path for a maximum total path length of 32,767 characters.

Starting in Windows 10, version 1607, MAX_PATH limitations have been removed from common Win32 file and directory functions.
However, you must opt-in to the new behavior. To enable the new long path behavior, both of the following conditions must be met:
The registry key HKLM\SYSTEM\CurrentControlSet\Control\FileSystem LongPathsEnabled (Type: REG_DWORD) must exist and be set to 1

MSDN

As I mentioned we talk about Windows 7 x64 (and according to MSDN it's also about WinXp, Win8 and some earlier Win10 versions).

Here is code to generate "deep path" directory with some files for testing, also it will set clipboard text with last* directory path to paste it in file manager ( just remove last extra folder from string :) )

Code: Select all

Procedure.b Generate(Path.s) 
  #PAEX = "\\?\"
  
  If Right(Path, 1) = "\"
    Path = RTrim(Path,"\")
  EndIf
  
  Protected x
  Protected counter = 0
  Protected LastError
  Protected DirectoryName$ = #PAEX+Path
  Protected hFile
  
  For x = 0 To 100
    counter+1
    If CreateDirectory_(DirectoryName$, 0)
      hFile = CreateFile_(DirectoryName$+"\file.txt", #GENERIC_READ|#GENERIC_WRITE, #FILE_SHARE_READ|#FILE_SHARE_WRITE, 0, #CREATE_NEW, #FILE_ATTRIBUTE_NORMAL, 0)
      If Not hFile = #INVALID_HANDLE_VALUE
        If Not CloseHandle_(hFile)
          Debug "OV CloseHandle_ fail"
          ProcedureReturn #False
        EndIf  
        DirectoryName$+"\subfolder_"+RSet(Str(counter), 8, "0")
      Else
        Debug "OV CreateFile fail: "+DirectoryName$+"\file.txt"
        Debug Len(DirectoryName$);-4
        ProcedureReturn #False
      EndIf   
    Else
      LastError = GetLastError_()
      If LastError = #ERROR_ALREADY_EXISTS
        Debug "OV CreateDirectory ALREADY_EXISTS: "+DirectoryName$
      Else 
        Debug "OV CreateDirectory fail: "+DirectoryName$
      EndIf   
      ProcedureReturn #False
    EndIf 
    
  Next

  SetClipboardText(Mid(DirectoryName$, 5))
  Debug "Path: "+Str(Len(DirectoryName$+"\file.txt"))
  
  ProcedureReturn #True 
EndProcedure

Generate("X:\LongPathDir") 
Everything
Enthusiast
Enthusiast
Posts: 224
Joined: Sat Jul 07, 2018 6:50 pm

Re: Need the expert advice

Post by Everything »

Ok guys, I understand that most of you have the latest OS version and most likely no virtual machine with Windows 7 (which is strange for programmers) so here is different interpretation of the same problem so that you can easily reproduce it and test it in your environment.
Instead of a long path, we can create a file with an "illegal" name. The fact of the name "illegality" does not matter here, it is important that in this situation the same mechanism will work that is the cause of the original problem.

You can do that with cmd:

Code: Select all

echo.>"\\?\X:\   illegal.txt  "
same for zero size:

Code: Select all

REM.>"\\?\X:\   illegal.txt  "
or with PB:

Code: Select all

Define Name$ = "\\?\X:\   illegal.txt  "
Define hFile = CreateFile_(Name$, #GENERIC_READ|#GENERIC_WRITE, #FILE_SHARE_READ|#FILE_SHARE_WRITE, 0, #CREATE_NEW, #FILE_ATTRIBUTE_NORMAL, 0)
If Not hFile = #INVALID_HANDLE_VALUE
  If Not CloseHandle_(hFile)
    Debug "CloseHandle_ fail"
  EndIf  
Else
  Debug "CreateFile fail: "+Name$
EndIf   
Despite the invalid name, we can work with it from our code without any problems (using WinAPI, PB wrappers may not handle it also), but many programs and the Windows shell will have problems with this, so this case suits us perfectly.
Now our goal is to get the full path to the file by dragging it to our application window.
Same problem from a different angle.
breeze4me
Enthusiast
Enthusiast
Posts: 511
Joined: Thu Mar 09, 2006 9:24 am
Location: S. Kor

Re: Need the expert advice

Post by breeze4me »

The following code works with Windows Explorer on Windows 10 home x64(1909).

Code: Select all

; original code by srod
;   http://forums.purebasic.com/english/viewtopic.php?p=436579#p436579
;
; modified by breeze4me


#Window = 0

#AllowDropType_HDROP = 1
#AllowDropType_IDLIST = 2

#CFSTR_SHELLIDLIST = "Shell IDList Array"

Prototype ptSHGetNameFromIDList(*pidl, sigdnName.l, *ppszName)

Structure _IDropTarget
  *vTable
  refCount.i
  blnAllowDrop.i
EndStructure

Structure CIDA
  cidl.l
  aoffset.l[0]
EndStructure

OleInitialize_(0)

Global SHGetNameFromIDList.ptSHGetNameFromIDList

Global CF_IDLIST = RegisterClipboardFormat_(#CFSTR_SHELLIDLIST)

If CF_IDLIST = 0
  End
EndIf


If OpenLibrary(0, "Shell32.dll")
  SHGetNameFromIDList = GetFunction(0, "SHGetNameFromIDList")
  
  If SHGetNameFromIDList
    If OpenWindow(#Window, 0, 0, 800, 600, "Drag & Drop", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
      
      ListIconGadget(0, 5, 5, 790, 590, "test", 500)
      
      *this._IDropTarget = AllocateMemory(SizeOf(_IDropTarget))
      *this\vTable = ?VTable_IDropTarget
      RegisterDragDrop_(GadgetID(0), *this) ; declare our gadget as a potential drop target
      
      Repeat
        Event = WaitWindowEvent()
      Until Event = #PB_Event_CloseWindow
    EndIf
  EndIf
  
  CloseLibrary(0)
EndIf

End


;-Drop enable function.

;-Internal functions.

;/////////////////////////////////////////////////////////////////////////////////
;*pdwEffect guaranteed to be non-null.
Procedure DropTarget_SetEffects(grfKeyState, *pdwEffect.LONG)
  If grfKeyState&#MK_CONTROL
    If *pdwEffect\l & #DROPEFFECT_COPY
      *pdwEffect\l = #DROPEFFECT_COPY
    Else
      *pdwEffect\l = #DROPEFFECT_NONE
    EndIf
  ElseIf *pdwEffect\l & #DROPEFFECT_MOVE
    *pdwEffect\l = #DROPEFFECT_MOVE
  Else
    *pdwEffect\l = #DROPEFFECT_NONE
  EndIf
EndProcedure
;/////////////////////////////////////////////////////////////////////////////////



;-iDropTarget methods.

;/////////////////////////////////////////////////////////////////////////////////
Procedure.i DropTarget_QueryInterface(*this._IDropTarget, iid, *ppvObject.INTEGER)
  Protected result
  If CompareMemory(iid, ?IID_IUnknown, SizeOf(CLSID)) Or CompareMemory(iid, ?IID_IDropTarget, SizeOf(CLSID))
    *ppvObject\i = *this
    *this\refCount + 1
    result = #S_OK
  Else
    *ppvObject\i=0
    result = #E_NOINTERFACE
  EndIf
  ProcedureReturn result
EndProcedure
;/////////////////////////////////////////////////////////////////////////////////


;/////////////////////////////////////////////////////////////////////////////////
Procedure.i DropTarget_AddRef(*this._IDropTarget)
  *this\refCount + 1
  ProcedureReturn 0
EndProcedure
;/////////////////////////////////////////////////////////////////////////////////


;/////////////////////////////////////////////////////////////////////////////////
Procedure.i DropTarget_Release(*this._IDropTarget)
  Protected result
  *this\refCount - 1
  If *this\refCount > 0
    result = *this\refCount
  Else
    FreeMemory(*this)
  EndIf
  ProcedureReturn result
EndProcedure
;/////////////////////////////////////////////////////////////////////////////////


;/////////////////////////////////////////////////////////////////////////////////
Procedure.i DropTarget_DragEnter(*this._IDropTarget, dataObject.IDataobject, grfKeyState, pt.q, *pdwEffect.LONG)
  Protected result=#S_OK, thisFormatEtc.FORMATETC
  *this\blnAllowDrop = #False
  If *pdwEffect = 0
    result = #E_INVALIDARG
  Else
    
;     With thisFormatEtc
;       \cfFormat = #CF_HDROP
;       \dwAspect = #DVASPECT_CONTENT
;       \lindex = -1
;       \tymed = #TYMED_HGLOBAL
;     EndWith
;     
;     If dataObject\QueryGetData(thisFormatEtc) = #S_OK
;       
;       *this\blnAllowDrop = #AllowDropType_HDROP
;       DropTarget_SetEffects(grfKeyState, *pdwEffect)
;       
;     Else
;       *pdwEffect\l = #DROPEFFECT_NONE
;     EndIf
    
    
    With thisFormatEtc
      \cfFormat = CF_IDLIST
      \dwAspect = #DVASPECT_CONTENT
      \lindex = -1
      \tymed = #TYMED_HGLOBAL
    EndWith
    
    If dataObject\QueryGetData(thisFormatEtc) = #S_OK
      
      *this\blnAllowDrop = #AllowDropType_IDLIST
      DropTarget_SetEffects(grfKeyState, *pdwEffect)
      
    Else
      
      With thisFormatEtc
        \cfFormat = #CF_HDROP
        \dwAspect = #DVASPECT_CONTENT
        \lindex = -1
        \tymed = #TYMED_HGLOBAL
      EndWith
      
      If dataObject\QueryGetData(thisFormatEtc) = #S_OK
        
        *this\blnAllowDrop = #AllowDropType_HDROP
        DropTarget_SetEffects(grfKeyState, *pdwEffect)
        
      Else
        *pdwEffect\l = #DROPEFFECT_NONE
      EndIf
    EndIf
    
  EndIf
  ProcedureReturn result
EndProcedure
;/////////////////////////////////////////////////////////////////////////////////


;/////////////////////////////////////////////////////////////////////////////////
Procedure.i DropTarget_DragOver(*this._IDropTarget, grfKeyState, pt.q, *pdwEffect.LONG)
  Protected result = #S_OK
  If *pdwEffect = 0
    result = #E_INVALIDARG
  Else
    If *this\blnAllowDrop
      DropTarget_SetEffects(grfKeyState, *pdwEffect)
    Else
      *pdwEffect\l = #DROPEFFECT_NONE
    EndIf
  EndIf
  ProcedureReturn result
EndProcedure
;/////////////////////////////////////////////////////////////////////////////////


;/////////////////////////////////////////////////////////////////////////////////
Procedure.i DropTarget_DragLeave(*this._IDropTarget)
  ProcedureReturn #S_OK
EndProcedure
;/////////////////////////////////////////////////////////////////////////////////


;/////////////////////////////////////////////////////////////////////////////////
;*pdwEffect\l contains the original combination of effects.
Procedure.i DropTarget_Drop(*this._IDropTarget, Dataobject.IDataobject, grfKeyState, pt.q, *pdwEffect.LONG)
  Protected result = #S_OK, thisFormatEtc.FORMATETC, thisStgMedium.STGMEDIUM, *m, *z.CIDA, *PathString, i, num, BasePath.s
  
  If *pdwEffect = 0
    result = #E_INVALIDARG
    
  ElseIf *this\blnAllowDrop
    
    DropTarget_SetEffects(grfKeyState, *pdwEffect)
    
    If *pdwEffect\l <> #DROPEFFECT_NONE
      
      With thisFormatEtc
        If *this\blnAllowDrop = #AllowDropType_HDROP
          \cfFormat = #CF_HDROP
        Else
          \cfFormat = CF_IDLIST
        EndIf
        
        \dwAspect = #DVASPECT_CONTENT
        \lindex = -1
        \tymed = #TYMED_HGLOBAL
      EndWith
      
      If Dataobject\GetData(thisFormatEtc, thisStgMedium) = #S_OK
        
        If thisStgMedium\hGlobal
          *m = GlobalLock_(thisStgMedium\hGlobal)
          
          If *m
            If *this\blnAllowDrop = #AllowDropType_IDLIST
              
              Debug "IDLIST"
              
              *z = *m
              
              Debug *z\cidl
              
              For i = 0 To *z\cidl
                
                If i = 0
                  
                  ; https://docs.microsoft.com/en-us/windows/win32/api/shobjidl_core/nf-shobjidl_core-shgetnamefromidlist
                  
                  If SHGetNameFromIDList(*z + *z\aoffset[i], $80058000, @*PathString) = #S_OK
                    If *PathString
                      Debug "----- base path -----"
                      
                      BasePath = PeekS(*PathString)
                      
                      If Right(BasePath, 1) <> "\" : BasePath + "\" : EndIf
                      
                      Debug BasePath
                      Debug "---------------------"
                      
                      CoTaskMemFree_(*PathString)
                    EndIf
                  EndIf
                  
                Else
                  If SHGetNameFromIDList(*z + *z\aoffset[i], $80018001, @*PathString) = #S_OK
                    If *PathString
                      Debug "**** child only ****"
                      Debug PeekS(*PathString)
                      
                      CoTaskMemFree_(*PathString)
                    EndIf
                  EndIf
                  
                EndIf
                
              Next
              
            Else
              Debug "HDROP"
              
              *m = GlobalLock_(thisStgMedium\hGlobal)
              
              *PathString = AllocateMemory(32768 * 4)
              
              If *PathString
                num = DragQueryFile_(*m, -1, 0, 0)
                
                If num > 0
                  For i = 0 To num - 1
                    If DragQueryFile_(thisStgMedium\hGlobal, i, *PathString, 32768)
                      Debug PeekS(*PathString)
                    EndIf
                  Next
                EndIf
                
                FreeMemory(*PathString)
              EndIf
              
            EndIf
            
            GlobalUnlock_(thisStgMedium\hGlobal)
          EndIf
          
        EndIf
        
        ReleaseStgMedium_(thisStgMedium)          
        
      Else
        result = #E_FAIL
      EndIf
    EndIf
  EndIf
  
  ProcedureReturn result
EndProcedure
;/////////////////////////////////////////////////////////////////////////////////


DataSection 
  VTable_IDropTarget:
   Data.i @DropTarget_QueryInterface()
   Data.i @DropTarget_AddRef()
   Data.i @DropTarget_Release()
   Data.i @DropTarget_DragEnter()
   Data.i @DropTarget_DragOver()
   Data.i @DropTarget_DragLeave()
   Data.i @DropTarget_Drop()

  CompilerIf Defined(IID_IUnknown, #PB_Label) = 0
    IID_IUnknown:   ;"{00000000-0000-0000-C000-000000000046}"
      Data.l $00000000
      Data.w $0000,$0000
      Data.b $C0,$00,$00,$00,$00,$00,$00,$46 
  CompilerEndIf

  CompilerIf Defined(IID_IDropTarget, #PB_Label) = 0
    IID_IDropTarget:  ;{00000122-0000-0000-C000-000000000046}
      Data.l $00000122
      Data.w $0000,$0000
      Data.b $C0,$00,$00,$00,$00,$00,$00,$46
  CompilerEndIf
EndDataSection
Last edited by breeze4me on Sun Apr 05, 2020 7:32 am, edited 1 time in total.
Everything
Enthusiast
Enthusiast
Posts: 224
Joined: Sat Jul 07, 2018 6:50 pm

Re: Need the expert advice

Post by Everything »

breeze4me wrote:The following code works with Windows Explorer on Windows 10 home x64(1909)
Thanks for the code
Looks like a completely normal use of interfaces, how can this code help?
Do invalid names really work with this code on win10? (because it makes no sense to check long paths on latest Windows builds).

On my Win7 I get the path to my desktop when I drag&drop the file with a long path (and getting a truncated path with illegal name).
Last edited by Everything on Sun Apr 05, 2020 2:47 am, edited 1 time in total.
breeze4me
Enthusiast
Enthusiast
Posts: 511
Joined: Thu Mar 09, 2006 9:24 am
Location: S. Kor

Re: Need the expert advice

Post by breeze4me »

Everything wrote:Do invalid names really work with this code on win10? (because it makes no sense to check long paths on latest Windows builds).
Yes, it works well.
But I have no idea on Windows 7.
BarryG
Addict
Addict
Posts: 3294
Joined: Thu Apr 18, 2019 8:17 am

Re: Need the expert advice

Post by BarryG »

Everything, your Generate(Path.s) procedure that creates the deep path also fails for me on Win 10 when I try to drag one of the deep files onto my code's window, so you're right. I also don't know how to make it work, so for that reason, I'm out.
Everything
Enthusiast
Enthusiast
Posts: 224
Joined: Sat Jul 07, 2018 6:50 pm

Re: Need the expert advice

Post by Everything »

breeze4me wrote:Yes, it works well. But I have no idea on Windows 7.
Thank you again for your code.
Unfortunately, I couldn’t check it on Windows 10, apparently due to some limitations of the virtual machine (vbox) dragging and dropping files does not work (although almost the same code with additional text dragging support allowed me to dragging text with no problem, I don't know why) But since the subject of our discussion are systems earlier than windows 10, let's focus on the fact that unfortunately on windows 7 this solution didn't help...
breeze4me
Enthusiast
Enthusiast
Posts: 511
Joined: Thu Mar 09, 2006 9:24 am
Location: S. Kor

Re: Need the expert advice

Post by breeze4me »

Tested on Windows 7 Pro SP1 x64. (VirtualBox)

Drag&Drop from Windows Explorer to the window. (1 folder and 1 file are selected)
The result is that.
(By the way, subfolder_00000027 cannot be accessible in Windows Explorer)
IDLIST
2
----- base path -----
C:\LONGPA~1\SUBFOL~1\SUBFOL~1\SUBFOL~1\SUBFOL~1\SUBFOL~1\SUBFOL~1\SUBFOL~1\SUBFOL~1\SUBFOL~1\SUBFOL~1\SUBFOL~1\SUBFOL~1\SUBFOL~1\SUBFOL~1\SUBFOL~1\SUBFOL~1\SUBFOL~1\SUBFOL~1\SUBFOL~1\SUBFOL~1\SUBFOL~1\SUBFOL~1\SUBFOL~1\SUBFOL~1\SUBFOL~1\subfolder_00000026\
C:\LongPathDir\subfolder_00000001\subfolder_00000002\subfolder_00000003\subfolder_00000004\subfolder_00000005\subfolder_00000006\subfolder_00000007\subfolder_00000008\subfolder_00000009\subfolder_00000010\subfolder_00000011\subfolder_00000012\subfolder_00000013\subfolder_00000014\subfolder_00000015\subfolder_00000016\subfolder_00000017\subfolder_00000018\subfolder_00000019\subfolder_00000020\subfolder_00000021\subfolder_00000022\subfolder_00000023\subfolder_00000024\subfolder_00000025\subfolder_00000026\
---------------------
**** child only ****
file.txt
**** child only ****
subfolder_00000027

Code: Select all

; original code by srod
;   http://forums.purebasic.com/english/viewtopic.php?p=436579#p436579
;
; modified by breeze4me


#Window = 0

#AllowDropType_HDROP = 1
#AllowDropType_IDLIST = 2

#CFSTR_SHELLIDLIST = "Shell IDList Array"

Prototype ptSHGetNameFromIDList(*pidl, sigdnName.l, *ppszName)
Prototype ptGetLongPathName(lpszShortPath.s, *lpszLongPath, cchBuffer.l)

Structure _IDropTarget
  *vTable
  refCount.i
  blnAllowDrop.i
EndStructure

Structure CIDA
  cidl.l
  aoffset.l[0]
EndStructure

OleInitialize_(0)

Global SHGetNameFromIDList.ptSHGetNameFromIDList
Global GetLongPathName.ptGetLongPathName

Global CF_IDLIST = RegisterClipboardFormat_(#CFSTR_SHELLIDLIST)

If CF_IDLIST = 0
  End
EndIf


If OpenLibrary(0, "Shell32.dll") And OpenLibrary(1, "Kernel32.dll")
  SHGetNameFromIDList = GetFunction(0, "SHGetNameFromIDList")
  GetLongPathName = GetFunction(1, "GetLongPathNameW")
  
  If SHGetNameFromIDList And GetLongPathName
    If OpenWindow(#Window, 0, 0, 800, 600, "Drag & Drop", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
      
      ListIconGadget(0, 5, 5, 790, 590, "test", 500)
      
      *this._IDropTarget = AllocateMemory(SizeOf(_IDropTarget))
      *this\vTable = ?VTable_IDropTarget
      RegisterDragDrop_(GadgetID(0), *this) ; declare our gadget as a potential drop target
      
      Repeat
        Event = WaitWindowEvent()
      Until Event = #PB_Event_CloseWindow
    EndIf
  EndIf
  
  CloseLibrary(0)
  CloseLibrary(1)
EndIf

End


;-Drop enable function.

;-Internal functions.

;/////////////////////////////////////////////////////////////////////////////////
;*pdwEffect guaranteed to be non-null.
Procedure DropTarget_SetEffects(grfKeyState, *pdwEffect.LONG)
  If grfKeyState&#MK_CONTROL
    If *pdwEffect\l & #DROPEFFECT_COPY
      *pdwEffect\l = #DROPEFFECT_COPY
    Else
      *pdwEffect\l = #DROPEFFECT_NONE
    EndIf
  ElseIf *pdwEffect\l & #DROPEFFECT_MOVE
    *pdwEffect\l = #DROPEFFECT_MOVE
  Else
    *pdwEffect\l = #DROPEFFECT_NONE
  EndIf
EndProcedure
;/////////////////////////////////////////////////////////////////////////////////



;-iDropTarget methods.

;/////////////////////////////////////////////////////////////////////////////////
Procedure.i DropTarget_QueryInterface(*this._IDropTarget, iid, *ppvObject.INTEGER)
  Protected result
  If CompareMemory(iid, ?IID_IUnknown, SizeOf(CLSID)) Or CompareMemory(iid, ?IID_IDropTarget, SizeOf(CLSID))
    *ppvObject\i = *this
    *this\refCount + 1
    result = #S_OK
  Else
    *ppvObject\i=0
    result = #E_NOINTERFACE
  EndIf
  ProcedureReturn result
EndProcedure
;/////////////////////////////////////////////////////////////////////////////////


;/////////////////////////////////////////////////////////////////////////////////
Procedure.i DropTarget_AddRef(*this._IDropTarget)
  *this\refCount + 1
  ProcedureReturn 0
EndProcedure
;/////////////////////////////////////////////////////////////////////////////////


;/////////////////////////////////////////////////////////////////////////////////
Procedure.i DropTarget_Release(*this._IDropTarget)
  Protected result
  *this\refCount - 1
  If *this\refCount > 0
    result = *this\refCount
  Else
    FreeMemory(*this)
  EndIf
  ProcedureReturn result
EndProcedure
;/////////////////////////////////////////////////////////////////////////////////


;/////////////////////////////////////////////////////////////////////////////////
Procedure.i DropTarget_DragEnter(*this._IDropTarget, dataObject.IDataobject, grfKeyState, pt.q, *pdwEffect.LONG)
  Protected result=#S_OK, thisFormatEtc.FORMATETC
  *this\blnAllowDrop = #False
  If *pdwEffect = 0
    result = #E_INVALIDARG
  Else
    
;     With thisFormatEtc
;       \cfFormat = #CF_HDROP
;       \dwAspect = #DVASPECT_CONTENT
;       \lindex = -1
;       \tymed = #TYMED_HGLOBAL
;     EndWith
;     
;     If dataObject\QueryGetData(thisFormatEtc) = #S_OK
;       
;       *this\blnAllowDrop = #AllowDropType_HDROP
;       DropTarget_SetEffects(grfKeyState, *pdwEffect)
;       
;     Else
;       *pdwEffect\l = #DROPEFFECT_NONE
;     EndIf
    
    
    With thisFormatEtc
      \cfFormat = CF_IDLIST
      \dwAspect = #DVASPECT_CONTENT
      \lindex = -1
      \tymed = #TYMED_HGLOBAL
    EndWith
    
    If dataObject\QueryGetData(thisFormatEtc) = #S_OK
      
      *this\blnAllowDrop = #AllowDropType_IDLIST
      DropTarget_SetEffects(grfKeyState, *pdwEffect)
      
    Else
      
      With thisFormatEtc
        \cfFormat = #CF_HDROP
        \dwAspect = #DVASPECT_CONTENT
        \lindex = -1
        \tymed = #TYMED_HGLOBAL
      EndWith
      
      If dataObject\QueryGetData(thisFormatEtc) = #S_OK
        
        *this\blnAllowDrop = #AllowDropType_HDROP
        DropTarget_SetEffects(grfKeyState, *pdwEffect)
        
      Else
        *pdwEffect\l = #DROPEFFECT_NONE
      EndIf
    EndIf
    
  EndIf
  ProcedureReturn result
EndProcedure
;/////////////////////////////////////////////////////////////////////////////////


;/////////////////////////////////////////////////////////////////////////////////
Procedure.i DropTarget_DragOver(*this._IDropTarget, grfKeyState, pt.q, *pdwEffect.LONG)
  Protected result = #S_OK
  If *pdwEffect = 0
    result = #E_INVALIDARG
  Else
    If *this\blnAllowDrop
      DropTarget_SetEffects(grfKeyState, *pdwEffect)
    Else
      *pdwEffect\l = #DROPEFFECT_NONE
    EndIf
  EndIf
  ProcedureReturn result
EndProcedure
;/////////////////////////////////////////////////////////////////////////////////


;/////////////////////////////////////////////////////////////////////////////////
Procedure.i DropTarget_DragLeave(*this._IDropTarget)
  ProcedureReturn #S_OK
EndProcedure
;/////////////////////////////////////////////////////////////////////////////////


;/////////////////////////////////////////////////////////////////////////////////
;*pdwEffect\l contains the original combination of effects.
Procedure.i DropTarget_Drop(*this._IDropTarget, Dataobject.IDataobject, grfKeyState, pt.q, *pdwEffect.LONG)
  Protected result = #S_OK, thisFormatEtc.FORMATETC, thisStgMedium.STGMEDIUM, *m, *z.CIDA, *PathString, i, num, BasePath.s, *buf
  
  If *pdwEffect = 0
    result = #E_INVALIDARG
    
  ElseIf *this\blnAllowDrop
    
    DropTarget_SetEffects(grfKeyState, *pdwEffect)
    
    If *pdwEffect\l <> #DROPEFFECT_NONE
      
      With thisFormatEtc
        If *this\blnAllowDrop = #AllowDropType_HDROP
          \cfFormat = #CF_HDROP
        Else
          \cfFormat = CF_IDLIST
        EndIf
        
        \dwAspect = #DVASPECT_CONTENT
        \lindex = -1
        \tymed = #TYMED_HGLOBAL
      EndWith
      
      If Dataobject\GetData(thisFormatEtc, thisStgMedium) = #S_OK
        
        If thisStgMedium\hGlobal
          *m = GlobalLock_(thisStgMedium\hGlobal)
          
          If *m
            If *this\blnAllowDrop = #AllowDropType_IDLIST
              
              Debug "IDLIST"
              
              *z = *m
              
              Debug *z\cidl
              
              For i = 0 To *z\cidl
                
                If i = 0
                  
                  If SHGetNameFromIDList(*z + *z\aoffset[i], $80058000, @*PathString) = #S_OK
                    If *PathString
                      Debug "----- base path -----"
                      
                      BasePath = PeekS(*PathString)
                      
                      If Right(BasePath, 1) <> "\" : BasePath + "\" : EndIf
                      
                      Debug BasePath
                      
                      *buf = AllocateMemory(32768 * 4)
                      If *buf
                        GetLongPathName(BasePath, *buf, 32768)
                        Debug PeekS(*buf)
                        
                        FreeMemory(*buf)
                      EndIf
                      
                      Debug "---------------------"
                      
                      CoTaskMemFree_(*PathString)
                    EndIf
                  EndIf
                  
                Else
                  
                  If SHGetNameFromIDList(*z + *z\aoffset[i], $80018001, @*PathString) = #S_OK
                    If *PathString
                      Debug "**** child only ****"
                      Debug PeekS(*PathString)
                      
                      CoTaskMemFree_(*PathString)
                    EndIf
                  EndIf
                  
                EndIf
                
              Next
              
            Else
              Debug "HDROP"
              
              *m = GlobalLock_(thisStgMedium\hGlobal)
              
              *PathString = AllocateMemory(32768 * 4)
              
              If *PathString
                num = DragQueryFile_(*m, -1, 0, 0)
                
                If num > 0
                  For i = 0 To num - 1
                    If DragQueryFile_(thisStgMedium\hGlobal, i, *PathString, 32768)
                      Debug PeekS(*PathString)
                    EndIf
                  Next
                EndIf
                
                FreeMemory(*PathString)
              EndIf
              
            EndIf
            
            GlobalUnlock_(thisStgMedium\hGlobal)
          EndIf
          
        EndIf
        
        ReleaseStgMedium_(thisStgMedium)          
        
      Else
        result = #E_FAIL
      EndIf
    EndIf
  EndIf
  
  ProcedureReturn result
EndProcedure
;/////////////////////////////////////////////////////////////////////////////////


DataSection 
  VTable_IDropTarget:
   Data.i @DropTarget_QueryInterface()
   Data.i @DropTarget_AddRef()
   Data.i @DropTarget_Release()
   Data.i @DropTarget_DragEnter()
   Data.i @DropTarget_DragOver()
   Data.i @DropTarget_DragLeave()
   Data.i @DropTarget_Drop()

  CompilerIf Defined(IID_IUnknown, #PB_Label) = 0
    IID_IUnknown:   ;"{00000000-0000-0000-C000-000000000046}"
      Data.l $00000000
      Data.w $0000,$0000
      Data.b $C0,$00,$00,$00,$00,$00,$00,$46 
  CompilerEndIf

  CompilerIf Defined(IID_IDropTarget, #PB_Label) = 0
    IID_IDropTarget:  ;{00000122-0000-0000-C000-000000000046}
      Data.l $00000122
      Data.w $0000,$0000
      Data.b $C0,$00,$00,$00,$00,$00,$00,$46
  CompilerEndIf
EndDataSection
Everything
Enthusiast
Enthusiast
Posts: 224
Joined: Sat Jul 07, 2018 6:50 pm

Re: Need the expert advice

Post by Everything »

breeze4me wrote:Tested on Windows 7 Pro SP1 x64. (VirtualBox)
Drag&Drop from Windows Explorer to the window. (1 folder and 1 file are selected)
(By the way, subfolder_00000027 cannot be accessible in Windows Explorer)
You can select just a file, but you must select it from subfolder_00000099
Windows explorer can't handle long paths on Win7 so you need to use some other file manager to be able to open last folder (like XYPFree)
breeze4me
Enthusiast
Enthusiast
Posts: 511
Joined: Thu Mar 09, 2006 9:24 am
Location: S. Kor

Re: Need the expert advice

Post by breeze4me »

Everything wrote:You can select just a file, but you must select it from subfolder_00000099
Windows explorer can't handle long paths on Win7 so you need to use some other file manager to be able to open last folder (like XYPFree)
It seems that there is an internal problem with XYplorer.
If you drag&drop "...subfolder_00000100\file.txt" from XYplorer to Explorer to make a shortcut link, then "Desktop - Shortcut" file is made by Explorer. And the target is "C:\Users\J_VM\Desktop" in Properties.

The result is same with "...subfolder_00000027\file.txt, ...subfolder_00000028\file.txt ......", but a normal shortcut file is made with "...subfolder_00000026\file.txt, ...000025\......".

Or it may be an internal limitation of Windows 7 that cannot be overcome.

Interestingly, an error occurs even in internal drag&drop of XYplorer.(from XYplorer to XYplorer)
---------------------------
XYplorerFree 17.40.0100
---------------------------
Nothing to drop.
---------------------------
OK
---------------------------
Post Reply