How to implement a watchdog timer in Delphi?

Question

I would like to implement a simple watchdog timer in Delphi XE 7 with two use cases:

• Watchdog ensures that a operation doesn't execute longer than x seconds
• Watchdog ensures that when errors occur then message exception will be stored in log file

Could you please suggest me any solution?

@DavidHeffernan Thanks. There can be case when I do some operation(e.g. start MSWord) then application hung. Should I create a multithreading for it? — Roman Marusyk
Wouldn't it be easier to avoid hanging by fixing the bugs in your program? — David Heffernan
Which part of the solution are you having trouble with? You've stated what you want your program to do, so what's preventing you from doing it? — Rob Kennedy

Roman Marusyk Roman Marusyk · Accepted Answer · 2015-11-04T21:06:16

Here is my solution. I'm not sure that is a proper, but its works. I crated a new thread:

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;

And here is an implementation part:

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.

How to implement a watchdog timer in Delphi?

1 Answers