' ========================================================================================
' Gets the path and file name of a Shell link object.
' - wszLinkPath = The path of the link object.
' Example: ? AfxGetLinkTargetPath("C:\Users\Pepe\Desktop\Lynx.lnk")
' ========================================================================================
FUNCTION AfxGetLinkTargetPath (BYREF wszLinkPath AS WSTRINGZ) AS WSTRING
' // Create an instance of the IShellLink interface
LOCAL pSlk AS IShellLinkW
pSlk = NEWCOM CLSID $CLSID_ShellLink
IF ISNOTHING (pSlk) THEN EXIT FUNCTION
' // The IShellLink Interface supports the IPersistFile
' // interface. Get an interface pointer to it.
LOCAL ppf AS IPersistFile
ppf = pSlk
IF ISNOTHING(ppf) THEN EXIT FUNCTION
' // Load the file
LOCAL hr AS LONG
ppf.Load(wszLinkPath, %STGM_READ)
IF SUCCEEDED(hr) THEN
' // Resolve the link by calling the Resolve method.
' // This enables us to find the file the link points to even if
' // it has been moved or renamed.
pSlk.Resolve(0, %SLR_ANY_MATCH OR %SLR_NO_UI)
' // Get the path of the file the link points to.
LOCAL wszPath AS WSTRINGZ * %MAX_PATH
LOCAL wfd AS WIN32_FIND_DATAW
hr = pSlk.GetPath(wszPath, %MAX_PATH, wfd, %SLGP_UNCPRIORITY)
IF SUCCEEDED(hr) THEN FUNCTION = wszPath
END IF
END FUNCTION
' ========================================================================================
'________________________________________________________________________________________
'
' Drag/Drop functions
' -------------------
'
' Simple demonstration of how to accept "dragged" files on your window of choice.
' NEW: Now also allows for right-click "pasting" of files.
'
' By Kevin G. Peel, KGP Software. 2003.
'
' Posted: July 2006.
' Mar 2010: Moved DragFinish() call to WM_DROPFILES to solve memory corruption error.
'
' [URL]http://www.kgpsoftware.com[/URL].
'________________________________________________________________________________________
#Compile Exe
#Dim All
#Register All
$APPTITLE = "DragDrop Example"
%USEMACROS = 1
#Include "win32api.inc"
Declare Function Sub1(p1 As Any) As Dword
Declare Function Sub2(p1 As Any, p2 As Any) As Dword
Declare Function Sub3(p1 As Any, p2 As Any, p3 As Any) As Dword
Declare Function Sub5(p1 As Any, p2 As Any, p3 As Any, p4 As Any, p5 As Any) As Dword
'------------------------------------------------------------------------------
' Returns details from a link (LNK) file, based on iType.
' 1 = link file name, 2 = link path name, 3 = link parameters
'
' Note: parts of the following function were found on PB forum,
' so credit goes to the original authors.
'------------------------------------------------------------------------------
Function GetLinkInfo(ByVal sLinkPath As String, ByVal nType As Long) As String
Local CLSCTX_INPROC_SERVER As Dword, CLSID_ShellLink As GUIDAPI
Local FileData As WIN32_FIND_DATA, Flags As Dword
Local IID_IShellLink As GUIDAPI, IID_Persist As String * 16
Local lResult As Dword, outvalue As Asciiz * %MAX_PATH, nRet As Long
Local pp As Dword Ptr, ppf As Dword Ptr, psl As Dword Ptr
Local TmpAsciiz As Asciiz * %MAX_PATH, TmpWide As Asciiz * (%MAX_PATH*2)
Poke$ VarPtr(CLSID_ShellLink), Mkl$(&H00021401) + Chr$(0, 0, 0, 0, &HC0, 0, 0, 0, 0, 0, 0, &H46)
Poke$ VarPtr(IID_IShellLink), Mkl$(&H000214EE) + Chr$(0, 0, 0, 0, &HC0, 0, 0, 0, 0, 0, 0, &H46)
IID_Persist = Mkl$(&H0000010B) + Chr$(0, 0, 0, 0, &HC0, 0, 0, 0, 0, 0, 0, &H46)
CLSCTX_INPROC_SERVER = 1
nRet = CoCreateInstance(CLSID_ShellLink, ByVal %NULL, CLSCTX_INPROC_SERVER, IID_IShellLink, psl)
If (nRet = %S_Ok) Then
pp = @psl
Call Dword @pp Using Sub3(ByVal psl, IID_Persist, ppf) To lResult
TmpAsciiz = sLinkPath
MultiByteToWideChar %CP_ACP, 0, TmpAsciiz, -1, ByVal VarPtr(TmpWide), %MAX_PATH
pp = @ppf + 20
Call Dword @pp Using Sub3(ByVal ppf, TmpWide, ByVal %True)
Select Case nType
Case 2
pp = @psl + 32
Call Dword @pp Using Sub3(ByVal psl, outvalue, ByVal %MAX_PATH)
Case 3
pp = @psl + 40
Call Dword @pp Using Sub3(ByVal psl, outvalue, ByVal %MAX_PATH)
Case Else
pp = @psl + 12
Call Dword @pp Using Sub5(ByVal psl, outvalue, ByVal %MAX_PATH, FileData, Flags)
End Select
' Release the persistant file
pp = @ppf + 8
Call Dword @pp Using Sub1(ByVal ppf)
' Unbind the shell link object from the persistent file
pp = @psl + 8
Call Dword @pp Using Sub1(ByVal psl)
Function = outValue
End If
End Function
'------------------------------------------------------------------------------
' Return a list of drag/drop filenames, separated by | (See WM_DROPFILES message)
' Note: this function also finishes the specified drag/drop operation.
'------------------------------------------------------------------------------
Function GetDropFiles(ByVal hDropParam As Dword) As String
Local sDropFiles As String, sFile As String, i As Long
For i = 0 To DragQueryFile(hDropParam, &HFFFFFFFF&, "", 0)-1
sFile = Space$(DragQueryFile(hDropParam, i, "", 0)+1)
DragQueryFile hDropParam, i, ByVal StrPtr(sFile), Len(sFile)
sFile = Left$(sFile, Len(sFile)-1)
If UCase$(Right$(sFile, 4)) = ".LNK" Then sFile = GetLinkInfo(sFile, 1)
sDropFiles = sDropFiles + sFile + "|"
Next i
Function = RTrim$(sDropFiles, "|")
End Function
'------------------------------------------------------------------------------
' Callback procedure for main dialog.
'------------------------------------------------------------------------------
CallBack Function dlgDropExample
Local sFiles As String, pDrop As Dword
Select Case CbMsg
Case %WM_DROPFILES
' Test for files "dragged" onto window...
pDrop = CbWParam
sFiles = GetDropFiles(pDrop)
' Free handle...
DragFinish(CbWParam)
If Len(sFiles) Then
' Display list of files "dropped"...
Replace "|" With $CrLf In sFiles
MessageBox CbHndl, "Files dropped onto the dialog: " + $CrLf + $CrLf + sFiles, $APPTITLE, %MB_IconInformation
End If
Case %WM_RButtonUp
' Test for files on clipboard (paste-like operation)...
OpenClipBoard 0
pDrop = GetClipboardData(%CF_HDrop)
sFiles = GetDropFiles(pDrop)
CloseClipboard
If Len(sFiles) Then
' Display list of files "dropped"...
Replace "|" With $CrLf In sFiles
MessageBox CbHndl, "Files pasted into the dialog: " + $CrLf + $CrLf + sFiles, $APPTITLE, %MB_IconInformation
End If
End Select
End Function
'------------------------------------------------------------------------------
' Program Start Point
'------------------------------------------------------------------------------
Function PBMain
Local hDlg As Dword
Dialog New %HWND_Desktop, $APPTITLE, , , 250, 150, %WS_OverlappedWindow To hDlg
Control Add Label, hDlg, 100, "Drag a file onto this dialog from explorer or right click with some copied files to display them...", 10, 10, 150, 35
DragAcceptFiles hDlg, %TRUE
Dialog Show Modal hDlg Call dlgDropExample
End Function
'________________________________________________________________________________________
'
' Drag/Drop functions
' -------------------
'
' Simple demonstration of how to accept "dragged" files on your window of choice.
' [b]NEW: Now also allows for right-click "pasting" of files.[/b]
'
' By Kevin G. Peel, KGP Software. 2003. Posted: July 2006.
' [url="http://www.kgpsoftware.com."]http://www.kgpsoftware.com.[/url]
'________________________________________________________________________________________
#Compile Exe
#Dim All
#Register All
$APPTITLE = "DragDrop Example"
%USEMACROS = 1
#Include "win32api.inc"
Declare Function Sub1(p1 As Any) As Dword
Declare Function Sub2(p1 As Any, p2 As Any) As Dword
Declare Function Sub3(p1 As Any, p2 As Any, p3 As Any) As Dword
Declare Function Sub5(p1 As Any, p2 As Any, p3 As Any, p4 As Any, p5 As Any) As Dword
'------------------------------------------------------------------------------
' Returns details from a link (LNK) file, based on iType.
' 1 = link file name, 2 = link path name, 3 = link parameters
'
' Note: parts of the following function were found on PB forum,
' so credit goes to the original authors.
'------------------------------------------------------------------------------
Function GetLinkInfo(ByVal sLinkPath As String, ByVal nType As Long) As String
Local CLSCTX_INPROC_SERVER As Dword, CLSID_ShellLink As GUIDAPI
Local FileData As WIN32_FIND_DATA, Flags As Dword
Local IID_IShellLink As GUIDAPI, IID_Persist As String * 16
Local lResult As Dword, outvalue As Asciiz * %MAX_PATH, nRet As Long
Local pp As Dword Ptr, ppf As Dword Ptr, psl As Dword Ptr
Local TmpAsciiz As Asciiz * %MAX_PATH, TmpWide As Asciiz * (%MAX_PATH*2)
Poke$ VarPtr(CLSID_ShellLink), Mkl$(&H00021401) + Chr$(0, 0, 0, 0, &HC0, 0, 0, 0, 0, 0, 0, &H46)
Poke$ VarPtr(IID_IShellLink), Mkl$(&H000214EE) + Chr$(0, 0, 0, 0, &HC0, 0, 0, 0, 0, 0, 0, &H46)
IID_Persist = Mkl$(&H0000010B) + Chr$(0, 0, 0, 0, &HC0, 0, 0, 0, 0, 0, 0, &H46)
CLSCTX_INPROC_SERVER = 1
nRet = CoCreateInstance(CLSID_ShellLink, ByVal %NULL, CLSCTX_INPROC_SERVER, IID_IShellLink, psl)
If (nRet = %S_OK) Then
pp = @psl
Call Dword @pp Using Sub3(ByVal psl, IID_Persist, ppf) To lResult
TmpAsciiz = sLinkPath
MultiByteToWideChar %CP_ACP, 0, TmpAsciiz, -1, ByVal VarPtr(TmpWide), %MAX_PATH
pp = @ppf + 20
Call Dword @pp Using Sub3(ByVal ppf, TmpWide, ByVal %True)
Select Case nType
Case 2
pp = @psl + 32
Call Dword @pp Using Sub3(ByVal psl, outvalue, ByVal %MAX_PATH)
Case 3
pp = @psl + 40
Call Dword @pp Using Sub3(ByVal psl, outvalue, ByVal %MAX_PATH)
Case Else
pp = @psl + 12
Call Dword @pp Using Sub5(ByVal psl, outvalue, ByVal %MAX_PATH, FileData, Flags)
End Select
' Release the persistant file
pp = @ppf + 8
Call Dword @pp Using Sub1(ByVal ppf)
' Unbind the shell link object from the persistent file
pp = @psl + 8
Call Dword @pp Using Sub1(ByVal psl)
Function = outValue
End If
End Function
'------------------------------------------------------------------------------
' Return a list of drag/drop filenames, separated by | (See WM_DROPFILES message)
' Note: this function also finishes the specified drag/drop operation.
'------------------------------------------------------------------------------
Function GetDropFiles(ByVal hDropParam As Dword) As String
Local sDropFiles As String, sText As String, i As Long
For i = 0 To DragQueryFile(hDropParam, &HFFFFFFFF&, "", 0)-1
sText = Space$(DragQueryFile(hDropParam, i, "", 0)+1)
DragQueryFile hDropParam, i, ByVal StrPtr(sText), Len(sText)
sText = Left$(sText, Len(sText)-1)
If UCase$(Right$(sText, 4)) = ".LNK" Then sText = GetLinkInfo(sText, 1)
sDropFiles = sDropFiles + sText + "|"
Next i
DragFinish hDropParam
Function = RTrim$(sDropFiles, "|")
End Function
'------------------------------------------------------------------------------
' Callback prcoedure for main dialog.
'------------------------------------------------------------------------------
CallBack Function dlgDropExample
Local sFiles As String, pDrop As Dword
Select Case CbMsg
Case %WM_DROPFILES
' Test for files "dragged" onto window...
pDrop = CbWParam
sFiles = GetDropFiles(pDrop)
If Len(sFiles) Then
' Display list of files "dropped"...
Replace "|" With $CrLf In sFiles
MessageBox CbHndl, "Files dropped onto the dialog: " + $CrLf + $CrLf + sFiles, $APPTITLE, %MB_ICONINFORMATION
End If
Case %WM_RBUTTONUP
' Test for files on clipboard (paste-like operation)...
OpenClipBoard 0
pDrop = GetClipboardData(%CF_HDROP)
sFiles = GetDropFiles(pDrop)
CloseClipboard
If Len(sFiles) Then
' Display list of files "dropped"...
Replace "|" With $CrLf In sFiles
MessageBox CbHndl, "Files pasted into the dialog: " + $CrLf + $CrLf + sFiles, $APPTITLE, %MB_ICONINFORMATION
End If
End Select
End Function
'------------------------------------------------------------------------------
' Program Start Point
'------------------------------------------------------------------------------
Function PBMain
Local hDlg As Dword
Dialog New %HWND_DESKTOP, $APPTITLE, , , 250, 150, %WS_OVERLAPPEDWINDOW To hDlg
Control Add Label, hDlg, 100, "Drag a file onto this dialog from explorer or right click with some copied files to display them...", 10, 10, 150, 35
DragAcceptFiles hDlg, %TRUE
Dialog Show Modal hDlg Call dlgDropExample
End Function
Leave a comment: