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


How to implement a watchdog timer in Delphi?

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

？看门狗确保操作的执行时间不超过x秒。？监视程序确保当发生错误时，消息异常将存储在日志文件中。

你能给我建议什么解决办法吗？

相关讨论

这是我的解决方案。我不确定这是否合适，但它起作用了。我用板条箱装了一条新线：

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
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;

下面是一个实现部分：

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
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.