定时器功能和使用回调生成事件

时间:2010-06-09 17:22:00

标签: vba excel-vba excel

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

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

“更好”是什么意思?我需要能够异步地从内部维护的队列中弹出消息的东西。问题是项目被外部数据源(路透社市场数据)推送到队列中,该数据源使用WM_Application范围内的消息引发其“数据更新”事件; SetTimer的工作原理是发送WM_Timer消息,这是Windows Messaging的七大弱点,即使在流量相对较小的情况下,我的“Pop”进程也永远无法运行。

如果您对更好的架构有建议,请随时提供:但传入的数据更新事件绝对必须尽快进入事件“接收器” - 如果有太多事件(或回调),Excel将崩溃当一些漫长而缓慢的过程正在处理最后一个事件时,以及之前的事件被提升。我的队列有一个有限的大小,因为应用程序中只有几百个股票:传入的数据更新可以查看和更新​​现有项目,如果它是已经在队列中的股票的更新价格,或推送新股票的股票和价格到队列。因此,由于我们很忙,所以没有定价数据丢失,而且推送和查看功能的清晰编码意味着事件接收器足够快以确保Excel保持稳定。

但是我还在寻找一种更好的方法来排除队列中的项目。

不幸的是,我尝试过的所有其他计时器API似乎都无法在VBA中运行:它们会使应用程序崩溃或冻结代码执行。这是列表(超链接指向MSDN文档):

  1. CreateTimerQueueTimer Lib "Kernel32.dll"
  2. CreateWaitableTimer Lib“kernel32”
  3. TimeSetEvent Lib“winmm.dll”
  4. 我怀疑我对这些功能的问题与我的语法错误无关:我不太清楚Windows线程模型是否足以说明他们回调时实际发生了什么,但是文档在一个他们说“这个回调函数不能调用TerminateThread函数”,我认为这意味着VBA不能“吸收”使用该特定计时器API引发的事件。

    请注意,我知道正确的API调用Kill或删除这些定时器及其相关队列:空间有限,Waitable Timer使用单独的Create-,Set-,Cancel-和CloseHandle API调用。并且TimerProc功能都有略微不同的签名。

    这是标准的SetTimer函数调用:

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

    我不会厌倦TimerProc函数声明和关于委托的离题:如果你能回答这个问题,你已经看过所有相关的代码示例。

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

1 个答案:

答案 0 :(得分:1)

我不是100%尝试做什么,但是计时器API会让你异步“调度”一个函数调用,但回调当然不会异步执行,因为它全部发生在同一个线程上。

也就是说,任何回调计时器API都应该在VBA中工作,例如(使用n-instances->单回调):

计时器模块

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