Timer leading to locks - delphi

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;