Drop and Run App

Category: Application Features

Date: 03-28-2012

Return to Index


 
'... this snippet is in work
 
'Compilable Example:
#Compiler PBWin 9, PBWin 10
#Compile EXE
#Dim All
#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) = ".lnkThen 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 DwordAs 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


created by gbSnippets
http://www.garybeene.com/sw/gbsnippets.htm