Skip to main content
Code Review

Return to Answer

added comment to make code clearer
Source Link
Greedo
Greedo
  • 2.4k
  • 2
  • 13
  • 35
Dim fancyAccessor As Object
Set fancyAccessor = GetFancyAccessor("myModule") 'late bound IDispatchVB interface with overloaded VTable

Dim unkInterface As IUnknown
Set unkInterface = FancyAccessor 'IUnknown::QueryInterface(IID_IUNKNOWN)

Dim accessorAfterQI As Object
Set accessorAfterQI = unkInterface 'IUnknown::QueryInterface(IID_IDISPATCH)

Debug.Assert ObjPtr(accessorAfterQI) = ObjPtr(fancyAccessor) 'fails ...
'This makes sense because IID_IDISPATCHVB <> IID_IDISPATCH,
' so we can expect 2 different interface pointers and you don't break COM/IUnknown rules. 
'But because you only overloaded the IDispatchVB's IDispatch vtable not the root vtable, 
' the overloaded implementation won't be called which is bad UX and does break COM's rules on IDispatch,
' specifically that the IUnknown & IDispatch implementations of each of the dual interfaces of an object
' should all do the same thing

Dim fancyAccessor As Object
Set fancyAccessor = GetFancyAccessor("myModule") 'late bound IDispatchVB interface with overloaded VTable

Dim unkInterface As IUnknown
Set unkInterface = FancyAccessor 'IUnknown::QueryInterface(IID_IUNKNOWN)

Dim accessorAfterQI As Object
Set accessorAfterQI = unkInterface 'IUnknown::QueryInterface(IID_IDISPATCH)

Debug.Assert ObjPtr(accessorAfterQI) = ObjPtr(fancyAccessor) 'fails

Dim fancyAccessor As Object
Set fancyAccessor = GetFancyAccessor("myModule") 'late bound IDispatchVB interface with overloaded VTable

Dim unkInterface As IUnknown
Set unkInterface = FancyAccessor 'IUnknown::QueryInterface(IID_IUNKNOWN)

Dim accessorAfterQI As Object
Set accessorAfterQI = unkInterface 'IUnknown::QueryInterface(IID_IDISPATCH)

Debug.Assert ObjPtr(accessorAfterQI) = ObjPtr(fancyAccessor) 'fails ...
'This makes sense because IID_IDISPATCHVB <> IID_IDISPATCH,
' so we can expect 2 different interface pointers and you don't break COM/IUnknown rules. 
'But because you only overloaded the IDispatchVB's IDispatch vtable not the root vtable, 
' the overloaded implementation won't be called which is bad UX and does break COM's rules on IDispatch,
' specifically that the IUnknown & IDispatch implementations of each of the dual interfaces of an object
' should all do the same thing
Source Link
Greedo
Greedo
  • 2.4k
  • 2
  • 13
  • 35

Private Function NextTypeLib() As LongPtr
    If this.currentTL.Next = 0 Then Err.Raise 5, Description:="We've reached the end of the line"
    NextTypeLib = this.currentTL.Next
    currentTL = this.currentTL.Next 'move the iterator along
End Function

'@Description("Gets type library com objects from list")
Public Function TryGetNext(ByRef outTypeLib As TypeLibInfo) As Boolean
    On Error GoTo cleanFail
    Dim tlPtr As LongPtr
    tlPtr = NextTypeLib
    Set outTypeLib = TLI.TypeLibInfoFromITypeLib(ObjectFromObjPtr(tlPtr))
    TryGetNext = True

This is an off-by-one error; after the Reset to the first element of the list of typelibs, the first call to TryGetNext calls NextTypeLib = this.currentTL.Next meaning the first item returned is actually the second typelib. The first typelib is always skipped - this breaks the technique for all unsaved 64 bit projects, and unsaved or saved 32 bit projects with no other references. Easy fix is to call .Next after assigning the return value to avoid skipping the first one, being careful not to dereference memory beyond the end of the list.

SwapClass

Private Sub Class_Initialize()
    Dim asDisp As IDispatchVB
    Set asDisp = Me
    Dim pAsDispVT As LongPtr
    pAsDispVT = memlongptr(ObjPtr(asDisp))
    Dim pInvokeVB As LongPtr, pInvokeOriginal As LongPtr
    pInvokeVB = pAsDispVT + IDispatchVBVTableOffset(IDispatchVBVTable.InvokeVB)
    pInvokeOriginal = pAsDispVT + IDispatchVBVTableOffset(IDispatchVBVTable.IDispatch.Invoke)
    
    Dim pGetIDsOfNamesVB As LongPtr, pGetIDsOfNamesOriginal As LongPtr
    pGetIDsOfNamesVB = pAsDispVT + IDispatchVBVTableOffset(IDispatchVBVTable.GetIDsOfNamesVB)
    pGetIDsOfNamesOriginal = pAsDispVT + IDispatchVBVTableOffset(IDispatchVBVTable.IDispatch.GetIDsOfNames)
    
    'swap the vtable entries
    memlongptr(pGetIDsOfNamesOriginal) = memlongptr(pGetIDsOfNamesVB)
    memlongptr(pInvokeOriginal) = memlongptr(pInvokeVB)
End Sub

Swapping the VTable of the IDispatchVB interface only overloads that interface. If I do something like:

Dim fancyAccessor As Object
Set fancyAccessor = GetFancyAccessor("myModule") 'late bound IDispatchVB interface with overloaded VTable

Dim unkInterface As IUnknown
Set unkInterface = FancyAccessor 'IUnknown::QueryInterface(IID_IUNKNOWN)

Dim accessorAfterQI As Object
Set accessorAfterQI = unkInterface 'IUnknown::QueryInterface(IID_IDISPATCH)

Debug.Assert ObjPtr(accessorAfterQI) = ObjPtr(fancyAccessor) 'fails

The two variables declared "As Object" should point to the same (overloaded) IDispatch instance. But they don't. This is because the second one points to the root IDispatch interface, which is not the same one.

Easy fix is to overload the IDispatch implementation of the default interface, meaning whenever the client asks for IID_IDISPATCH, they always get the overloaded version. Downside is this means the VTable layout is dependent on the order the SwapClass is written in VBA which is less robust and predictable than implementing a custom interface.

Both these changes have been implemented when I ported the code to twinBASIC https://github.com/Greedquest/vbInvoke