Delphi如何实现看门狗定时器？答案

【问题标题】：How to implement a watchdog timer in Delphi?Delphi如何实现看门狗定时器？
【发布时间】：2015-10-23 18:49:42
【问题描述】：

我想在 Delphi XE 7 中实现一个简单的看门狗定时器，有两个用例：

• 看门狗确保操作执行时间不超过x 秒
• 看门狗确保发生错误时将消息异常存储在日志文件中

您能建议我任何解决方案吗？

【问题讨论】：

我可以使用WaitForSingleObject()吗？
跟踪时间。一旦超过 x 秒，就退出。
@DavidHeffernan 谢谢。当我执行某些操作（例如启动 MSWord）然后应用程序挂起时，可能会出现这种情况。我应该为它创建一个多线程吗？
通过修复程序中的错误来避免挂起不是更容易吗？
解决方案的哪一部分遇到了问题？你已经说明了你想让你的程序做什么，那么是什么阻止你这样做呢？

标签： delphi watchdog

【解决方案1】：

这是我的解决方案。我不确定这是正确的，但它的作品。我创建了一个新线程：

type

  // will store all running processes
  TProcessRecord = record
    Handle: THandle;
    DateTimeBegin, DateTimeTerminate: TDateTime;
  end;

  TWatchDogTimerThread = class(TThread)
  private
    FItems: TList<TProcessRecord>;
    FItemsCS: TCriticalSection;
    class var FInstance: TWatchDogTimerThread;
    function IsProcessRunning(const AItem: TProcessRecord): Boolean;
    function IsProcessTimedOut(const AItem: TProcessRecord): Boolean;
    procedure InternalKillProcess(const AItem: TProcessRecord);
  protected
    constructor Create;
    procedure Execute; override;
  public
    class function Instance: TWatchDogTimerThread;
    destructor Destroy; override;
    procedure AddItem(AProcess: THandle; ADateStart: TDateTime; ATimeOutMS: Cardinal);
  end;
 const
  csPocessThreadLatencyTimeMs = 500;

这是一个实现部分：

procedure TWatchDogTimerThread.Execute;
var
  i: Integer;
begin
  while not Terminated do
  begin
    Sleep(csPocessThreadLatencyTimeMs);
    FItemsCS.Enter;
    try
      i := 0;
      while i < FItems.Count do
      begin
        if not IsProcessRunning(FItems[i]) then
        begin
          FItems.Delete(i);
        end
        else if IsProcessTimedOut(FItems[i]) then
        begin
          InternalKillProcess(FItems[i]);
          FItems.Delete(i);
        end
        else
          Inc(i);
      end;
    finally
      FItemsCS.Leave;
    end;
  end;
end;

procedure TWatchDogTimerThread.AddItem(AProcess: THandle; ADateStart: TDateTime; ATimeOutMS: Cardinal);
var
  LItem: TProcessRecord;
begin
  LItem.Handle := AProcess;
  LItem.DateTimeBegin := ADateStart;
  LItem.DateTimeTerminate := IncMilliSecond(ADateStart, ATimeOutMS);

  FItemsCS.Enter;
  try
    FItems.Add(LItem);
  finally
    FItemsCS.Leave;
  end;
end;

constructor TWatchDogTimerThread.Create;
begin
  inherited Create(False);
  FItems := TList<TProcessRecord>.Create;
  FItemsCS := TCriticalSection.Create;
end;

destructor TWatchDogTimerThread.Destroy;
begin
  FreeAndNil(FItemsCS);
  FItems.Free;
  FInstance := nil;
  inherited;
end;

class function TWatchDogTimerThread.Instance: TWatchDogTimerThread;
begin
   if not Assigned(FInstance) then
    FInstance := Create;
  Result := FInstance;
end;

procedure TWatchDogTimerThread.InternalKillProcess(const AItem: TProcessRecord);
begin
  if AItem.Handle <> 0 then
    TerminateProcess(AItem.Handle, 0);
end;

function TWatchDogTimerThread.IsProcessRunning(const AItem: TProcessRecord): Boolean;
var
  LPID: DWORD;
begin
  LPID  := 0;
  if AItem.Handle <> 0 then
    GetWindowThreadProcessId(AItem.Handle, @LPID);
  Result := LPID <> 0;
end;

function TWatchDogTimerThread.IsProcessTimedOut(const AItem: TProcessRecord): Boolean;
begin
  Result := (AItem.DateTimeTerminate < Now);// and IsProcessRunning(AItem);
end;

end.

【讨论】：