Delphi 通向锁的计时器

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

我的应用程序调用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，这意味着一切正常，我们可以退出并继续

若事件在一定时间内未触发，则我退出并通知用户

这段代码有时会创建线程锁

我的应用程序和COM库停止响应。 锁是什么原因造成的

如何改进上述代码

---

谢谢。

事件的全部目的是不编写同步阻塞代码

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;

---

事件的全部目的是不编写同步阻塞代码

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;

---

如果没有更多的COM库、线程模型等知识，很难说。当然，问题中的代码看起来确实很可疑，首先是调用

Sleep

和

Application.ProcessMessages

。我的应用程序中没有使用线程。COM库可能在内部使用线程，但我不知道。我不需要Application.ProcessMessages来检查我的bwait变量是否已由COM库事件设置吗？我将尝试不使用sleep&Application.ProcessMessages的代码。感谢不要尝试使用异步模型编写同步代码。使用事件的全部意义在于，你应该继续做任何你想做的事情；然后在事件触发时处理该事件。尝试撤销会将所有好处抛在脑后，并强制您阻止代码，直到您收到某个特定事件。。。如果你没有收到怎么办？一切都锁上了！如果没有更多的COM库、线程模型等知识，很难说。当然，问题中的代码看起来确实很可疑，首先是调用

Sleep

和

Application.ProcessMessages

。我的应用程序中没有使用线程。COM库可能在内部使用线程，但我不知道。我不需要Application.ProcessMessages来检查我的bwait变量是否已由COM库事件设置吗？我将尝试不使用sleep&Application.ProcessMessages的代码。感谢不要尝试使用异步模型编写同步代码。使用事件的全部意义在于，你应该继续做任何你想做的事情；然后在事件触发时处理该事件。尝试撤销会将所有好处抛在脑后，并强制您阻止代码，直到您收到某个特定事件。。。如果你没有收到怎么办？一切都锁上了！我对您的第二个解决方案感兴趣，但无法使其按我所希望的方式工作。我正在执行以下操作：SetTimer（MsgWnd，1100x1000，@MyTimer）；调用代码，该代码将触发我的事件，而如果事件被触发，则为true do begin，或者timedOut然后退出；end While do循环似乎阻止事件触发。关于这个问题有什么建议吗？谢谢。@Walid摆脱

while

循环，调用COM代码后立即退出。这个循环不属于你。这就是第二个示例的全部要点，即不使用任何循环all@Remy_Lebeau如何保证在DoIt（）退出之前触发事件或超时？事件在每次DoIt退出后都成功激发。这就是我想要实现的：1）设置计时器；2） 调用触发事件的代码3）如果事件触发，我们可以进入下一步\If timedOut然后通知用户谢谢。阅读您的&Craig评论。看起来我还需要其他东西，因为我需要等待事件触发或超时。第一个示例似乎阻止事件触发。有什么建议吗？谢谢。@Walid“如何保证在DoIt（）退出之前触发事件或timeout？”-应该在触发事件之前退出，这就是第二个示例的要点。让

DoIt（）

退出允许控制返回到主消息循环，从而保持UI响应，COM在后台工作，直到触发COM事件或计时器超时。如果您需要在退出之前让

DoIt（）

等待事件/超时，那么您就回到了原始问题，因此需要运行第二个消息循环，如我的第一个示例中所示。我对您的第二个解决方案感兴趣，但无法让它按我的意愿工作。我正在执行以下操作：SetTimer（MsgWnd，1100x1000，@MyTimer）；调用代码，该代码将触发我的事件，而如果事件被触发，则为true do begin，或者timedOut然后退出；end While do循环似乎阻止事件触发。关于这个问题有什么建议吗？谢谢。@Walid摆脱

while

循环，调用COM代码后立即退出。这个循环不属于你。这就是第二个示例的全部要点，即不使用任何循环all@Remy_Lebeau如何保证在DoIt（）退出之前触发事件或超时？事件在每次DoIt退出后都成功激发。这就是我想要实现的：1）设置计时器；2） 调用触发事件的代码3）如果事件触发，我们可以进入下一步\If timedOut然后通知用户谢谢。阅读您的