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

问题描述 投票：0回答：2

这真的很困扰我并阻碍我的开发/调试。每当我声明我正在实现的接口的变量类型时，本地窗口都不会显示它的属性值。相反，它只是读取

对象不支持此属性或方法

这很愚蠢，因为它确实如此。事实上，它有，以便履行与接口的合同。

如果我将变量声明为接口的具体实现，则窗口将按预期工作。然而，这完全违背了抽象编码的初衷。

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

最小、完整且可验证的示例：

创建一个 

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

enter image description here

vba oop interface ide
2个回答
0
投票

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

本地窗口如何工作

本地窗口通过 

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

的属性

这很容易演示。根据原始问题使用相同的 

IClass
和 
Class1
。然后从标准 .bas 模块运行 
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
。你应该看到这样的东西：

enter image description here

按 Run 或 F5 键，当代码在第二个 

Stop
处中断时，您应该看到如下内容：

enter image description here

这证明

Invoke
绝对是允许Locals窗口调用Properties并显示其结果的机制。

请注意，手表窗口也会发生完全相同的情况。

Object
呼叫与本地呼叫

从标准 .bas 模块运行 

Test2
时：

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

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

enter image description here

为什么 

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

要找到差异，我们必须再次钩住

Invoke
。从标准 .bas 模块运行 
Test3
：

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
。您应该在立即窗口中看到这一点：

enter image description here

第一个 NULL REFIID 是通过 

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

因此，本地窗口使用 

Invoke
中的第二个参数（类型 REFIID），根据 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

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

Test4
：

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
- 接口属性值现在可以正确显示。在通过 
Invoke
调用原始 
DispCallFunc
之前，我们所做的唯一更改是将 
{CACC1E86-622B-11D2-AA78-00C04F9901D2}
替换为 IID_NULL

enter image description here

总结

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

我可能是错的，但我认为这可能与 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

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

最新问题
© www.soinside.com 2019 - 2024. All rights reserved.