定時器導致鎖

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;