How to get property values of classes that implement an interface in the Locals window?
Asked Answered
M

3

41

This is really bothering me and hindering my development/debugging. Whenever I declare a variable type of the interface I'm implementing, the Locals Window doesn't show it's property values. Instead it just reads

Object doesn't support this property or method

Which is silly, because it absolutely does. In fact it has to in order to fulfill its contract with the Interface.

If I declare the variable as the concrete implementation of the interface, the window works as expected. However, that completely defeats the purpose of coding to the abstraction to begin with.

How can I get the locals window to properly display the class' property values?

Minimal, Complete, and Verifiable Example:

Create an IClass class to use as an interface.

Option Explicit

Public Property Get Name() As String
End Property

Create a Class1 that implements the interface.

Option Explicit

Implements IClass

Public Property Get Name() As String
    Name = "Class1"
End Property

Private Property Get IClass_Name() As String
    IClass_Name = Name
End Property

And lastly, some test code in a regular .bas module to illustrate the issue.

Option Explicit

Public Sub test()
    Dim x As Class1
    Dim y As IClass

    Set x = New Class1
    Debug.Print x.Name

    Set y = New Class1
    Debug.Print y.Name

    Stop
End Sub

enter image description here

Meeks answered 19/3, 2015 at 13:44 Comment(13)
The funky part is that it still knows to expect a String... looks like a bug in the locals window!Uveitis
Probably the simplest solution is to just reverse-engineer the entire VBA IDE, find the Microsoft bug, tweak a bit of assembly-level code, and then...bingo, a working Locals window.Scurf
In fact, I have discovered a truly marvelous implementation of this, which this comment is too narrow to contain.Scurf
@Scurf props for the Fermat reference :DSpectacle
Is the locals window actually entering the property? What if you add a let and Set? Can you call DebugBreal or my ProcMonDebugOutput to see if proeprties get entered?Eladiaelaeoptene
I don't know what those are @JustinDearing. The repro is up there if you want to try your hand at it. I've long since given up on this one and no longer work with VBA on a regular basis.Meeks
Very interesting issue... Well, this seems to be bug. I'd suggest to create custom *.dll with class which implements interface in VB.NET (Visual Studio). You can simply use it on other machines, but you need to register this dll in GAC. This is my favorite way to use custom classes within VBA.Receivership
I'd be interested in seeing a more thorough answer @MaciejLos. If not for me, for the next poor sap. I'm starting to think of this xkcd comic when I see this post.Meeks
Funny comic :smile: If you really interested how to write and use custom com dll within VBA, i can show you a way how to achieve that. Am i start writing the answer?Receivership
My past answer: #29563948Receivership
That's a nice workaround if you're able to create a COM visible assembly to use.Meeks
When would you declare a variable as an interface, then initialize it as an implemented class object?Spaceband
@MaciejLos Yes nice work around howerever if the interface references any VBA objects theey also require creating interfaces for those in the type library. I'm suprised this VBA bug with the debug watch has persisted this long.Grassgreen
A
8

8.5 years later since the question was asked, I will not provide a solution to the problem but I will explain and demonstrate what is going on.

How does the Locals Window works

The Locals Window reads all the Get Properties names and ids via the ITypeInfo interface. It then proceeds to call each one of them using IDispatch::Invoke, including the Properties marked as Private

This is easy to demonstrate. Use the same IClass and Class1 as per the original question. Then run the Test method from a standard .bas module:

Option Explicit

#If VBA7 Then
    Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
#Else
    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
    Public Enum LongPtr: [_]: End Enum
#End If

#If Win64 Then
    Private Const PTR_SIZE As Long = 8
#Else
    Private Const PTR_SIZE As Long = 4
#End If

Public Sub Test()
    Dim x As Class1
    Set x = New Class1

    Dim vTablePtr As LongPtr
    Dim invokeAddr As LongPtr
    Dim invokePtr As LongPtr

    CopyMemory vTablePtr, ByVal ObjPtr(x), PTR_SIZE
    invokeAddr = vTablePtr + PTR_SIZE * 6
    CopyMemory invokePtr, ByVal invokeAddr, PTR_SIZE
    
    'Redirect Invoke
    CopyMemory ByVal invokeAddr, AddressOf IDispatch_Invoke, PTR_SIZE
    
    Stop 'Now expand 'x' in the Locals Window - there are no values
    
    'Restore Invoke
    CopyMemory ByVal invokeAddr, invokePtr, PTR_SIZE
    
    Stop 'There are values under 'x' in the Locals Window
End Sub

Function IDispatch_Invoke(ByVal this As Object _
                        , ByVal dispIDMember As Long _
                        , ByVal riid As LongPtr _
                        , ByVal lcid As Long _
                        , ByVal wFlags As Integer _
                        , ByVal pDispParams As LongPtr _
                        , ByVal pVarResult As LongPtr _
                        , ByVal pExcepInfo As LongPtr _
                        , ByVal puArgErr As LongPtr) As Long
    Const DISP_E_MEMBERNOTFOUND = &H80020003
    IDispatch_Invoke = DISP_E_MEMBERNOTFOUND
End Function

When the code breaks on the first Stop, go to the Locals Window and expand x. You should see something like this:

enter image description here

Press Run or F5 key and when the code breaks on the second Stop, you should see something like this:

enter image description here

This proves that Invoke is definitely the mechanism that allows the Locals window to call the Properties and display their results.

Note that the exact same thing happens for the Watches Window.

Object call vs Locals call

When running Test2 from a standard .bas module:

Option Explicit

Public Sub Test2()
    Dim x As Class1
    Dim y As IClass
    Dim o As Object

    Set x = New Class1
    Debug.Print x.Name

    Set y = New Class1
    Debug.Print y.Name

    Set o = y
    Debug.Print o.Name
End Sub

we get this in the Immediate Window:

enter image description here

Why does o.Name return Class1 correctly since this is also calling IDispatch::Invoke the same way that the Locals Window does?

To find the difference, we must hook Invoke again. Run Test3 from a standard .bas module:

Option Explicit

#If VBA7 Then
    Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
#Else
    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
    Public Enum LongPtr: [_]: End Enum
#End If

#If Win64 Then
    Private Const PTR_SIZE As Long = 8
#Else
    Private Const PTR_SIZE As Long = 4
#End If

Public Type GUID
    data1 As Long
    data2 As Integer
    data3 As Integer
    data4(0 To 7) As Byte
End Type

Public Sub Test3()
    Dim x As Class1
    Set x = New Class1

    Dim vTablePtr As LongPtr
    Dim invokeAddr As LongPtr
    Dim invokePtr As LongPtr

    CopyMemory vTablePtr, ByVal ObjPtr(x), PTR_SIZE
    invokeAddr = vTablePtr + PTR_SIZE * 6
    CopyMemory invokePtr, ByVal invokeAddr, PTR_SIZE
    
    CopyMemory ByVal invokeAddr, AddressOf IDispatch_Invoke, PTR_SIZE
    
    Dim o As Object
    Set o = x
    
    On Error Resume Next
    o.Name
    On Error GoTo 0
    
    Stop 'Now expand 'x' in the Locals Window
    
    CopyMemory ByVal invokeAddr, invokePtr, PTR_SIZE
End Sub

Function IDispatch_Invoke(ByVal this As Object _
                        , ByVal dispIDMember As Long _
                        , ByVal riid As LongPtr _
                        , ByVal lcid As Long _
                        , ByVal wFlags As Integer _
                        , ByVal pDispParams As LongPtr _
                        , ByVal pVarResult As LongPtr _
                        , ByVal pExcepInfo As LongPtr _
                        , ByVal puArgErr As LongPtr) As Long
    Const DISP_E_MEMBERNOTFOUND = &H80020003
    Dim g As GUID
    CopyMemory g, ByVal riid, LenB(g)
    Debug.Print GUIDToString(g)
    IDispatch_Invoke = DISP_E_MEMBERNOTFOUND
End Function

Public Function GUIDToString(ByRef gid As GUID) As String
    GUIDToString = "{00000000-0000-0000-0000-000000000000}"
    With gid
        Mid$(GUIDToString, 2, 8) = AlignHex(Hex$(.data1), 8)
        Mid$(GUIDToString, 11, 4) = AlignHex(Hex$(.data2), 4)
        Mid$(GUIDToString, 16, 4) = AlignHex(Hex$(.data3), 4)
        Mid$(GUIDToString, 21, 4) = AlignHex(Hex$(.data4(0) * 256& + .data4(1)), 4)
        Mid$(GUIDToString, 26, 6) = AlignHex(Hex$(.data4(2) * 65536 + .data4(3) * 256& + .data4(4)), 6)
        Mid$(GUIDToString, 32, 6) = AlignHex(Hex$(.data4(5) * 65536 + .data4(6) * 256& + .data4(7)), 6)
    End With
End Function
Private Function AlignHex(ByRef h As String, ByVal charsCount As Long) As String
    Const maxHex As String = "0000000000000000" '16 chars (LongLong max chars)
    If Len(h) < charsCount Then AlignHex = Right$(maxHex & h, charsCount) Else AlignHex = h
End Function

When the code breaks on the Stop line, go to the Locals Window and expand x. You should see this in the Immediate Window:

enter image description here

The first NULL REFIID was printed from the o.Name call and the other 3 REFIIDs are printed when we expand x in the Locals Window. The second NULL one is called for the custom enumerator i.e. dispIDMember -4 which returns an IEnumVariant for use in a For Each loop. The last 2 are called for Name and IClass_Name.

So, the Locals Window uses the second parameter (type REFIID) in Invoke which according to MS documentation is

Reserved for future use. Must be IID_NULL.

Displaying interface Property values in the Locals Window

Since the REFIID is what tells Invoke if the call came via late-binding or from the Locals Window, let's change the REFIID to IID_NULL and see what happens. Add the following code to a standard .bas module:

Option Explicit

#If VBA7 Then
    Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
    Private Declare PtrSafe Function DispCallFunc Lib "oleaut32.dll" (ByVal pvInstance As LongPtr, ByVal oVft As LongPtr, ByVal cc As Long, ByVal vtReturn As Integer, ByVal cActuals As Long, ByRef prgvt As Integer, ByRef prgpvarg As LongPtr, ByRef pvargResult As Variant) As Long
#Else
    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length 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 Integer, ByRef prgpvarg As Long, ByRef pvargResult As Variant) As Long
#End If

#If Win64 Then
    Private Const vbLongPtr As Long = vbLongLong
    Private Const PTR_SIZE As Long = 8
#Else
    Private Const vbLongPtr As Long = vbLong
    Private Const PTR_SIZE As Long = 4
#End If

#If VBA7 = 0 Then
    Public Enum LongPtr: [_]: End Enum
#End If

Private newInvokePtr As LongPtr
Private oldInvokePtr As LongPtr
Private invokeVtblPtr As LongPtr

Public Type GUID
    data1 As Long
    data2 As Integer
    data3 As Integer
    data4(0 To 7) As Byte
End Type

'https://learn.microsoft.com/en-us/windows/win32/api/oaidl/nf-oaidl-idispatch-invoke
Function IDispatch_Invoke(ByVal this As Object _
    , ByVal dispIDMember As Long _
    , ByVal riid As LongPtr _
    , ByVal lcid As Long _
    , ByVal wFlags As Integer _
    , ByVal pDispParams As LongPtr _
    , ByVal pVarResult As LongPtr _
    , ByVal pExcepInfo As LongPtr _
    , ByVal puArgErr As LongPtr _
) As Long
    RestoreInvoke
    Const DISP_E_MEMBERNOTFOUND = &H80020003
    Const CC_STDCALL = 4
    '
    Debug.Print "this: " & ObjPtr(this)
    Debug.Print "dispIDMember: " & dispIDMember
    
    Dim g As GUID
    Dim h As GUID
    CopyMemory g, ByVal riid, LenB(g)
    Debug.Print "riid: " & GUIDToString(g)
    Debug.Print "lcid: " & lcid
    Debug.Print "wFlags: " & wFlags
    Debug.Print
    
    g = h 'This is the actual change that makes the Locals window display interface properties
    
    Dim prgvt(0 To 7) As Integer
    Dim prgpvarg(0 To 7) As Variant
    Dim prgpvarg2(0 To 7) As LongPtr
    Dim i As Long
    
    prgvt(0) = vbLong:    prgpvarg(0) = dispIDMember
    prgvt(1) = vbLongPtr: prgpvarg(1) = VarPtr(g)
    prgvt(2) = vbLong:    prgpvarg(2) = lcid
    prgvt(3) = vbInteger: prgpvarg(3) = wFlags
    prgvt(4) = vbLongPtr: prgpvarg(4) = pDispParams
    prgvt(5) = vbLongPtr: prgpvarg(5) = pVarResult
    prgvt(6) = vbLongPtr: prgpvarg(6) = pExcepInfo
    prgvt(7) = vbLongPtr: prgpvarg(7) = puArgErr
    For i = 0 To 7
        prgpvarg2(i) = VarPtr(prgpvarg(i))
    Next i

    DispCallFunc ObjPtr(this), PTR_SIZE * 6, CC_STDCALL, vbLong, 8, prgvt(0), prgpvarg2(0), IDispatch_Invoke
    HookInvoke this
End Function

Sub HookInvoke(obj As Object)
    If obj Is Nothing Then Exit Sub
    Dim vTablePtr As LongPtr
    newInvokePtr = VBA.Int(AddressOf IDispatch_Invoke)
    CopyMemory vTablePtr, ByVal ObjPtr(obj), PTR_SIZE
    invokeVtblPtr = vTablePtr + 6 * PTR_SIZE
    CopyMemory oldInvokePtr, ByVal invokeVtblPtr, PTR_SIZE
    CopyMemory ByVal invokeVtblPtr, newInvokePtr, PTR_SIZE
End Sub

Sub RestoreInvoke()
    If invokeVtblPtr = 0 Then Exit Sub
    CopyMemory ByVal invokeVtblPtr, oldInvokePtr, PTR_SIZE
    invokeVtblPtr = 0
    oldInvokePtr = 0
    newInvokePtr = 0
End Sub

Public Function GUIDToString(ByRef gid As GUID) As String
    GUIDToString = "{00000000-0000-0000-0000-000000000000}"
    With gid
        Mid$(GUIDToString, 2, 8) = AlignHex(Hex$(.data1), 8)
        Mid$(GUIDToString, 11, 4) = AlignHex(Hex$(.data2), 4)
        Mid$(GUIDToString, 16, 4) = AlignHex(Hex$(.data3), 4)
        Mid$(GUIDToString, 21, 4) = AlignHex(Hex$(.data4(0) * 256& + .data4(1)), 4)
        Mid$(GUIDToString, 26, 6) = AlignHex(Hex$(.data4(2) * 65536 + .data4(3) * 256& + .data4(4)), 6)
        Mid$(GUIDToString, 32, 6) = AlignHex(Hex$(.data4(5) * 65536 + .data4(6) * 256& + .data4(7)), 6)
    End With
End Function
Private Function AlignHex(ByRef h As String, ByVal charsCount As Long) As String
    Const maxHex As String = "0000000000000000" '16 chars (LongLong max chars)
    If Len(h) < charsCount Then AlignHex = Right$(maxHex & h, charsCount) Else AlignHex = h
End Function

Now, run Test4 from another .bas module:

Option Explicit

Public Sub Test4()
    Dim x As Class1
    Dim y As IClass
    Dim o As Object

    Set x = New Class1
    Debug.Print x.Name

    Set y = New Class1
    Debug.Print y.Name

    HookInvoke y

    Set o = y
    Debug.Print o.Name 'Notice that the RIID will be NULL: {00000000-0000-0000-0000-000000000000}
    
    Stop               'Expand 'y' in the Locals Window and notice that the RIID will be: {CACC1E86-622B-11D2-AA78-00C04F9901D2}
                       'The fix seems to be to clear the RIID to NULL
    RestoreInvoke
End Sub

When the code breaks on the Stop line, go to the Locals Window and expand y - the interface Property value is now displayed correctly. The only change we did, before calling the original Invoke via DispCallFunc was to replace the {CACC1E86-622B-11D2-AA78-00C04F9901D2} with IID_NULL

enter image description here

Summary

  • The Locals/Watches Window calls Object/Interface Properties via IDispatch::Invoke
  • When the call comes from Locals/Watches, the second argument passed to Invoke is the {CACC1E86-622B-11D2-AA78-00C04F9901D2} with the exception of dispIDMember -4 which is reserved for calling the class enumerator
  • When the call comes from late-binding (Object), the REFIID is always IID_NULL ({00000000-0000-0000-0000-000000000000})
  • If we intercept the Invoke call and replace {CACC1E86-622B-11D2-AA78-00C04F9901D2} with IID_NULL then the Locals/Watches Window displays the Properties correctly for the implemented interface
Achates answered 29/11, 2023 at 21:44 Comment(3)
Holy cow! You found the actual bug! I know it's not a solution, but take my upvote anyway.Meeks
Amazing, wonder what CACC1E86-622B-11D2-AA78-00C04F9901D2 represents. It's very close to cacc1e84-622b-11d2-aa78-00c04f9901d2 (supposedly IID_GEN_PROJECT) and not far off cacc1e82-622b-11d2-aa78-00c04f9901d2 (supposedly BASIC_TYPEINFO). I would imagine it's an internal Excel class identifier?Thief
@Thief Ha. I did not think to check this in other apps until I read your comment. It seems the same REFIID {CACC1E86-622B-11D2-AA78-00C04F9901D2} is being used under other MS apps like Word and PowerPoint. I don't have AutoCAD installed at the moment but I guess it would be the same.Achates
H
2

Your question is about the variables in the Locals window, for which I don't have an answer, but if you accept to watch the variable in the Watches window, you may use the following workaround.

Define a function (e.g. named autocast below) that you use to cast your interface variable to the actual class. You will need to adapt the function to cast all your class modules explicitly (you may also generate this function automatically).

In the Watches (not Locals) window, type:

autocast(y)

Watches window, call a function

The drawback is that it doubles the number of properties shown.

NEW solution (proposal from comments)

Use of IUnknown:

Function autocast(ByVal obj As IUnknown) As Object
    ' https://mcmap.net/q/389323/-how-to-get-property-values-of-classes-that-implement-an-interface-in-the-locals-window
    ' In the Watches window, if a class instance xx is declared as an interface,
    ' its properties show "Object doesn't support this property or method",
    ' instead type autocast(xx) and the property values are shown.
    Set autocast = obj
End Function

Code of autocast:


OLD solution

Function autocast(obj) As Object
    Select Case TypeName(obj)
        Case "Class1": Dim objClass1 As Class1: Set objClass1 = obj: Set autocast = objClass1
        Case "Class2": Dim objClass2 As Class2: Set objClass2 = obj: Set autocast = objClass2
        'etc.
    End Select
End Function

EDIT: code to generate the function above in the Immediate window, with the list of all Class modules of the current document (requires Trust Access to the VBA Project object model):

Sub GenerateAutocastFunction()
    ' https://mcmap.net/q/389323/-how-to-get-property-values-of-classes-that-implement-an-interface-in-the-locals-window
    Dim ObjApplication As Object
    Dim objVBComponent As VBComponent
    Dim objCurrentFile As Object
    Dim strTab As String

    Set ObjApplication = Application
    Select Case Application
        Case "Microsoft Word": Set objCurrentFile = ObjApplication.ActiveDocument
        Case "Microsoft Excel": Set objCurrentFile = ObjApplication.ActiveWorkbook
        Case "Microsoft PowerPoint": Set objCurrentFile = ObjApplication.ActivePresentation
    End Select

    strTab = Chr(9)
    Debug.Print "Function autocast(obj) As Object"
    Debug.Print strTab & "' https://mcmap.net/q/389323/-how-to-get-property-values-of-classes-that-implement-an-interface-in-the-locals-window"
    Debug.Print strTab & "Select Case TypeName(obj)"
    For Each objVBComponent In objCurrentFile.VBProject.VBComponents
        If objVBComponent.Type = vbext_ct_ClassModule Then
            Debug.Print strTab & strTab & "Case """ & objVBComponent.Name & """: Dim obj" & objVBComponent.Name & " As " _
                        & objVBComponent.Name & ": Set obj" & objVBComponent.Name & " = obj: Set autocast = obj" & objVBComponent.Name
        End If
    Next
    Debug.Print strTab & "End Select"
    Debug.Print "End Function"
End Sub
Hammon answered 16/7 at 13:13 Comment(5)
Clever workaround. Bounty awarded.Meeks
There is no need for the GenerateAutocastFunction method. Simply rewrite autocast to Function autocast(obj) As Object: Dim iUnk As IUnknown: Set iUnk = obj: Set autocast = iUnk: End FunctionAchates
Or even shorter: Function autocast(ByVal obj As IUnknown) As Object: Set autocast = obj: End FunctionAchates
@CristianBuse Thanks, it works, respect! I have updated with your solution, but would you mind posting it as a separate answer? (then, I'd revert to the old version)Hammon
@SandraRossi I already have an answer so I won't post another one. Plus, it's your workaround that matters, I simply circumvented the code that required module access. If you don't know what my proposal does, then read this for more details. Thanks!Achates
B
-1

I could be wrong, but I think this may be something to do with the way classes are instantiated in VBA.

For example:

Dim oClass1 as Class1
Set oClass1 = new Class1

Is different than

Dim oClass1 as New Class1

In the second case I believe the constructor doesn't get called until the property is accessed.

If you try this, it is sees the property in the Watch window. Notice the New for the IClass - just for Demonstration - I know its not the way to do that :)

Public Sub test1()

    Dim x As Class1
    Dim y As IClass

    Set y = New IClass
    Set x = New Class1
    Debug.Print x.Name
    Debug.Print y.Name
    Stop

End Sub

I suspect its something to do with that and the watch window requires this ... maybe...

Bootee answered 2/2, 2017 at 14:19 Comment(3)
Unfortunately, I no longer have access to an Office install to test this.Meeks
Newing up the interface defeats the purpose - of course it's going to work, you're looking at a class instance that happens to be named with an I prefix - that doesn't make it an interface. The point is that this VBE bug makes debugging code written against an interface harder to debug using the locals toolwindow.Uveitis
I know that, thats why I said 'I know its not the way to do that'. My Point was trying to demonstrate the instantiation differences between the two invokations and that the watch Windows internal implementation was probably using that. :)Bootee

© 2022 - 2024 — McMap. All rights reserved.