如何在Locals窗口中获取实现接口的类的属性值？

Question

这真的困扰着我,妨碍了我的开发/调试.每当我声明我正在实现的接口的变量类型时,Locals Window都不会显示它的属性值.相反,它只是读取

Object不支持此属性或方法

这很愚蠢,因为它确实如此.事实上,它必须履行与Interface的合同.

如果我将变量声明为接口的具体实现,则窗口按预期工作.但是,这完全违背了编码到抽象的目的.

如何让locals窗口正确显示类的属性值？

最小,完整和可验证的示例:

创建一个IClass用作接口的类.

Option Explicit

Public Property Get Name() As String
End Property

创建一个Class1实现接口的.

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

最后,常规.bas模块中的一些测试代码来说明问题.

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

Answer 1

问题提出 8.5 年后，我不会提供问题的解决方案，但我会解释并演示发生了什么。

本地窗口如何工作

本地窗口Get通过界面读取所有属性名称和 ID ITypeInfo。然后，它继续使用 调用它们中的每一个IDispatch::Invoke，包括标记为的属性Private

这很容易证明。根据原始问题使用相同的IClass和。然后从标准 .bas 模块Class1运行该方法：Test

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

当代码在第一个处中断时Stop，转到“本地窗口”并展开x。你应该看到这样的东西：

按 Run 或 F5 键，当代码在第二个 处中断时Stop，您应该看到如下内容：

这证明这Invoke确实是允许本地窗口调用属性并显示其结果的机制。

请注意，Watches Window 也会发生完全相同的情况。

Object呼叫与本地呼叫

Test2从标准 .bas 模块运行时：

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

我们在立即窗口中得到这个：

为什么会正确o.Name返回Class1，因为这也以IDispatch::Invoke与本地窗口相同的方式调用？

为了找到差异，我们必须Invoke再次钩住。Test3从标准 .bas 模块运行：

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

当代码中断时Stop，转到“本地窗口”并展开x。您应该在立即窗口中看到这一点：

第一个 NULL REFIID 是从o.Name调用中打印出来的，其他 3 个 REFIID 是在我们x在本地窗口中展开时打印的。第二个 NULL 是为自定义枚举器调用的，即 dispIDMember -4，它返回一个IEnumVariantfor 在For Each循环中使用。最后 2 个需要Name和IClass_Name。

因此，本地窗口使用第二个参数（REFIID 类型），Invoke根据 MS 文档，该参数是

保留以供将来使用。必须是 IID_NULL。

在本地窗口中显示接口属性值

由于 REFIID 告诉我们Invoke调用是通过后期绑定还是来自本地窗口，所以让我们将 REFIID 更改为 IID_NULL 并看看会发生什么。将以下代码添加到标准 .bas 模块中：

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

Test4现在，从另一个 .bas 模块运行：

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

当代码中断时Stop，转到本地窗口并展开y- 接口属性值现在可以正确显示。在调用原始Invokevia之前我们所做的唯一更改DispCallFunc是将其替换{CACC1E86-622B-11D2-AA78-00C04F9901D2}为 IID_NULL

概括

• 本地/监视窗口通过调用对象/接口属性IDispatch::Invoke
• 当调用来自 Locals/Watches 时，传递给的第二个参数Invoke是，{CACC1E86-622B-11D2-AA78-00C04F9901D2}但 -4 除外，dispIDMember它是为调用类枚举器而保留的
• 当调用来自后期绑定 ( Object) 时，REFIID 始终为 IID_NULL ( {00000000-0000-0000-0000-000000000000})
• 如果我们拦截Invoke调用并替换{CACC1E86-622B-11D2-AA78-00C04F9901D2}为 IID_NULL，则本地/监视窗口会正确显示已实现接口的属性

Answer 2

我可能是错的，但我认为这可能与 VBA 中实例化类的方式有关。

例如：

Dim oClass1 as Class1
Set oClass1 = new Class1

不同于

Dim oClass1 as New Class1

在第二种情况下，我相信在访问属性之前不会调用构造函数。

如果您尝试执行此操作，则会在“监视”窗口中看到该属性。注意 IClass 的新功能 - 仅用于演示 - 我知道这不是这样做的方法:)

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

我怀疑这与此有关，并且观察窗口需要这个......也许......