Visual Basic 6 crashes when executing API CallStdFunction

[addyanto]

I am trying to obtain the path from inside of Windows shortcut files (.lnk). I am using VB6 (mandatory) and API. Windows 10 on the computer.

For this was suggested to me 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}"

continued in the next post; (I am trying to split because the forum returned error 403 when tried first time to post these)

[addyanto]

Continued from the first post...

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" ()

Continue in the next post, same error 403 from the forum.

[addyanto]

My function (until crash point) 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 beyond the crash point. Visual basic crashes when calling CallStdFunction. What is happening?

[addyanto]

I am putting the table dump here, for you to look into addresses. Appear to be valid, because addresses looks like they are close to each other, but I have not at all experience with ole32 and shell32 neither with callstdfunction to say... I do have experience with API but not these; also, I am not really clear about correct use of CopyMemory .. I tried both byref and byval, both crashed, but not when CopyMemory, looks more like there is something related with callstdfunction

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

i am specifically refer to passing the psl.lpVtbl ByValue to CopyMemory.... also please advice refer to CallStdFunction, why may be crashing VB?

[wqweto]

No, you cannot declare Dim psl As IShellLink and use it w/ CoCreateInstance like this. CoCreateInstance last (out) parameter expects a pointer i.e. psl As Long

To get the VTable from this pointer you have to manually dereference it once to get lpVTable (yet another pointer) which you can index i.e. at lpVTable[1] is the address of AddRef function you are trying to call.

Why do you want to call AddRef manually? CoCreateInstance did it once for you, why do you want to call it second time? Usually you don't have to, usually calling QueryInterface does call AddRef internally so most code just calls QI only.

Moreover in VB6 you can use stdole.IUnknown in place of interface pointers i.e. in place of last (out) parameter of CoCreateInstance and forget about AddRef/Release calls. Just use this pUnk as normal VB6 reference in your code, use ObjPtr(pUnk) to get the pointer as Long if you have to dereference it etc. use Set pUnk = Nothing to call Release behind the scenes or let it go our of scope and VB6 will call Release for you as it does for every other reference in your code.

cheers,
</wqw>

[AdorablePlum]

I use this function

Function GetTargetPath(ByVal FileName As String)
Dim Obj As Object
Set Obj = CreateObject("WScript.Shell")
Dim Shortcut As Object
On Error Resume Next
Set Shortcut = Obj.CreateShortcut(FileName)
GetTargetPath = Shortcut.TargetPath
End Function

[addyanto]

Why do you want to call AddRef manually? CoCreateInstance did it once for you, why do you want to call it second time?
</wqw>

That was only a test; I normally tried first to call "QueryInterface" (first function in the table), then call "Load" the shortcut file, then"Resolve" (Resolve is the 19th method in IShellLink vtable) etc. But VB6 crashes, so i tried with simpler and simpler functions to see if/why crashes; and crashes.
From what you said, appears that there is a problem with psl As IShellLink; please, can you give me the correct way? I will use a temp variable as long, but how to obtain the table address and functions addresses from it?

[addyanto]

I use this function
...........

Wow, it worked!
So, I will try to test this further, to see if works in most cases possible.
Thanks/ Many thanks!

[wqweto]

From what you said, appears that there is a problem with psl As IShellLink; please, can you give me the correct way? I will use a temp variable as long, but how to obtain the table address and functions addresses from it?

Did you try using oleexp first?

It has all the interfaces and coclasses you are trying to use declared already.

You have to use this TLB only in IDE. Once code is compiled you don't have to ship the TLB file to your end users.

cheers,
</wqw>

[addyanto]

Did you try using oleexp first?......
.... you don't have to ship the TLB file to your end users.

</wqw>

No, didn't heard about it till now; i'll look into it today.
No end users, am programming mostly /only for me (and some close friends, sometimes).

[addyanto]

No, you cannot declare Dim psl As IShellLink and use it w/ CoCreateInstance like this. CoCreateInstance last (out) parameter expects a pointer i.e. psl As Long
...
</wqw>

I was trying to use ChatGPT to get some usable example of code to retrieve paths from shortcuts. In the past (1-2 years ago) I was curious if this so-called AI is good of something, and i was very dissapointed (i am so-so good in VB6, but of course not an expert); but some 5-6 month ago I got something useful from it, so I was tried again yesterday regarding this specific area... and, as you can see, i was pushed on a not useful path, and with erroneus code, and was a lot of circling around what that bot are proposing, to no use. May be a way of using that, but....

[wqweto]

It will happen some day sooner or later but LLM's are not there yet.

cheers,
</wqw>