WithEvents 使用 IConnectionPoint 处理声明为对象的类的所有事件

Question

所以我尝试使用连接点接口来侦听由对象创建的所有事件。我正在动态执行此操作以进行日志记录 - 因此我向我的类提供一个对象实例，然后我的类连接所有事件。

---

背景

我的理解是，当在 IDL 中定义事件源接口时，会发生 2 件事

• 事件处理方法的带有 vtable 布局的早期绑定接口：https://devblogs.microsoft.com/oldnewthing/20130611-00/?p=4113
• 带有事件处理方法 dispid 的后期绑定调度接口：https://devblogs.microsoft.com/oldnewthing/20130612-00/?p=4103

因此，通常在 COM 中，如果您预先拥有类型库，则可以使事件接收器对象（侦听器）实现 Early Bound 事件接口

IFooEvents

，然后调用

IConnectionPointContainer.Find(IID_FooEvents).Advise(eventSink_IFooEvents)

但是，如果您想进行后期绑定，那么您可以让您的事件侦听器具有

IDispatch

接口，其 DispID 与 FooEvents 接口匹配（如果两者都是双重接口或调度接口）。

我所做的是这个 - 一个 IDispatchInvoke 重载的类（使用 vtable 修补）：

Class OmniEventListener Implements IDispatch
    Private Sub IDispatch_Invoke(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)
        'Custom IDispatch::Invoke returns HResult S_OK for everything and logs any calls
        ' so it can be used as the event sink everywhere    
        MsgBox printf("IDispatchVB_InvokeVB dispid={}", dispIDMember)
        Err.ReturnHResult = 0
    End Sub
End Class

所以该类基本上说“无论 dispid 是什么，只需记录调用并继续”，这意味着这是一个通用事件接收器，

然后连接一个随机 COM 对象：

Private Function GetConnection(ByVal src As Object, Optional ByVal listener As Object, Optional ByRef outCN As IConnectionPoint) As Long

    Dim container As IConnectionPointContainer = src 'will throw if src exposes no event container   
    
    Dim enum As IEnumConnectionPoints = container.EnumConnectionPoints()

    Do While enum.Next(1, outCN) = 0
        Dim iid As UUID
        outCN.GetConnectionInterface iid
       
        MsgBox printf("Connection point {}", UUIDToString(iid)) 'IID_FooEvents
        If Not listener Is Nothing Then
            Debug.Print "Advising"
            On Error Resume Next 'try advise using IDispatch won't always work but will sometimes
            Dim cookie As Long = outCN.Advise(listener)
            On Error GoTo 0
            Debug.Print "Advised " ; cookie
            If cookie <> 0 Then Return cookie
        End If
    Loop
    'No IDispatch compatible connection found
    Set outCN = Nothing
    Return 0
End Function


Sub TestUsingExcelAppEvents()
    Dim xl As Object = CreateObject("Excel.Application")
    Debug.Print "Got", xl.name
    Dim cn As IConnectionPoint
    Dim cookie As Long = GetConnection(xl, New OmniEventListener, outCN:=cn)
    If cookie <> 0 Then
        'This raises the NewWorkbook event, which pops a message box 
        ' from our OmniEventListener::IDispatch::Invoke with dispid 0x61d - see screenshot
        xl.workbooks.add 
        cn.Unadvise cookie
    End If
    xl.quit
End Sub

获取到IDL中AppEvents对应的连接点：

当

RaiseEvent Application_NewWorkbook

发生时，正确的事件会显示：

到目前为止我所拥有的

希望一切都有意义。我的方法适用于 MSForms 控件，例如 Matt 在 MVVM 示例中使用

ConnectToConnectionPoint

api here - wine 上的 src 代码显示它只是使用底层的接口。

但是我的方法不允许我连接到引发事件的VBA事件对象，例如

Class SimpleEventSource
    Public Event AfterAdd()
    
    Public Sub DoAdd()
        RaiseEvent AfterAdd
    End Sub
End Class

如果我这样做

cookie = GetConnection(mSimpleEventSource, New OmniEventListener, outCN)

那么它就无法连接。因此，没有任何连接点可以通过传递 OmniEventListener 来成功

Advise

。因此我无法登录

Event AfterAdd

但是我知道所有VBA类（包括SimpleEvents类）都是对偶的，并且我知道

AfterAdd

事件对应于源接口的dispid为1。如果您使用 VB6 或 twinBASIC 进行编译并查看 IDL，您就可以看到它。 那么我怎样才能挂钩任何 VBA 类的事件呢？

我正在制作我的日志库来帮助在发生这种情况时通过日志记录引发单元测试事件。我正在 twinBASIC 中构建它，目标是对 VBA 代码进行单元测试。

---

---

附录 IDL (OLEWoo)

excel（请参阅此 uuid 与上面屏幕截图中消息框中的 uuid 匹配）： 双BASIC/VBA：

twinBASIC/VBA：

excel（请参阅接口的 NewWorkbook 方法上的 id 0x0000061d 与前面屏幕截图中消息框中的 dispid 相匹配，表明它是在全向事件接收器上调用以响应事件发生的）：

Answer 1

不是完整的答案，但有一些进展：

虽然所有 VBA 接口都是双重的，但事实并非如此，因此连接点将允许您使用后期绑定 vtable（即公开正确的 dispid，而不是正确的 vtable 布局）。

由事件源决定它允许什么类型的事件接收器；要么显式地作为对象（如 MSForms 控件），隐式地作为对象（如 Excel 文档对象事件），或者特定的早期绑定事件接口（如通过 vtable 的 vba 类）。

可以创建一个具有对任何参数灵活的 vtable 和存根方法的对象，或者一个采用接口描述并适当插入存根方法的类，或者事件采用事件同步接口的 ITypeInfo 并执行一些反射来相应地生成一个虚函数表。不过，VBA 类的 ITypeInfo 很难获得。