Date: 02-16-2022
Return to Index
created by gbSnippets
'Compilable Example: (Jose Includes)
'Based on Florent Heyworth's PB code and MSDN
'Original code for writing of links from Semen Matusovski
'Modified by George Bleck for reading of links
#Compiler PBWin 9, PBWin 10
#Compile EXE
#Dim All
%Unicode=1
#Register None
#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
Function PBMain
? GetLinkInfo ("C:\users\gary\desktop\axialis iconworkshop.lnk")
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
Local pp, ppf, psl As Dword Ptr
Local TmpAsciiz As Asciiz * %MAX_PATH
Local TmpWide As Asciiz * ( 2 * %MAX_PATH )
Local outvalue As Asciiz * %Max_Path '128
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
CoInitialize ByVal %NULL
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
CoUninitialize
End Function
'gbs_00751
'Date: 03-10-2012
http://www.garybeene.com/sw/gbsnippets.htm