监听类引发的所有事件,而不使用 WithEvents

问题描述 投票:0回答:1

我正在尝试使用连接点接口(

IConnectionPoint
/
IConnectionPointContainer
)来侦听由对象创建的所有事件。我正在动态地执行此操作以进行单元测试 - 因此我向我的类提供一个工作簿对象,并获取所有带有时间戳的单击、选择更改、工作表添加事件的日志,无需显式定义事件侦听器,这都是自动的。


背景

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

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

IFooEvents
,然后调用

IConnectionPointContainer.Find(IID_FooEvents).Advise(eventSink_IFooEvents)

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

IDispatch
接口,其 DispID 与 FooEvents 接口匹配(如果两者都是双重接口或调度接口)。就像我们使用 dispid -4 作为默认成员一样,dispid 15 可能是 Worksheet_Change 事件回调函数的预期地址。

由于这些方法是由 dispid 通过 IDispatch::Invoke 调用的,所以我希望您可以使用自定义方法覆盖该方法以记录方法调用,但实际上不调用任何内容。我所做的是这个 - 一个 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对应的连接点:

enter image description here

RaiseEvent Application_NewWorkbook
发生时,正确的事件会显示: dispid message box

到目前为止我所拥有的

希望一切都有意义。我的方法适用于 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 匹配): coclass for application object 双BASIC/VBA: coclass event source

twinBASIC/VBA: source interface

excel(请参阅接口的 NewWorkbook 方法上的 id 0x0000061d 与前面屏幕截图中消息框中的 dispid 相匹配,显示它是在全事件接收器上调用以响应事件发生的):

AppEvents

vba com ole connection-points twinbasic
1个回答
0
投票

不是完整的答案,但有一些进展:

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

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

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

© www.soinside.com 2019 - 2024. All rights reserved.