PC Pro 2005 June (DVD)/DPPRO0605DVD.iso/Install/program files/Borland/BDS/3.0/Demos/Delphi.Net/CLR/ProcessViewer/ProcessCheckerClass.pas

Pascal/Delphi Source File | 2004-10-22 | 8.3 KB | 269 lines

unit ProcessCheckerClass;
{*******************************************************************************
  ProcessChecker Demo
  Written by David Clegg, [e-mail].

  This unit contains the TProcessChecker class, which is responsible for
  monitoring, stopping and restarting processes.
*******************************************************************************}
interface

uses
  ProcessCheckerSettings, System.Windows.Forms, System.Diagnostics,
  ProcessClasses;

type
  TProcessCheckerEvent = procedure (Sender: TObject; const EventMessage: string) of object;
  TProcessArray = Array of Process;

    /// <summary>
    /// Class to handle the Process monitoring.
    /// </summary>
  TProcessChecker = class
  strict private
    FOnEvent: TProcessCheckerEvent;
    FSettings: TProcessCheckerSettings;
    FSuspended: boolean;
    FTimer: Timer;
    procedure InitTimer;
    procedure InitSettings;
    procedure SetTimerInterval;
    procedure CheckProcesses;
    procedure TimerTick(Sender: TObject; Args: EventArgs);
    procedure SettingsUpdated(Sender: TObject; Args: EventArgs);
    function CheckProcess(pProcessPath: string): TProcessArray;
    procedure RestartProcess(pProcess: TWatchedProcess);
    procedure NotifyEvent(const pEventDetails: string);
    procedure StopProcess(pProcess: Process);
    procedure StopDependantProcesses(pProcess: TWatchedProcess);
  public
    property OnEvent: TProcessCheckerEvent read FOnEvent write FOnEvent;
    property Settings: TProcessCheckerSettings read FSettings write FSettings;
    property Suspended: boolean read FSuspended write FSuspended;
    constructor Create(const pSettings: TProcessCheckerSettings);
  end;

implementation

uses
  System.IO, System.Threading, SysUtils;

constructor TProcessChecker.Create(const pSettings: TProcessCheckerSettings);
begin
  inherited Create;
  FSettings := pSettings;
  InitTimer;
  InitSettings;
end;

/// <summary>
/// Create the timer, and attach the Tick event.
/// </summary>
procedure TProcessChecker.InitTimer;
begin
  FTimer := System.Windows.Forms.Timer.Create;
  Include(FTimer.Tick, TimerTick);
  SetTimerInterval;
end;

/// <summary>
/// Sets the interval for the timer used to trigger the process checking
/// </summary>
procedure TProcessChecker.SetTimerInterval;
var
  lInterval: integer;
begin
  //CheckFrequency is stored in seconds, but we need to convert it
  //to milliseconds for the timer.
  lInterval := FSettings.CheckFrequency * 1000;

  //The Timer class will throw an exception if we attempt to assign an
  //interval with a zero value
  if (lInterval > 0) then
  begin
    FTimer.Interval := lInterval;
    FTimer.Enabled := FSettings.Enabled;
  end
  else
  begin
    //Ensure timer is disabled
    FTimer.Enabled := false;
    if FSettings.Enabled then
    begin
      FSettings.Enabled := false;
      FSettings.Save;
    end;
  end;
end;

procedure TProcessChecker.TimerTick(Sender: TObject; Args: EventArgs);
begin
  CheckProcesses;
end;

/// <summary>
/// Create the ProcessCheckerSettings instance, and attach the event
/// handlers to notify when the instance is loaded or saved.
/// </summary>
procedure TProcessChecker.InitSettings;
begin
  Include(FSettings.SettingsLoaded, SettingsUpdated);
  Include(FSettings.SettingsSaved, SettingsUpdated);

  //As the event handlers are attached after the settings are
  //initially loaded from disk, we need to fire the event manually.
  SettingsUpdated(Self, nil);
end;

/// <summary>
/// Event handler called if the ProcessCheckerSettings instance is loaded
/// or saved. As we are only interested in determining that the settings
/// may have changed (and not what caused the change), we can share the
/// event handler.
/// </summary)
procedure TProcessChecker.SettingsUpdated(Sender: TObject; Args: EventArgs);
begin
  SetTimerInterval;
end;

/// <summary>
/// Iterate through all monitored processes to check whether they are
/// still running.
/// </summary>
procedure TProcessChecker.CheckProcesses;
var
  lProcesses: TProcessArray;
  i: integer;
  j: integer;
  lWatchedProcess: TWatchedProcess;
  lRunningProcess: Process;
begin
  if not FSuspended then
    for i := 0 to FSettings.WatchedProcesses.Count -1 do
    begin
      lWatchedProcess := FSettings.WatchedProcesses[i] as TWatchedProcess;
      lProcesses := CheckProcess(lWatchedProcess.Path);
      if (Length(lProcesses) = 0) then
      begin
        //No instances of lWatchedProcess running, so re-start it
        RestartProcess(lWatchedProcess);
        if (FSettings.RestartOneProcess) then
          //We only restart one process each time we check
          //running processes. Any subsequent processes that have
          //unexpectedly terminated will be caught next time.
          break;
      end
      else
        for j := 0 to Length(lProcesses) -1 do
        begin
          //At least one instance of lWatchedProcess running,
          //so check that the instance(s) are still responding.
          lRunningProcess := lProcesses[j];
          if lWatchedProcess.CheckResponding then
            if not (lRunningProcess.Responding) then
            begin
              //Process not responding, so re-start it.
              NotifyEvent(Format('%s - not responding',
                [lRunningProcess.ProcessName]));
              StopProcess(lRunningProcess);
              RestartProcess(lWatchedProcess);
              if (FSettings.RestartOneProcess) then
                //Only restarting one process per check.
                break;
            end;
        end;
  end;
end;

/// <summary>
/// Check to see whether the specified process is still running.
/// Returns an array of Process instances if the process has at least one
/// running instance.
/// </summary>
function TProcessChecker.CheckProcess(pProcessPath: string): TProcessArray;
var
  lProcessName: string;
begin
  lProcessName := System.IO.Path.GetFileNameWithoutExtension(pProcessPath);
  Result := Process.GetProcessesByName(lProcessName);
end;

/// <summary>
/// Restart a process.
/// </summary>
procedure TProcessChecker.RestartProcess(pProcess: TWatchedProcess);
var
  lStartProcess: Process;
begin
  StopDependantProcesses(pProcess);
  lStartProcess := Process.Create;
  lStartProcess.StartInfo.FileName := pProcess.Path;
  lStartProcess.StartInfo.WorkingDirectory := Path.GetDirectoryName(pProcess.Path);
  try
    lStartProcess.Start();
    NotifyEvent(Format('%s - Process restarted', [pProcess.Name]));
  except on E: Exception do
    NotifyEvent(Format('Error starting %s - %s',
      [pProcess.Name, E.Message]));
  end;
end;

/// <summary>
/// Iterate through, and terminate, all dependant processes.
/// </summary>
procedure TProcessChecker.StopDependantProcesses(pProcess: TWatchedProcess);
var
  lDependantProcesses: TProcessArray;
  i: integer;
  j: integer;
begin
  for i := 0 to pProcess.DependantProcesses.Count -1 do
  begin
    lDependantProcesses := CheckProcess(pProcess.DependantProcesses[i].Path);
    for j := 0 to Length(lDependantProcesses) -1 do
      StopProcess(lDependantProcesses[j]);
  end;
end;

/// <summary>
/// Stop a process.
/// </summary>
procedure TProcessChecker.StopProcess(pProcess: Process);
begin
  //Attempt to stop the process 'nicely' by sending a Close message
  //to the processes main window
  pProcess.CloseMainWindow();
  //Give the message a chance to be processed
  Thread.Sleep(100);
  if not pProcess.HasExited then
  begin
    //CloseMainWindow didn't work so attempt a more forceful
    //shutdown. Process.Kill forces an immediate termination of the
    //process.
    pProcess.Kill;
    Thread.Sleep(100);
    if not pProcess.HasExited then
      //Still running, but its time to admit defeat :-(
      NotifyEvent(Format('%s - Process termination failed',
        [pProcess.ProcessName]))
    else
      NotifyEvent(Format('%s - Process killed', [pProcess.ProcessName]));
  end
  else
    NotifyEvent(Format('%s - Process stopped' , [pProcess.ProcessName]));
end;

/// <summary>
/// Send a Process Checker Event notification.
/// </summary>
procedure TProcessChecker.NotifyEvent(const pEventDetails: string);
begin
  if Assigned(FOnEvent) then
    FOnEvent(Self, pEventDetails);
end;

end.