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布尔变量设置为true，这意味着所有好处，我们可以退出并继续。

如果事件在一定时间内没有被解雇，那么我退出＆amp;告知用户。

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

我的应用程序和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;
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;

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

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;

计时器导致锁定

1 个答案: