uProcessMonitor

unit uProcessMonitor;

{$I ComplierDirectives.inc}

interface

uses Windows, Messages, SysUtils, Classes, Tlhelp32, ShellAPI, ExtCtrls;

type
  TProcessEvent = procedure (Sender: TObject;
    const ProcessEntry: TProcessEntry32) of Object;

  TProcessEntryObject = class (TObject)
  public
    ProcessEntry: TProcessEntry32;
  end;

  TProcessMonitor = class (TComponent)
  private
    FLastProcessEntryList,
    FNewProcessEntryList: TStringList;
    FRefreshTimer: TTimer;
    FOnProcessRun: TProcessEvent;
    FOnProcessTerminate: TProcessEvent;
    function GetEnabled: Boolean;
    procedure SetEnabled(const Value: Boolean);
    function GetInterval: Cardinal;
    procedure SetInterval(const Value: Cardinal);
    procedure ClearProcessEntryObjectList(AList: TStringList);
    procedure RefreshProcess(Sender: TObject);
    procedure CheckForEvents(OldList, NewList: TStringList);
    procedure CopyToStringList(Src, Des: TStringList);
  protected
    procedure DoProcessRun(ProcessEntry: TProcessEntry32); dynamic;
    procedure DoProcessTerminate(ProcessEntry: TProcessEntry32); dynamic;
    procedure Snapshot(AList: TStringList); virtual;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function GetProcessEntry(const ProcessID: Cardinal;
      var ProcessEntry: TProcessEntry32): Boolean; overload;
    function GetProcessEntry(const ExeFile: string;
      var ProcessEntry: TProcessEntry32): Boolean; overload;
  published
    property OnProcessRun: TProcessEvent read FOnProcessRun write FOnProcessRun;
    property OnProcessTerminate: TProcessEvent read FOnProcessTerminate
      write FOnProcessTerminate;
    property Enabled: Boolean read GetEnabled write SetEnabled;
    property Interval: Cardinal read GetInterval write SetInterval;
  end;

implementation

uses CommonProc;

{ TProcessMonitor }

constructor TProcessMonitor.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FLastProcessEntryList := TStringList.Create;
  FLastProcessEntryList.Sorted := True;
  FLastProcessEntryList.CaseSensitive := False;
  FNewProcessEntryList := TStringList.Create;
  FLastProcessEntryList.Sorted := True;
  FLastProcessEntryList.CaseSensitive := False;
  FRefreshTimer := TTimer.Create(Self);
  FRefreshTimer.Enabled := False;
  FRefreshTimer.Interval := 1000;
  FRefreshTimer.OnTimer := RefreshProcess;
end;

destructor TProcessMonitor.Destroy;
begin
  FRefreshTimer.Enabled := False;
  FRefreshTimer.OnTimer := nil;
  FRefreshTimer.Free;
  ClearProcessEntryObjectList(FNewProcessEntryList);
  FNewProcessEntryList.Free;
  FLastProcessEntryList.Free;
  inherited Destroy;
end;

function TProcessMonitor.GetProcessEntry(const ProcessID: Cardinal;
  var ProcessEntry: TProcessEntry32): Boolean;
var
  Index: Integer;
  AList: TStringList;
begin
  Result := False;
  AList := TStringList.Create;
  try
    Snapshot(AList);
    Index := AList.IndexOf(IntToStr(ProcessID));
    if Index = -1 then Exit;
    ProcessEntry := TProcessEntryObject(AList.Objects[Index]).ProcessEntry;
    Result := True;
  finally
    ClearProcessEntryObjectList(AList);
    AList.Free;
  end;
end;

function TProcessMonitor.GetProcessEntry(const ExeFile: string;
  var ProcessEntry: TProcessEntry32): Boolean;
var
  I: Integer;
  AList: TStringList;
  EStr: string;
begin
  Result := False;
  AList := TStringList.Create;
  try
    Snapshot(AList);
    for I := 0 to AList.Count - 1 do
    begin
      EStr := UpperCaseEx(StrPas(TProcessEntryObject(
        AList.Objects[I]).ProcessEntry.szExeFile));
      if EStr = UpperCaseEx(ExeFile) then
      begin
        ProcessEntry := TProcessEntryObject(AList.Objects[I]).ProcessEntry;
        Result := True;
        Break;
      end;
    end;
  finally
    ClearProcessEntryObjectList(AList);
    AList.Free;
  end;
end;

procedure TProcessMonitor.SetEnabled(const Value: Boolean);
begin
  FRefreshTimer.Enabled := Value;
  if Value then
     RefreshProcess(FRefreshTimer);
end;

function TProcessMonitor.GetEnabled: Boolean;
begin
  Result := FRefreshTimer.Enabled;
end;

procedure TProcessMonitor.SetInterval(const Value: Cardinal);
begin
  FRefreshTimer.Interval := Value;
end;

function TProcessMonitor.GetInterval: Cardinal;
begin
  Result := FRefreshTimer.Interval;
end;

procedure TProcessMonitor.Snapshot(AList: TStringList);
var
  ContinueLoop: LONGBOOL;
  SnapshotHandle: THandle;
  ProcessEntry32: TProcessEntry32;
  ProcessObject: TProcessEntryObject;
begin
  SnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  if SnapshotHandle = -1 then Exit;
  ClearProcessEntryObjectList(AList);
  ProcessEntry32.dwSize := Sizeof(ProcessEntry32);
  ContinueLoop := Process32First(SnapshotHandle, ProcessEntry32);
  while Integer(ContinueLoop) <> 0 do
  begin
    ProcessObject := TProcessEntryObject.Create;
    ProcessObject.ProcessEntry := ProcessEntry32;
    AList.AddObject(IntToStr(ProcessEntry32.th32ProcessID),
      ProcessObject);
    ContinueLoop := Process32Next(SnapshotHandle,ProcessEntry32);
  end;
end;

procedure TProcessMonitor.RefreshProcess(Sender: TObject);
begin
  FRefreshTimer.Enabled := False;
  try
    Snapshot(FNewProcessEntryList);
    CheckForEvents(FLastProcessEntryList, FNewProcessEntryList);
  finally
    FRefreshTimer.Enabled := True;
  end;
end;

procedure TProcessMonitor.ClearProcessEntryObjectList(AList: TStringList);
var
  I: Integer;
  ProcessObject: TProcessEntryObject;
begin
  for I := 0 to AList.Count - 1 do
  begin
    ProcessObject := TProcessEntryObject(AList.Objects[I]);
    try
      if ProcessObject <> nil then ProcessObject.Free;
    except
      // do nothing
    end;
  end;
  AList.Clear;
end;

procedure TProcessMonitor.CheckForEvents(OldList, NewList: TStringList);
var
  I: Integer;
begin
  try
  // for Added
    for I := 0 to NewList.Count - 1 do
      if (OldList.Count <> 0) and (OldList.IndexOf(NewList[I]) = -1) then
        DoProcessRun(TProcessEntryObject(NewList.Objects[I]).ProcessEntry);
    // for Deleted
    for I := 0 to OldList.Count - 1 do
      if (NewList.Count <> 0) and (NewList.IndexOf(OldList[I]) = -1) then
        DoProcessTerminate(TProcessEntryObject(OldList.Objects[I]).ProcessEntry);
    CopyToStringList(NewList, OldList);
  except
    // do nothing
  end;
end;

procedure TProcessMonitor.CopyToStringList(Src, Des: TStringList);
var
  I: Integer;
  ProcessObject: TProcessEntryObject;
begin
  ClearProcessEntryObjectList(Des);
  for I := 0 to Src.Count - 1 do
  begin
    ProcessObject := TProcessEntryObject.Create;
    ProcessObject.ProcessEntry := TProcessEntryObject(Src.Objects[I]).ProcessEntry;
    Des.AddObject(Src[I], ProcessObject);
  end;
end;

procedure TProcessMonitor.DoProcessRun(ProcessEntry: TProcessEntry32);
begin
  if Assigned(FOnProcessRun) then
    FOnProcessRun(Self, ProcessEntry);
end;

procedure TProcessMonitor.DoProcessTerminate(ProcessEntry: TProcessEntry32);
begin
  if Assigned(FOnProcessTerminate) then
    FOnProcessTerminate(Self, ProcessEntry);
end;

end.