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

我正试图用setTimerAPI做一些小把戏，终于能够为我一直遇到的问题创建一个可复制的示例。当我将自定义类的实例传递给回调时，我遇到了一个错误，但对于内置/库类则没有

以下是我想做的：

使用

通过将timerID（

UINT\u 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。传递数据

我已经定义了一个回调函数签名，它符合

如您所见，UINT\u 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定时器不会被破坏，所以我的对象也不能被破坏。出于这个原因，我正在使用建议的方法


问题
好的，把所有这些放在一起创建一个MRE（或者现在的缩写词）：

这实际上和预期的完全一样！输出如下所示：

1我就是你传递的数据！
我是你传递的数据！
我是你传递的数据！
我是你传递的数据！
5我就是你传递的数据 好吧，如果您按下Stop键，那么我认为期望指向从VBA定义的类创建的对象的指针继续有效是不合理的。对于一个非常耐用的类，你需要用C++（或者C++或Python，甚至VB6）来写它。
 Ps.，如果你像我一样使用McSyLB有问题，那可能是因为在这种情况下，要么遵循其中的解决方案，要么像安装（启用）指令一样使用MalCISIB V2来安装/启用.NET 3.5。@MathieuGuindon
End
以类似的方式对所有内容进行核处理，但也意味着
TIMERPROC
永远不会返回，这会破坏Excel的消息循环（或该线程上的循环）-我认为，如果在回调执行过程中对停止按钮进行部分计算，则停止按钮也会这样做，但它似乎只会在调用
TIMERPROC
之间着陆，所以这不是问题。（这可能是因为按钮按下在UI线程中运行，因此在
WM_TIMER
消息之间排队，因此无法中断执行；同样的原因，您需要
DoEvents
分散在各个位置，停止按钮才能工作）生成无模式，不可见的用户窗体并使用该hWnd而不是Excel？您无法安全地执行您正在尝试执行的操作。
nIDEvent
参数是一个唯一的计时器ID。它是指针大小的，因此您可以将虚拟对象的地址作为ID传递。执行此操作的每个客户端都将保证获得唯一的ID。它不是要传递实际数据。问题是，如果您的计时器过程运行，您将如何区分那些使用任何唯一ID的计时器，以及那些ID是指向对象的指针的计时器？如果可以，计时器过程已经知道对象的地址，那么为什么要传递它呢？多亏了@IInspectable的健全性检查；它在重置透视图方面很有用，但我已将代码更改为不使用接口指针，而是使用32位长（某些文本的hashval），但它仍然崩溃，因为它试图调用fakeDictionary类。为什么会崩溃？因为它是一个VBA定义的类，您将其拆下。我相信，如果你把你的代码转移到一个二进制编译的载体上，这种情况就会消失。在您自己的实验中，Scripting.Dictionary幸存了下来，但您的自定义VBA类没有。在按下“停止”后（即，在执行上下文被核化后），强制对象停留相当于故意造成内存泄漏。这不能很好地结束。FWIW，如果您选择获取（而不是免费），您将能够在不重置全局状态的情况下停止。似乎比试图创建准进程外存储更干净。否则，不要点击停止按钮。把它当作一个IDK我不相信。。。VBA类与任何其他COM对象一样，使用引用计数来保持活动状态，对吗？其中的解释是，我使用的缓存方法只是向对象添加一个引用，并将其存储在具有Excel进程生命周期的位置。这相当于在对窗口进行子类化时向数据存储添加某些内容。我认为你应该期望仍然被引用的指针保持有效，如果微软做了一个鬼鬼祟祟的桌布拉动，那他们就是错的@Greedo的要点是，通过点击“停止”，你就是在做鬼鬼祟祟的桌布拖拉的人。记住，这是一个只针对开发人员的问题
Dim timerParams As Object
'... initialise the object with the data to pass
SetTimer hWnd:=Application.hWnd, nIDEvent:=ObjPtr(timerParams), uElapse:=500, lpTimerFunc:=AddressOf timerProc

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

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

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