传递对自定义类与内置对象的引用时非常奇怪的错误

Posted 2023-02-22

【中文标题】传递对自定义类与内置对象的引用时非常奇怪的错误

【英文标题】：Very weird bug when passing references to custom classes vs built-in objects

【发布时间】：2019-08-19 15:50:27

【问题描述】：

我正在尝试使用 SetTimer api 做一些技巧，并且终于能够为我一直遇到的问题创建一个可重现的示例。将自定义类的实例传递给回调时出现错误，但不适用于内置/库类

这是我想要做的：

使用SetTimer function 创建带有回调函数的计时器 通过将 timerID（文档中的UINT_PTR nIDEvent）设置为指向包装数据的对象的指针，将一些数据传递给回调 使用mscorlib.AppDomain 将参数对象保存在内存中以防止状态丢失（点击编辑器中的停止按钮）

---

稍微扩展一下这些点：

1.创建计时器

这里没有问题；下面是我的 api 声明，我把它放在一个名为 WinAPI 的模块中

Public Declare Function SetTimer Lib "user32" ( _
                        ByVal hWnd As LongPtr, _
                        ByVal nIDEvent As LongPtr, _
                        ByVal uElapse As Long, _
                        ByVal lpTimerFunc As LongPtr) As LongPtr

Public Declare Function KillTimer Lib "user32" ( _
                        ByVal hWnd As LongPtr, _
                        ByVal nIDEvent As LongPtr) As Long

2。传递数据

我已经定义了一个符合TIMERPROC definition的回调函数签名

Private Sub timerProc(ByVal windowHandle As LongPtr, ByVal message As Long, ByVal timerObj As Object, ByVal tickCount As Long)

如您所见，第三个参数_In_ UINT_PTR idEvent，通常是 WinAPI 计时器的普通 id，在这里用于传递对内存中某个对象的引用。在我的实际代码中，这是一个强类型的自定义类，但对于这个示例，Object 就足够了。

然后我使用

创建计时器

Dim timerParams As Object
'... initialise the object with the data to pass
SetTimer hWnd:=Application.hWnd, nIDEvent:=ObjPtr(timerParams), uElapse:=500, lpTimerFunc:=AddressOf timerProc

（好吧，我不使用所有的命名参数，但你明白了；）

3.持久化数据

在我的真实代码中（对不起，在这个例子中没有），我已经连接了一些零碎的东西，所以点击停止按钮会触发计时器停止，但是在它被销毁之前它仍然会再得到一个滴答声与KillTimer。因此，即使我在编辑器中点击停止，我的对象也必须保留在内存中，如果没有，那么当 timerProc 最后一次运行时，它尝试取消引用的指针将无效。

基本上，每当调用 timerProc 时，我总是必须确保 timerObj 存在。当我在 VBA 代码中按下 Stop 时，WinAPI 计时器不会被破坏，所以我的对象也不能被破坏。出于这个原因，我使用建议的方法in this answer

---

问题

好吧，将所有这些放在一起创建一个 MRE（或现在的首字母缩写词）：

Option Explicit

Private Declare Function SetTimer Lib "user32" ( _
                         ByVal hWnd As LongPtr, _
                         ByVal nIDEvent As LongPtr, _
                         ByVal uElapse As Long, _
                         ByVal lpTimerFunc As LongPtr) As LongPtr

Private Declare Function KillTimer Lib "user32" ( _
                         ByVal hWnd As LongPtr, _
                         ByVal nIDEvent As LongPtr) As Long

Private Function GetPersistentDictionary() As Object
    ' References:
    '  mscorlib.dll
    '  Common Language Runtime Execution Engine

    Const name = "weak-data"
    Static dict As Object

    If dict Is Nothing Then
        Dim host As New mscoree.CorRuntimeHost
        Dim domain As mscorlib.AppDomain
        host.Start
        host.GetDefaultDomain domain

        If IsObject(domain.GetData(name)) Then
            Set dict = domain.GetData(name)
        Else
            Set dict = CreateObject("Scripting.Dictionary")
            domain.SetData name, dict
        End If
    End If

    Set GetPersistentDictionary = dict
End Function

Private Sub timerProc(ByVal windowHandle As LongPtr, ByVal message As Long, ByVal timerObj As Object, ByVal tickCount As Long)

    Static i As Long 'this will go to zero after a state-loss
    i = i + 1
    Debug.Print i;
    Dim data As String
    data = timerObj.Item("myVal")
    Debug.Print data
    If i >= 10 Then
        KillTimer Application.hWnd, ObjPtr(timerObj)
        Debug.Print "Done"
        i = 0
    End If
End Sub

Private Sub setUpTimer()
    'create the data to pass to the callback function
    Dim testObj As Object
    Set testObj = New Dictionary
    testObj.Item("myVal") = "I'm the data you passed!"

    'store the data object in cache so its reference count never goes to zero
    Dim cache As Dictionary
    Set cache = GetPersistentDictionary()
    Set cache.Item("testObj") = testObj

    'create the timer, passing the data object as an argument
    SetTimer Application.hWnd, ObjPtr(testObj), 500, AddressOf timerProc
End Sub

这实际上完全符合预期！输出是这样的：

 1 I'm the data you passed!
 2 I'm the data you passed!
 3 I'm the data you passed!
 4 I'm the data you passed!
 5 I'm the data you passed! '<- I pressed stop just after this, which restarted the static count, but didn't destroy the cached object
 1 I'm the data you passed!
 2 I'm the data you passed!
 3 I'm the data you passed!
 4 I'm the data you passed!
 5 I'm the data you passed!
 6 I'm the data you passed!
 7 I'm the data you passed!
 8 I'm the data you passed!
 9 I'm the data you passed!
 10 I'm the data you passed!
Done

但是，如果我尝试使用自定义类而不是 Scripting.Dictionary 作为数据（尝试前保存）：

Private Sub setUpTimer()
    'create the data to pass to the callback function
    Dim testObj As Object
    Set testObj = New fakeDictionary '<-custom class, the only change
    testObj.Item("myVal") = "I'm the data you passed!"
    '...everything else the same

fakeDictionary 就是这个：

Option Explicit

Private dict As New Scripting.Dictionary

Public Property Get Item(ByVal key As String) As String
    Item = dict.Item(key)
End Property

Public Property Let Item(ByVal key As String, ByVal value As String)
    dict.Item(key) = value
End Property

Private Sub Class_Terminate()
    Debug.Print "I am made dead"
End Sub

我在停止代码时得到这个：

然后当下一条计时器消息进来并运行回调并且未处理异常时，Excel会崩溃。

正文如下

运行时错误 -2147418105

自动化错误

被调用者（服务器[不是服务器应用程序]）不可用并且 消失了；所有连接都无效。调用可能已执行。

【问题讨论】：

附言。如果您像我一样在使用 mscorlib 时遇到问题，可能是因为 this，在这种情况下，要么按照那里的解决方法，要么像我一样通过安装/启用 .Net 3.5 来使用 mscorlib v2（按照说明 @ 987654326@)

@MathieuGuindon End 确实以类似的方式对所有内容进行了核对，但也意味着TIMERPROC 永远不会返回导致 Excel 的消息循环（或该线程上的循环）崩溃 - 我认为停止按钮会如果在回调执行的过程中对其进行了评估，则执行相同的操作，但它似乎只会在对 TIMERPROC 的调用之间降落，因此这不是问题。 （这可能是因为按钮按下在 UI 线程中运行，因此在 WM_TIMER 消息之间排队，因此永远不会中断执行；同样的原因，您需要分散在各处的 DoEvents 才能使停止按钮工作）

如何生成一个无模式、不可见的用户窗体并使用该 hWnd 而不是 Excel 的？

你不能安全地做你想做的事。 nIDEvent 参数是一个唯一的计时器 ID。它是指针大小的，因此您可以将虚拟对象的地址作为 ID 传递。每个这样做的客户都将保证获得一个唯一的 ID。它并不意味着传递实际数据。问题是，如果您的计时器程序运行，您将如何区分那些使用任何唯一 ID 的计时器和那些计时器，以及那些 ID 是指向对象的指针的计时器？如果可以的话，定时器过程已经知道对象的地址了，为什么还要传递呢？

感谢@IInspectable 的健全性检查；它在重置对此的看法时很有用，但我已将代码更改为不使用接口指针并使用 32 位长（某些文本的哈希值），但它仍然崩溃，因为它试图调用你的 fakeDictionary 类。为什么会崩溃？因为它是一个 VBA 定义的类，你把它拆掉了。我相信如果您将代码移动到二进制编译的车辆上，这种情况就会消失。在您自己的实验中，Scripting.Dictionary 幸存下来，但您的自定义 VBA 类没有。

【参考方案1】：

好吧，如果您按停止，那么我认为期望指向从您的 VBA 定义的类创建的对象的指针继续有效是不合理的。对于一个真正持久的类，您需要用 C#（或 C++ 或 Python，甚至 VB6）编写它。

【讨论】：

这个。在按下“停止”后（即在执行上下文被 nuked 之后）强制对象停留，相当于故意造成内存泄漏。这不能很好地结束。

FWIW，如果您选择获取vbWatchDog（不是免费的），您将能够在不重置全局状态的情况下停止。似乎比尝试创建准进程外存储更清洁。否则，请不要单击该停止按钮。将其视为SCRAM button。

IDK 我不相信... VBA 类与任何其他 COM 对象一样，并使用引用计数来保持活力，对吗？ the other post by @FlorentB. 中解释的方式是，我使用的缓存方法只是添加对对象的引用并将其存储在具有 Excel 进程生命周期的位置。这相当于在子类化窗口时向数据存储添加一些内容。我认为您应该期望仍然被引用的指针仍然有效，如果他们偷偷地拉动桌布，微软就有过错！

@Greedo 的重点是，点击“停止”，你就是偷偷拉桌布的人

请记住，这也是一个仅限开发人员的问题。最终用户不会遇到这个问题，因为他们不会有打开 VBIDE 按下停止按钮的习惯。