Timer leading to locks

Question

Can anyone tell me why this code is leading to my application to stop responding.

My application calls a COM library. I wait for the COM library events to fire so that I can carry on. I use a timer to keep checking if the COM library fired:

procedure MyTimer(hWnd: HWND; uMsg: Integer; idEvent: Integer; dwTime:   Integer); stdcall;
begin
  //writeln('Timer Event');
end;

I keep checking if the event fired this way:

procedure MyClass.Loop(bwait: boolean);
var
s: TDateTime;
id: uint;
begin
  try
    id := SetTimer(0, 1, 1000, @MyTimer);
    s := Now;
    while bwait do
    begin
      sleep(30);
      Application.ProcessMessages;
      if bwait = false then // Event fired, all good=> exit
      begin
        KillTimer(0, id);
        break;
      end;

      if Now - s > EncodeTime(0, 0, 1000, 0) then // Timed out=> exit
      begin
        KillTimer(0, id);
        break;  
      end;
    end;

  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
end;

When the COM library event fires it sets the bwait boolean variable to true which means all good and we can exit and carry on.

If event hasn't fired within a certain time then I exit & inform user.

This code sometimes creates thread locks.

My application and the COM library stop responding. What's causing the lock ?

How can the above code be improved ?

Thank you.

Answer 1

The whole purpose of events is to NOT write synchronous blocking code.

Application.ProcessMessages() is not intended to process COM messages. You can use TEvent instead, which has a UseCOMWait parameter to make the TEvent.WaitFor() method use CoWaitForMultipleHandles() internally to process the COM message loop while waiting for the event to be signaled.

uses
  ..., DateUtils, SyncObjs;

type
  MyClass = class
  private
    doneEvent: TEvent;
    procedure COMEventHandler(parameters);
    procedure Loop(bWait: Boolean);
    ...
  public
    constructor Create;
    destructor Destroy; override;
    procedure DoIt;
  end;

constructor MyClass.Create;
begin
  inherited;
  ...
  doneEvent := TEvent.Create(True);
end;

destructor MyClass.Destroy;
begin
  ...
  doneEvent.Free;
  inherited;
end;

procedure MyClass.COMEventHandler(parameters);
begin
  doneEvent.SetEvent;
end;

procedure MyClass.Loop(bWait: Boolean);
var
  s: TDateTime;
begin
  if not bWait then Exit;
  try
    s := Now;

    repeat
      case doneEvent.WaitFor(30) of
        wrSignaled: begin
          // Event fired, all good=> exit
          Break;
        end;
        wrTimeout: begin
          if MillisecondsBetween(Now, s) > (1000 * 1000) then
          begin
            // Timed out=> exit
            Break;  
          end;
          if GetQueueStatus(QS_ALLINPUT) <> 0 then
            Application.ProcessMessages;
        end;
        wrError: begin
          RaiseLastOSError(doneEvent.LastError);
        end;
      end;
    until False;
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
end;

procedure MyClass.DoIt;
begin
  doneEvent.ResetEvent;
  // invoke COM function that will eventually trigger the COM event...
  Loop(True); // wait for event to fire or timer to elapse...
  ...
end;

But this is not the correct way to write event-driven code. Like any asynchronous system, you should break up your code into smaller pieces and let the events notify your code when to invoke those pieces. Don't write blocking code at all. For example:

const
  APPWM_COM_EVENT_DONE = WM_APP + 1;
  APPWM_COM_EVENT_TIMEOUT = WM_APP + 2;

type
  MyClass = class
  private
    MsgWnd: HWND;
    procedure COMEventHandler(parameters);
    procedure WndProc(var Message: TMessage);
  public
    constructor Create;
    destructor Destroy; override;
    procedure DoIt;
  end;

constructor MyClass.Create;
begin
  inherited;
  MsgWnd := AllocateHWnd(WndProc);
end

destructor MyClass.Destroy;
begin
  KillTimer(MsgWnd, 1);
  DeallocateHWnd(MsgWnd);
  inherited;
end;

procedure MyClass.COMEventHandler(parameters);
begin
  KillTimer(MsgWnd, 1);
  PostMessage(MsgWnd, APPWM_COM_EVENT_DONE, 0, 0);
end;

procedure MyTimer(hWnd: HWND; uMsg: UINT; idEvent: UINT_PTR; dwTime:   DWORD); stdcall;
begin
  KillTimer(hWnd, idEvent);
  PostMessage(hWnd, APPWM_COM_EVENT_TIMEOUT, 0, 0);
end;

procedure MyClass.WndProc(var Message: TMessage);
begin
  case Message.Msg of
    APPWM_COM_EVENT_DONE:
    begin
      // Event fired, all good
    end;

    APPWM_COM_EVENT_TIMEOUT:
    begin
      // Event timed out
    end;

  else
    begin
      Message.Result := DefWindowProc(MsgWnd, Message.Msg, Message.WParam, Message.LParam);
    end;
  end;
end;

procedure MyClass.DoIt;
begin
  SetTimer(MsgWnd, 1, 1000 * 1000, @MyTimer);
  // invoke COM function that will eventually trigger the COM event...
  // exit now, let WndProc() handle the notifications later...
end;