Windows XP WinMM.DLL no event run as service

Hi there,

we have an application  which uses quiete critical timing using WinMM.DLL.
The code of the unit (CairnTimer) is as follows :

unit cairntimer;

interface

uses
  Windows, SysUtils, Classes, Dialogs;
type
  TCairnTimerThread = class;

  TCairnTimer = class(TComponent)
  private
    TimerOn : Boolean;
    TimerThreadPriority : TThreadPriority;
    TimerPaused : Boolean;
    TimerDelay : Cardinal;
    TimerResolution : Cardinal;
    TimerTicks : Cardinal;
    TimerMilliSeconds : Cardinal;
    OnTimerEvent : TNotifyEvent;
    OnTimerEventHandle : Integer;
    TimerName : Integer;
  protected
    procedure InitTimer;
    procedure SetTimerTicks(NewTicks : Cardinal);
    procedure UpdateTimerStatus(NewOn : Boolean);
    procedure UpdateTimerPriority(NewPriority : TThreadPriority);
  public
    CairnTimerThread : TCairnTimerThread;
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;
    procedure Resume;
    procedure Pause;
    property Ticks : Cardinal read TimerTicks default 0;
    property MilliSeconds : Cardinal read TimerMilliSeconds default 0;
  published
    property Enabled : Boolean read TimerOn write UpdateTimerStatus default False;
    property TimerPriority : TThreadPriority read TimerThreadPriority write UpdateTimerPriority default tpNormal;
    property Delay : Cardinal read TimerDelay write TimerDelay default 100;
    property Resolution : Cardinal read TimerResolution write TimerResolution default 10;
    property OnTimer : TNotifyEvent read OnTimerEvent write OnTimerEvent;
  end;

  TCairnTimerThread = class(TThread)
  public
    CairnTimer : TCairnTimer;
    procedure Execute; override;
    Procedure SetTriggerEvent;
  end;

  TCairnTimerCallBack = procedure(NA1, NA2, CairnTimerUser, NA3, NA4 : Integer) stdcall;
  ECairnTimer = class(Exception);

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('System', [TCairnTimer]);
end;

function KillTimer(CairnTimerName : Integer) : Integer; stdcall;
  external 'WinMM.dll' name 'timeKillEvent';

function SetTimer(TimerDelay, TimerResolution : Integer;
  CairnTimerCallBack : TCairnTimerCallBack;
  CairnTimerUser, CairnTimerFlags : Integer) : Integer; stdcall;
  external 'WinMM.dll' name 'timeSetEvent';

procedure TCairnTimerThread.Execute;
var
  TickRecord : Cardinal;
begin
  TickRecord := 0;
  while not (Terminated) and Assigned(CairnTimer) do
  begin
    WaitForSingleObject(CairnTimer.OnTimerEventHandle, INFINITE);
    if CairnTimer.Enabled then
    begin
           Inc(TickRecord);
          CairnTimer.SetTimerTicks(TickRecord);
        if Assigned(CairnTimer.OnTimerEvent) then
          Synchronize(SetTriggerEvent);
    end;
  end;
end;

Procedure TCairnTimerThread.SetTriggerEvent;
Begin
  if assigned(CairnTimer.OnTimerEvent)
    then CairnTimer.OnTimerEvent(CairnTimer);
end;

constructor TCairnTimer.Create(AOwner : TComponent);
begin
  inherited Create(AOwner);
  TimerOn := False;
  TimerDelay := 100;
  TimerResolution := 10;
  TimerPaused := False;
  TimerTicks := 0;
  TimerMilliSeconds := 0;
  TimerThreadPriority := tpNormal;
  OnTimerEventHandle := CreateEvent(nil, False, False, nil);
  CairnTimerThread := TCairnTimerThread.Create(True);
  CairnTimerThread.CairnTimer := Self;
  CairnTimerThread.FreeOnTerminate := false;
  CairnTimerThread.Priority := TimerThreadPriority;
end;

destructor TCairnTimer.Destroy;
begin
  OnTimer := nil;
  Enabled := False;
  with CairnTimerThread do
  begin
    Terminate;
    SetEvent(OnTimerEventHandle);
    if Suspended then Resume;
    WaitFor;
    Free;
  end;
  CloseHandle(OnTimerEventHandle);
  inherited Destroy;
end;

procedure TCairnTimer.SetTimerTicks(NewTicks : Cardinal);
begin
  TimerTicks := NewTicks;
  TimerMilliSeconds := TimerMilliSeconds + TimerDelay;
end;

procedure CairnTimerCallBack(NA1, NA2, CairnTimerUser, NA3, NA4 : Integer); stdcall;
var
  CairnTimer : TCairnTimer;
begin
  CairnTimer := TCairnTimer(CairnTimerUser);
  if Assigned(CairnTimer) then
    if not CairnTimer.TimerPaused then
      SetEvent(CairnTimer.OnTimerEventHandle);
end;

procedure TCairnTimer.InitTimer;
begin
  TimerName := SetTimer(TimerDelay, TimerResolution, @CairnTimerCallBack, Integer(Self), 1);
end;

procedure TCairnTimer.UpdateTimerStatus(NewOn : Boolean);
begin
  if NewOn = TimerOn then
    Exit;
  if (csDesigning in ComponentState) then
  begin
    TimerOn := NewOn;
    Exit;
  end;
  if (NewOn) then
  begin
    CairnTimerThread.CairnTimer.InitTimer;
    CairnTimerThread.Resume;
    TimerPaused := false;
    TimerTicks := 0;
    TimerMilliSeconds := 0;
  end;
  if (not (NewOn)) then
  begin
    KillTimer(TimerName);
    TimerPaused := true;
  end;
  TimerOn := NewOn;
end;

procedure TCairnTimer.UpdateTimerPriority(NewPriority : TThreadPriority);
begin
  if NewPriority = TimerThreadPriority then
    Exit;
  if Assigned(CairnTimerThread) then
  begin
    CairnTimerThread.Priority := NewPriority;
  end;
  TimerThreadPriority := NewPriority;
end;

procedure TCairnTimer.Pause;
begin
  if TimerOn then
    CairnTimerThread.Suspend;
  TimerPaused := True;
end;

procedure TCairnTimer.Resume;
begin
  if TimerOn then
    CairnTimerThread.Resume;
  TimerPaused := False;
end;

end.


Using this timer from an executable application is not a problem at all. However, when we build the application as a service, than the timer stops given events to our application after some time.
The timer is enabled / disabled every 5 seconds.

Anyone had problems of this kind? This is in a production environment. Currently we are running the program as an executable but this is not acceptable for our client since it is a server application.

Thanks for an tips, help or replies from people who had similar problems or know what is causing this.

Tom De Decker