High resolution timer wrapped in a COM object

Only recently I needed a timer with a shorter interval than that the Ocx Timer can provide. The Ocx Timer smallest interval is 15.625 ms – 64 ticks per second - where I needed an interval of 10 ms to receive 100 timer-events per second. After some research I decided to use the API function CreateTimerQueueTimer() as a high-resolution timer. For a discussion on available timers see this Code Project article. I didn’t use the multi-media timers because MS advises against it, because these timers increase the system clock’s frequency which leads to a drain of battery-power on mobile devices. Nevertheless, the CreateTimerQueueTimer() API only produces shorter intervals than 15.625 ms if the the application’s system clock is adjusted as well using the multimedia function timeBeginPeriod(). This function cannot be used to increase the resolution of the SetTimer API which is used by the Ocx Timer.

A resource must be deleted
As with most Windows resources the queued timer comes with a create- and a release function. The created timer is released using the Windows API DeleteTimerQueueTimer() and is (usually) invoked when the program terminates. In addition, at the very end of the application, the system timer must be reset using timeEndPeriod(). The most common scenario for a GB program is outlined in this simple program:

$Library "mmsystem.inc"
OpenW 1
Global timerHandle As Handle, param As Large
' Create a 10 ms timer with ID=1 for Me
param = MakeLargeHiLo(Me.hWnd, 1)   ' assemble handle and ID
~timeBeginPeriod(1)
CreateTimerQueueTimer(timerHandle, Null, _
  ProcAddr(TimerQProc), V:param, 0, 10, WT_EXECUTEINTIMERTHREAD)
Do
  Sleep
Until Me Is Nothing
DeleteTimerQueueTimer(Null, timerHandle, Null)
~timeEndPeriod(1)

Proc TimerQProc(ByVal pParameter As Long, ByVal TimerOrWaitFired As Long) Naked
  ' Process timer event
  Dim pL As Pointer Large, hWnd As Handle, ID As Long
  Pointer pL = pParameter
  hWnd = HiLarge(pL), ID = LoLarge(pL)
EndProc

This sample only shows the general structure of a program that uses a Windows timer resource, the structure of the program is the same if it uses some other Windows resource. In this scenario a Windows resource is allocated before entering the message loop and released after the message loop has finished and the last Form has closed. However, when the program unexpectedly stops with a runtime-error the code below the message loop is never executed! This leads to unreleased Windows resources, something you don’t want. When GB raises a runtime error it stops at the line the error occurred and halts further execution of the program. The program’s windows (Forms) remain on the screen waiting to be closed or ‘cleaned up’ by using the wipe-window button in the IDE’s toolbar. Closing the remaining windows this way does not trigger any event subs like - for instance - the Form_Destroy event sub. Consequently, it is  pointless to move the resource delete function to this event sub, because it is not executed once the program stopped with a runtime error.

Each time the program is run within the IDE and stops with a runtime error it does not release the allocated resources. But, this is also true for the GB function mAlloc calls that require a call to mFree to release the memory. We need a way to release allocated resources under all circumstances. 

Using a COM wrapper
When GB stops executing after a runtime error it still releases GB resources, it closes I/O channels and deletes any TempFileName files, and finally it clears all the program’s global variables. For dynamic variables types (String, Object, arrays, hashes) the allocated memory is freed as well. (Therefore, it is sometimes better to use a string to allocate memory than to use mAlloc, strings are freed automatically.) For global variables that hold a COM object GB calls the Release vtable function of the IUnknown interface that each COM object implements. So, if we could wrap the resource handling in a (minimal) COM wrapper and store it in an Object type we are assured the Release function is called and we can properly delete the resource in the object’s Release function. This way we’re able to free the resources under all conditions.

If you’re not familiar with COM objects and the IUnknown implementation you might read a previous post first: COM in GB32 – IUnknown. The rest of this post discusses how to create a minimal COM wrapper for the queued timer APIs.

The minimal COM wrapper
The following full working sample creates a queued timer in the QueTimer function which returns an Object that holds a reference to the minimal COM object it creates. A COM object must at least implement the IUnknown interface that consists of the QueryInterface, AddRef and Release functions. Since this COM object doesn’t support any other interfaces (except IUnknown) we simply return with E_NOTIMPL from the QueryInterface function. The COM object is built manually in code and cannot be created by a function like CreateObject(). As a result QueryInterface is never called. The AddRef and Release functions require a proper implementation since these vtable functions are called by GB’s Set command.
The vtable functions must have the Naked attribute, or at least a $StepOff command, to prevent the GB compiler from inserting Tron code which can result in nasty and hard to find bugs. This is also true for any callback function Windows calls; the QueTimer callback procedure needs the Naked attribute as well.

$Library "mmsystem.inc"

OpenW 1, 0, 0, 300, 300, 48
PrintScroll = 1 : PrintWrap = 1

Global Object tmrQ1, tmrQ2
Set tmrQ1 = QueTimer(Me, 1, 10)   ' ID=1, 10 msec
Set tmrQ2 = QueTimer(Me, 2, 1000) ' ID=2, 1000 msec

Global Long Count, CountToErr
Do
  Sleep
Until Me Is Nothing

Sub Win_1_Message(hWnd%, Mess%, wParam%, lParam%)
  ' Process the WM_TIMER
  Static Long CountToErr
  If Mess% = WM_TIMER
    If wParam% == 1
      Count++
      Print ".";      // do something
    ElseIf wParam% == 2
      TitleW 1, "Timer Events/s:" + Str(Count) : Count = 0
      ' Interrupt GB with a runtime error after 10 sec
      CountToErr++ : If CountToErr = 10 Then Error 3
    EndIf
  EndIf
EndSub

Proc QueTimerProc(ByVal pParameter As Long, ByVal TimerOrWaitFired As Long) Naked
  ' Callback function
  Local hWnd As Handle, id As Long, pObj As Pointer IQueTimer
  Pointer pObj = pParameter             ' holds address of a IQueTimer object
  ~PostMessage(pObj.hWndTarget, WM_TIMER, pObj.TimerID, 0)
EndProc


Function QueTimer(frm As Form, id As Long, mSec As Long) As Object
  ' Create high-resolution timer wrapped in a minimal COM object.
  Global Long g_IQueTimerCnt

  Type IQueTimer         ' definition of object
    lpVtbl As Long
    refcount As Long
    Handle As Handle
    hWndTarget As Handle
    TimerID As Long
  EndType

  ' Set up the IUnknown vtable, same for each object
  Static vTable(0 .. 2) As Long    ' must remain in memory
  If vTable(0) == 0                ' do this only once
    vTable(0) = ProcAddr(IQueTimerVtbl_QueryInterface)
    vTable(1) = ProcAddr(IQueTimerVtbl_AddRef)
    vTable(2) = ProcAddr(IQueTimerVtbl_Release)
  EndIf

  ' Alloc and clear an IQueTimer object (Type) and
  ' assign it to an IQueTimer pointer.
  Local pObj As Pointer IQueTimer
  Pointer pObj = cAlloc(1, SizeOf(IQueTimer))

  ' Initialize the IQueTimer object
  pObj.lpVtbl = ArrayAddr(vTable())     ' set vtable
  pObj.refcount = 1                     ' set refcount
  pObj.hWndTarget = frm.hWnd            ' target window
  pObj.TimerID = id                     ' timer ID

  ' Create the API timerqueue resource and
  ' if succesfull finish the COM object, otherwise
  ' free the allocated memory.
  Local timerHandle As Handle
  If CreateTimerQueueTimer(timerHandle, Null, _
    ProcAddr(QueTimerProc), Pointer(pObj), 0, mSec, WT_EXECUTEINTIMERTHREAD)
    '  store the resource handle in the object
    pObj.Handle = timerHandle

    ' Set the system's clock resolution to 1 ms,
    ' do this only once per application.
    If g_IQueTimerCnt == 0 Then ~timeBeginPeriod(1)
    g_IQueTimerCnt++            ' count the number of instances

    ' Return COM object as Object
    {V:QueTimer} = Pointer(pObj)

  Else    ' something went wrong, release already allocated resource(s)
    ~mFree(Pointer(pObj))     ' free the alloced memory

    ' Do not set returnvalue to return Nothing
  EndIf
EndFunc

Function IQueTimerVtbl_QueryInterface(ByRef This As IQueTimer, _
  ByVal riid As Long, ByVal ppvObject As Long) As Long Naked
  Return E_NOTIMPL
EndFunc

Function IQueTimerVtbl_AddRef(ByRef this As IQueTimer) As Long Naked
  this.refcount++
  Return this.refcount
EndFunc

Function IQueTimerVtbl_Release(ByRef this As IQueTimer) As Long Naked
  this.refcount--
  If this.refcount == 0
    MsgBox "terminating" ' remove comment to see that Release is called
    DeleteTimerQueueTimer(Null, this.Handle, Null)
    g_IQueTimerCnt--     ' decrease instance counter
    ' If all instances are released, reset the system clock
    If g_IQueTimerCnt == 0 Then ~timeEndPeriod(1)
    ~mFree(*this)
  EndIf
  Return this.refcount
EndFunc

' Declares and Constants
Declare Function CreateTimerQueueTimer Lib "kernel32" (ByRef hNewTimer As Handle, _
  ByVal hTimer As Handle, ByVal Callbck As Long, ByVal Parameter As Long, _
  ByVal DueTime As Long, ByVal Period As Long, ByVal Flags As Long) As Long

Declare Function DeleteTimerQueueTimer Lib "kernel32" (ByVal hTimer As Handle, _
  ByVal Timer As Handle, ByVal CompletionEvent As Handle) As Long

Global Const E_NOTIMPL = 0x80004001
Global Const WT_EXECUTEINTIMERTHREAD = 0x00000020

The program creates two high-resolution timers and stores the minimal COM wrappers in the Object variables tmrQ1 and tmrQ2. The second timer is used to display the number of timer events per second produced by timer 1. There is nothing you can do with the Object variables, the minimal COM wrapper does not support any properties or methods. The Set command is the only command that can be used on these objects. The only reason for the existence of these Object variables is to sit and wait to be released so that the resources can be deleted properly. In fact, you could collect all globally used resources into the creation function – here QueTimer() - and release them in the Release vtable function.
To demonstrate the proper calling of the object’s Release the program raises an error after 10 seconds. A message box pops up to show you that Release is invoked after a runtime error.

Finally
If you’re not familiar with the binary layout of a COM object and maybe having trouble understanding how the COM object is build, don’t worry. You can copy paste this code to create your own minimal COM wrapper, simply replace the string ‘QueTimer’ with a name of your own (do not select Whole Word in the Replace dialog box). Then replace the code that creates and deletes the Windows resource with the functions you require. Of course you will need to edit the IQueTimer type that holds the information for a particular COM object.