Date: 02-16-2022
Return to Index
created by gbSnippets
'... this snippet is in work
'Compilable Example: (Jose Includes)
#Compiler PBWin 9, PBWin 10
#Compile EXE
#Dim All
%Unicode=1
#Include "Win32API.inc"
%IDC_Button = 500 : %IDC_TextBox = 501
$CLSID_ShellLink = Guid$("{00021401-0000-0000-C000-000000000046}")
$IID_IShellLink = Guid$("{000214EE-0000-0000-C000-000000000046}")
$IID_IPersistFile = Guid$("{0000010B-0000-0000-C000-000000000046}")
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
Global hDlg As Dword, fName As String
Function PBMain() As Long
Local style&
style& = %WS_TabStop Or %WS_Border Or %ES_Left Or %ES_AutoHScroll _
Or %ES_MultiLine Or %ES_NoHideSel Or %ES_WantReturn
Dialog New Pixels, 0, "Drop Test",300,300,500,100, %WS_OverlappedWindow To hDlg
Control Add Button, hDlg, %IDC_Button, "Run", 10,10,100,25
Control Add TextBox, hDlg, %IDC_TextBox, "", 10,40,480,50, style&
DragAcceptFiles hDlg, %True
Dialog Show Modal hDlg Call DlgProc
End Function
CallBack Function DlgProc() As Long
Local i,j,iResult As Long, temp$
Select Case Cb.Msg
Case %WM_Command
If Cb.Ctl = %IDC_Button And Cb.CtlMsg = %BN_Clicked Then
iResult = ShellExecute(hDlg, "Open", (fName), $Nul, $Nul, %SW_ShowNormal)
End If
Case %WM_DropFiles
temp$ = GetDroppedFileName(Cb.WParam)
DragFinish Cb.WParam
i = InStr(temp$,"%")
j = InStr(i,temp$,"%")
If i Then temp$ = Left$(temp$,i-1) + "Environ$(" + Mid$(temp$,i+1,j-i) + ")" + Mid$(temp$,j+1)
If Right$(temp$,4) = ".lnk" Then fName = LCase$(GetLinkInfo(temp$))
If Len(fName) Then
Control Set Text hDlg,%IDC_TextBox, (temp$ + $CrLf + fName)
Else
Control Set Text hDlg,%IDC_TextBox, (temp$ + $CrLf + "<no link path returned>")
End If
End Select
End Function
Function GetDroppedFileName(hDrop As Dword) As String
'David Gwillim July 2005
Local fString As Asciiz*%Max_Path, iCount As Long
fString=Space$(%Max_Path)
iCount = DragQueryFile(hDrop,0,fString,Len(fString)-1) ' put FileName(0) into fString and get character count
Function = Left$(fString,iCount) ' put Count chars into result string
End Function
Function GetLinkInfo(LinkPath As String ) As String
Local CLSID_ShellLink, IID_IShellLink As GUIDAPI
Local CLSCTX_INPROC_SERVER, Flags, lResult As Dword
Local FileData As WIN32_FIND_DATA
Local IID_Persist As String * 16, pp, ppf, psl As Dword Ptr
Local outvalue, TmpAsciiz As Asciiz * %Max_Path
Local TmpWide As Asciiz * ( 2 * %Max_Path )
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
If IsFalse( CoCreateInstance(CLSID_ShellLink, ByVal %NULL, CLSCTX_INPROC_SERVER, IID_IShellLink, psl )) Then
pp = @psl: Call Dword @pp Using Sub3( ByVal psl, IID_Persist, ppf ) To lResult
TmpAsciiz = LinkPath
MultiByteToWideChar %CP_ACP, 0, TmpAsciiz, %Max_Path, ByVal VarPtr(TmpWide), 2 * %Max_Path
pp = @ppf + 20: Call Dword @pp Using Sub3( ByVal ppf, TmpWide, ByVal %TRUE )
pp = @psl + 12: Call Dword @pp Using Sub5( ByVal psl, outvalue, ByVal %Max_Path, FileData, Flags ) 'GetFilePath
pp = @ppf + 8: Call Dword @pp Using Sub1( ByVal ppf ) 'Release the persistant file
pp = @psl + 8: Call Dword @pp Using Sub1( ByVal psl ) 'Unbind the shell link object from the persistent file
Function = outvalue
End If
End Function
'gbs_00732
'Date: 03-10-2012
http://www.garybeene.com/sw/gbsnippets.htm