I am trying to obtain the path from inside of Windows shortcut files (.lnk). I am using VB6 (mandatory) and API. Was suggested to me for that to use functions from ole32.dll and shell32.dll. I had declared CLSID_ShellLink, IID_IShellLink, IID_IShellLinkA, IID_IPersistFile, also the table IShellLinkVtbl and other various as such:
Private Const MAX_PATH As Long = 260
Private Const S_OK As Long = 0
Private Const CLSCTX_INPROC_SERVER As Long = 1
Private Declare Function CoCreateInstance Lib "ole32.dll" ( _
ByRef rclsid As Any, ByVal pUnkOuter As Long, _
ByVal dwClsContext As Long, ByRef riid As Any, _
ByRef ppv As Any) As Long
Private Declare Function CLSIDFromString Lib "ole32.dll" ( _
ByVal lpsz As Long, ByRef pclsid As GUID) As Long
Private Declare Function DispCallFunc Lib "oleaut32.dll" ( _
ByVal pvInstance As Long, ByVal oVft As Long, ByVal cc As Long, _
ByVal vtReturn As Integer, ByVal cActuals As Long, _
ByRef prgvt As Any, ByRef prgpvarg As Any, _
ByRef pvargResult As Any) As Long
' Required GUIDs
Private Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(7) As Byte
End Type
' CLSID and IID Definitions
Private Const CLSID_ShellLink As String = "{00021401-0000-0000-C000-000000000046}"
Private Const IID_IShellLinkA As String = "{000214EE-0000-0000-C000-000000000046}"
Private Const IID_IPersistFile As String = "{0000010B-0000-0000-C000-000000000046}"
and
Private Type IShellLinkA
lpVtbl As Long
End Type
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
ByRef Destination As Any, _
ByRef Source As Any, _
ByVal Length As Long)
'IShellLink and IPersistFile Interface Pointers
Private Type IShellLinkVtbl
QueryInterface As Long
AddRef As Long
Release As Long
GetPath As Long
GetIDList As Long
SetIDList As Long
GetDescription As Long
SetDescription As Long
GetWorkingDirectory As Long
SetWorkingDirectory As Long
GetArguments As Long
SetArguments As Long
GetHotkey As Long
SetHotkey As Long
GetShowCmd As Long
SetShowCmd As Long
GetIconLocation As Long
SetIconLocation As Long
SetRelativePath As Long
Resolve As Long
SetPath As Long
End Type
Public Type IShellLink
lpVtbl As Long
End Type
Private Type IPersistFile
lpVtbl As Long
End Type
Private Type QueryInterfacePtr
pQueryInterface As Long
End Type
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" ( _
ByVal lpPrevWndFunc As Long, _
ByVal hWnd As Long, _
ByVal Msg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long _
) As Long
Public Declare Function CallStdFunction Lib "user32" Alias "CallWindowProcA" ( _
ByVal lpFunction As Long, _
ByVal This As Long, _
ByVal riid As Long, _
ByVal ppv As Long, _
ByVal unused As Long _
) As Long
'Private Declare Function CoInitialize Lib "ole32.dll" (ByVal pvReserved As Long) As Long
'Private Declare Sub CoUninitialize Lib "ole32.dll" ()
Private Declare Function OleInitialize Lib "ole32.dll" (ByVal pvReserved As Long) As Long
Private Declare Sub OleUninitialize Lib "ole32.dll" ()
My function to get the path from inside a shortcut file looks like this:
' Function to resolve shortcut
Public Function GetShortcutTarget(ByVal ShortcutPath As String) As String
' Stop
' Initialize COM
OleInitialize 0
' 'CoInitialize (Null) - not necessary? because apparently is initialized inside OleInitialize
' hres = CoInitialize(0)
' Debug.Print "CoInitialize result: "; Hex(hres)
' Convert GUID strings to actual GUIDs
Dim clsidShellLink As GUID
Dim iidShellLink As GUID 'reference to the identifier of the interface to be used to communicate with the object
Dim iidPersistFile As GUID
CLSIDFromString StrPtr(CLSID_ShellLink), clsidShellLink
CLSIDFromString StrPtr(IID_IShellLinkA), iidShellLink
CLSIDFromString StrPtr(IID_IPersistFile), iidPersistFile
' Create ShellLink object
Dim hres As Long
Dim psl As IShellLink
Stop
hres = CoCreateInstance(clsidShellLink, 0, _
CLSCTX_INPROC_SERVER, iidShellLink, psl)
If hres <> S_OK Then OleUninitialize: Exit Function
DebugPrint_VtableDump psl'calling a separat sub to display table dump
Stop
'TEST ONLY!
Dim pAddRef As Long
CopyMemory pAddRef, ByVal (psl.lpVtbl + 4), 4 ' VTable[1] = AddRef
Debug.Print "Calling AddRef at address: "; Hex(pAddRef)
hres = CallStdFunction(pAddRef, ByVal VarPtr(psl), 0, 0, 0) ' Pass the actual pointer
Debug.Print "AddRef Result: "; Hex(hres)
'==========0000
'
'
'
End Function
The rest of the function is not relevant because is beynd the crash point. Visual basic crashes when calling CallStdFunction. What is happening?
I am putting the table dump here, for you to look into addresses. Appear to be valid, because addreses looks like they are cose to each other, but I have not at all experience with ole32 and shell32 neither with callstdfunction to say.... Dump:
psl.lpVtbl = &H7BA19C; dec = 8102300
VTable Dump:
VTable[ 0 ]: &H741A42C8; dec = 1947878088
VTable[ 1 ]: &H741A4274; dec = 1947878004
VTable[ 2 ]: &H741A4254; dec = 1947877972
VTable[ 3 ]: &H741A4244; dec = 1947877956
VTable[ 4 ]: &H741A4220; dec = 1947877920
VTable[ 5 ]: &H741A4210; dec = 1947877904
VTable[ 6 ]: &H741A41F0; dec = 1947877872
VTable[ 7 ]: &H741A41D4; dec = 1947877844
VTable[ 8 ]: &H741A41C0; dec = 1947877824
VTable[ 9 ]: &H741A41A0; dec = 1947877792
VTable[ 10 ]: &H741A418C; dec = 1947877772
pRelease address: 741A4254
pGetPath: 741A4210
pRelease: 741A4254
- so, why Visual basic crashes when calling CallStdFunction?
- Is it correct to use this syntax? both for CopyMemory andCallStdFunction?
CopyMemory pAddRef, ByVal (psl.lpVtbl + 4), 4 ' VTable[1] = AddRef
hres = CallStdFunction(pAddRef, ByVal VarPtr(psl), 0, 0, 0) ' Pass the actual pointer