Question

我想在Delphi XE 7中实现一个带有两个用例的简单监视程序计时器：

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

中

你能告诉我任何解决方案吗？

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.

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

1 个答案: