如何在Delphi中实现看门狗定时器

Question

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

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

中

你能给我建议一个解决方案吗?

Answer 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.