定时器函数和使用回调生成事件

Question

我需要一种比 user32.dll 中的 SetTimer API 更好的引发事件的方法。

您是否成功使用过其他定时器 API？您知道在 Excel 中引发事件或异步调用函数的另一种方法吗？

“更好”是什么意思？我需要一些可以从内部维护的队列中异步弹出消息的东西。问题是外部数据源（路透社市场数据）将项目推送到队列中，该数据源使用 WM_Application 范围内的消息引发其“数据更新”事件； SetTimer 的工作原理是发送 WM_Timer 消息，这是 Windows 消息的七石弱点，我的“Pop”进程永远没有机会运行，即使在相对较少的流量中也是如此。

如果您对更好的架构有任何建议，请随时提出：但传入的数据更新事件绝对必须尽快进入事件“接收器” - 如果事件（或回调）过多，Excel 将崩溃在一些漫长而缓慢的过程正在处理最后一个事件以及之前的事件时引发。我的队列的大小是有限的，因为应用程序中只有几百只股票：传入的数据更新可以查看和更新​​现有项目，如果它是已经在队列中的股票的更新价格，或者推送新股票的股票代码和价格进入队列。因此，从来没有因为我们很忙而丢失任何定价数据，并且对 push 和 peek 函数的简洁编码意味着事件接收器足够快以确保 Excel 保持稳定。

但我一直在寻找一种更好的方式将项目从队列中弹出。

不幸的是，我尝试过的所有其他计时器 API 似乎都不能在 VBA 中工作：它们会使应用程序崩溃或冻结代码执行。这是列表（超链接指向 MSDN 文档）：

1. CreateTimerQueueTimer Lib "Kernel32.dll"
2. CreateWaitableTimer 库“kernel32”
3. TimeSetEvent 库“winmm.dll”

我怀疑我在使用这些函数时遇到的问题与我的语法错误无关：我不太了解 Windows 线程模型，无法说出它们回调时实际发生的情况，但是关于一个其中声明“此回调函数不得调用 TerminateThread 函数”，我认为这意味着 VBA 不能“接收”使用该特定计时器 API 引发的事件。

认为我知道正确的 API 调用来杀死或删除这些计时器及其相关队列：空间有限，可等待计时器使用单独的 Create-、Set-、Cancel- 和 CloseHandle API 调用。 TimerProc 函数的签名都略有不同。

这是标准的 SetTimer 函数调用：

lngTimerID = SetTimer(hWndXL, VBA.ObjPtr(Me), lngInterval, AddressOf TimerProc)

我不会用 TimerProc 函数声明和关于委托的题外话来烦你：如果你能回答这个问题，你已经看过所有相关的代码示例了。

期待您的回复：我有一个正在运行的应用程序，仔细编码和隔离意味着内部数据滞后是可以接受的。但我想我可以做得更好，即使我仅限于提供独立的 Excel 工作簿。

Answer 1

我不是 100% 同意您尝试做的事情，但是计时器 API 可以让您异步“调度”函数调用，但回调当然不会异步执行，因为这一切都发生在同一个线程上。

也就是说，任何回调计时器 API 都应该在 VBA 中工作，例如（使用 n-instances->single callback）：

定时器模块

Public Const TIME_PERIODIC As Long = 1
Public Const TIME_CALLBACK_FUNCTION As Long = &H0
Public Declare Function CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (dest As Any, src As Any, ByVal length As Long) As Long
Public Declare Function timeKillEvent Lib "winmm.dll" (ByVal uID As Long) As Long
Public Declare Function timeSetEvent Lib "winmm.dll" (ByVal uDelay As Long, ByVal uResolution As Long, ByVal lpFunction As Long, ByVal dwUser As Long, ByVal uFlags As Long) As Long

Public Sub tmrCallback(ByVal uID As Long, ByVal uMsg As Long, ByVal dwUser As Long, ByVal dw1 As Long, ByVal dw2 As Long)
    If (dwUser = 0) Then
        timeKillEvent uID
        Exit Sub
    End If

    Dim IDisp As Object
    Dim Obj As Class1

    CopyMemory IDisp, dwUser, 4&
    Set Obj = IDisp
    CopyMemory IDisp, 0&, 4&
    Obj.TimerMethod
End Sub

Class1

Private MYHTIMER As Long
Public Name As String

Private Sub stopTmr()
    If (MYHTIMER) Then timeKillEvent MYHTIMER
End Sub

Private Sub Class_Initialize()
    MYHTIMER = timeSetEvent(1000, 0, AddressOf Module1.tmrCallback, ObjPtr(Me), TIME_PERIODIC Or TIME_CALLBACK_FUNCTION)
End Sub

Private Sub Class_Terminate()
    stopTmr
End Sub

Public Sub TimerMethod()
    Static lCntr    As Long: lCntr = lCntr + 1
    Debug.Print "In " & Me.Name & ".TimerMethod()", "#"; lCntr, CLng(Timer - StartTime) & "secs"
    If (lCntr = 2) Then TestBlockThreadFor5Secs
    If (lCntr >= 3) Then stopTmr
End Sub

测试

Public A As Class1
Public B As Class1

Sub test()
    Set A = New Class1: A.Name = "inst1"
    Set B = New Class1: B.Name = "inst2"
End Sub

Sub TestBlockThreadFor5Secs()
    Debug.Print "**blocking"
    t = Timer:
    Do Until Timer - t = 5: Loop
End Sub

结果

In inst1.TimerMethod()      # 1           1secs
In inst2.TimerMethod()      # 1           1secs
In inst1.TimerMethod()      # 2           2secs
**blocking
In inst1.TimerMethod()      # 3           7secs
In inst2.TimerMethod()      # 2           7secs
**blocking
In inst2.TimerMethod()      # 3           12secs