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:
Press Run or F5 key and when the code breaks on the second Stop
, you should see something like this:
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:
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:
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
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
String
... looks like a bug in the locals window! – Uveitis