最新消息:雨落星辰是一个专注网站SEO优化、网站SEO诊断、搜索引擎研究、网络营销推广、网站策划运营及站长类的自媒体原创博客

vb6 - Visual Basic 6 crashes when executing CallStdFunction (through API) - Stack Overflow

programmeradmin5浏览0评论

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
发布评论

评论列表(0)

  1. 暂无评论