3
\$\begingroup\$

Asynchronous programming is tricky enough already, and VBA doesn't make life any easier. I wanted to create some basic functionality to allow async processes to mark completion without having to implement any complicated interfaces.

The basic idea was to raise a regular stream of events, or Ticks, and then to check the value of a supplied variable each time. These are performed in the Tick method of a main class:

Class: asyncTimer

Option Explicit

Implements ITicker 'to allow tick method to remain hidden

Public Event Tick()
Public Event Timeout()
Public Event Complete()

Private Const waitIndefinitely As Double = -1

Private Type tTimer
    tickFrequency As Double                      'in seconds
    startTime As Double
    endTime As Double
    neverTimeout As Boolean
    conditionAddress As LongPtr
End Type

Private this As tTimer

Public Sub Await(ByRef processComplete As Boolean, Optional ByVal tickFrequency As Double = 0.5, Optional ByVal maxWait As Double = 10)
    this.conditionAddress = VarPtr(processComplete)
    If maxWait = waitIndefinitely Then
        this.neverTimeout = True
    ElseIf maxWait >= 0 Then
        this.startTime = timer
        this.endTime = this.startTime + maxWait
    Else
        Err.Raise 5, , "Max wait must be positive or -1 (for no timeout)"
    End If

    startTicking tickFrequency, Me
End Sub

Private Sub ITicker_Tick()
    If Peek(this.conditionAddress, vbBoolean) Then 'check if val has changed
        stopTicking
        RaiseEvent Complete
    ElseIf timer > this.endTime Then
        stopTicking
        RaiseEvent Timeout
    Else
        RaiseEvent Tick
    End If
End Sub

Private Sub Class_Terminate()
    stopTicking
End Sub

The class implements an interface in order to keep its methods secret.

Class: ITicker

Public Sub Tick()
End Sub

A regular stream of events (well callbacks really) are what drives everything in its asynchronous glory. These are generated with a Windows API Timer to schedule regular function calls:

Module: TickGenerator

Option Explicit

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

Private Type tGenerator
    caller As ITicker
    timerID As Long
End Type

Private this As tGenerator

Public Sub startTicking(ByVal tickFrequency As Double, ByVal caller As ITicker)
    Set this.caller = caller
    this.timerID = SetTimer(0, 0, tickFrequency * 1000, AddressOf Tick)
End Sub

Private Sub Tick(ByVal HWnd As Long, ByVal uMsg As Long, ByVal nIDEvent As Long, ByVal dwTimer As Long)
    this.caller.Tick
End Sub

Public Sub stopTicking()
    On Error Resume Next
    KillTimer 0, this.timerID
End Sub

The whole setup runs until a certain condition is met, or the class raches a timeout value. The idea was to pass the condition ByRef which means if the caller code changed its value to True (marking the async task complete), the timer code would be aware of it. However a bit of trickery is required to monitor a value passed to a class ByRef, involving checking the memory at the address of the variable. A utility module holds the generic method (as described here)

Module: asyncMethods

Option Explicit

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (dest As _
                                                                     Any, source As Any, ByVal bytes As Long)

' read a value of any type from memory

Public Function Peek(ByVal address As Long, ByVal ValueType As VbVarType) As Variant
    Select Case ValueType
    Case vbByte
        Dim valueB As Byte
        CopyMemory valueB, ByVal address, 1
        Peek = valueB
    Case vbInteger
        Dim valueI As Integer
        CopyMemory valueI, ByVal address, 2
        Peek = valueI
    Case vbBoolean
        Dim valueBool As Boolean
        CopyMemory valueBool, ByVal address, 2
        Peek = valueBool
    Case vbLong
        Dim valueL As Long
        CopyMemory valueL, ByVal address, 4
        Peek = valueL
    Case vbSingle
        Dim valueS As Single
        CopyMemory valueS, ByVal address, 4
        Peek = valueS
    Case vbDouble
        Dim valueD As Double
        CopyMemory valueD, ByVal address, 8
        Peek = valueD
    Case vbCurrency
        Dim valueC As Currency
        CopyMemory valueC, ByVal address, 8
        Peek = valueC
    Case vbDate
        Dim valueDate As Date
        CopyMemory valueDate, ByVal address, 8
        Peek = valueDate
    Case vbVariant
        ' in this case we don't need an intermediate variable
        CopyMemory Peek, ByVal address, 16
    Case Else
        Err.Raise 1001, , "Unsupported data type"
    End Select

End Function

What I'm after

I'd like a bit of feedback on a few areas in particular:

  • Use of Api functions. They seem to be leading to a few crashes!
  • Use of the ITicker interface. I've never used interfaces to hide methods before
  • User interface; I've tried to keep it very simple with friendly VBA Events, but is this useful?
  • Errors; how should I be raising them. This is a very simple application so I haven't done anything fancy

Test code

One example of using this is in monitoring user interaction such as worksheet selection changes

Sheet1:

Option Explicit

Private WithEvents testclass As asyncTimer
Private countReached As Boolean

Sub runtests()
    Set testclass = New asyncTimer
    countReached = False
    Range("A1") = 1
    Range("B1") = 1
    testclass.Await countReached, 0.5, 5
End Sub

Private Sub testclass_Complete()
    MsgBox "done"
End Sub

Private Sub testclass_Tick()
    Range("B1") = Range("B1") + 1
End Sub

Private Sub testclass_Timeout()
    MsgBox "timeout"
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Range("A1") = Range("A1") + 1
    countReached = Range("A1") > 10
    Range("A2") = countReached
End Sub

Here the value of A1 shows the number of selection change events, A2 whether the condition (as seen by the timer) is True or False, and B1 shows the number of elapsed Ticks.

\$\endgroup\$
  • 1
    \$\begingroup\$ Doesn't that make VBA go into [Running] mode several times a second? If that's the case, that could be just bad if not worse than running synchronously because you're forcing the VBA to do numerous context switching to process messages from the timer, and worse, it may choose to reject the messages so you run a risk of completely missing the changes you wanted to monitor. \$\endgroup\$ – this Sep 2 '18 at 21:06
  • \$\begingroup\$ Is this building on your previous asynchronous and/or timer questions? \$\endgroup\$ – Raystafarian Sep 3 '18 at 22:32
  • \$\begingroup\$ @this I'm not very familiar with the way this timer works so I'm not sure I fully understand. I'm not sure what [Running] mode is; I guess you just mean that this code does not run continuously like a DoEvents loop would, and that adds overhead. But that's true of any Async event source (e.g.WinHttpRequest) isn't it - and they seem to be prevalent. I'll have to run some tests to compare efficiency. Also, what's this about ignoring messages? Do you mean that too many callbacks will lead to some (or all) being ignored after a while, or that my VBA Event handlers will miss some events? \$\endgroup\$ – Greedo Sep 4 '18 at 11:38
  • \$\begingroup\$ @Raystafarian I was wondering that myself. I see an immediate issue; that if this technique were to be used with multiple processes like in my quasi-multithreading question, then I would need support for multiple timers. Currently that would probably lead to crashes as timers are overwritten or stopped, and random bits of memory are accessed. \$\endgroup\$ – Greedo Sep 4 '18 at 11:42
  • \$\begingroup\$ You elected to keep this question and do want answers? \$\endgroup\$ – Raystafarian Sep 11 '18 at 23:29

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Browse other questions tagged or ask your own question.