定时器导致锁

Question

谁能告诉我为什么这段代码导致我的应用程序停止响应。

我的应用程序调用一个COM库。我等待COM库事件触发，以便继续。 我用一个定时器，以保持检查是否COM库解雇：

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

我继续检查，如果触发的事件是这样的：

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; 

当COM库事件触发其设置BWAIT布尔变量这意味着一切都很好，我们可以退出并继续前进。

如果事件未在一定时间内触发，则退出&通知用户。

此代码有时会创建线程锁。

我的应用程序和COM库停止响应。 什么导致锁？

上述代码如何改进？

谢谢。

Answer 1

事件的全部目的是不编写同步分块代码。

Application.ProcessMessages()不适用于处理COM消息。您可以使用TEvent代替UseCOMWait参数，以使TEvent.WaitFor()方法在内部使用CoWaitForMultipleHandles()来处理COM消息循环，同时等待事件发出信号。

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; 
    id: UINT; 
begin 
    try 
    doneEvent.ResetEvent; 
    s := Now; 

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

procedure MyClass.DoIt; 
begin 
    // invoke COM function that will eventually trigger the COM event... 
    Loop(True); 
end; 

但是，这不是编写事件驱动代码的正确方法。与任何异步系统一样，您应该将代码分解为更小的代码，并让事件通知您的代码何时调用这些代码。根本不要编写阻止代码。例如：

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... 
end;