{

  Copyright (c) 1997-2003 by CoolDev.Com. Part of CoolControls package.

}

{$I versions.inc}
unit CoolAppLock;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, tlhelp32, ExtCtrls, CoolCtrls;

type
  // Event type for the application run process.
  TAppRunEvent = procedure (Sender: TObject; AppPath: string; var AllowRun: Boolean) of Object;

  // TCoolProgrLock is non visual component that will enable you to block
  // certain application and processes from being executed. Once enabled it
  // will terminate and prevent from running specified processes.
  TCoolProgrLock = class(TComponent)
  private
    FAboutBox: TCCAboutBox;
    FTimer: TTimer;
    FActive: Boolean;
    FInterval: Cardinal;
    StL: TStringList;  // store locked programs name
    FAppRunDetected: TAppRunEvent;

    procedure SetActive(Value: Boolean);
    procedure TimerAction(Sender: TObject);
    procedure SetList(St: TStringList);
  protected
    function  GetSystemProcess: TStringList; // get processes
    procedure Kill(ProgramPath: String); //kill process by pathname
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    // Displays information about the control and package version.
    property About: TCCAboutBox read FAboutBox write FAboutBox;
    // Determines if the component currently active (enabled).
    property Active: Boolean read FActive write SetActive default False;
    // Executables of the processes to be killed or prevented from the running.
    property Items: TStringList read Stl write SetList;
    // Event olccurs when the application run is detected.
    property OnAppRunDetected: TAppRunEvent read FAppRunDetected write FAppRunDetected;
  end;

implementation

constructor TCoolProgrLock.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  FTimer := TTimer.Create(Self);
  FTimer.Interval := 200;
  FTimer.Enabled := False;
  FTimer.OnTimer := TimerAction;

  FInterval := 200;
  FActive := False;
  Stl := TStringList.Create();
end;

destructor TCoolProgrLock.Destroy;
begin
  FTimer.Free;
  Stl.Free;
  inherited Destroy;
end;

function TCoolProgrLock.GetSystemProcess: TStringList;
var
  PHandle: THandle;
  ProcEntry: TProcessEntry32;
begin
  Result := TStringList.Create;
  try
    Result.Sorted := True;
    PHandle := CreateToolHelp32Snapshot(TH32CS_SNAPPROCESS, 0);
    ProcEntry.dwSize := SizeOf(TProcessEntry32);

    if Process32First(PHandle, ProcEntry) then
      Result.Add(ProcEntry.szExeFile);

    while Process32Next(PHandle,ProcEntry) do
      Result.Add(ProcEntry.szExeFile);

    CloseHandle(PHandle);
  except
    Result.Free;
  end;
end;

procedure TCoolProgrLock.Kill(ProgramPath: String);
var
{$IFDEF DELPHI4_OR_ABOVE}
  Handle: THandle;
  ex: Cardinal;
{$ELSE}
  Handle: Integer;
  ex: Integer;
{$ENDIF}
  ProcEntry: TProcessEntry32;
  processID: Cardinal;
begin
  processID := 0;

  Handle := CreateToolHelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  try
    ProcEntry.dwSize := SizeOf(TProcessEntry32);
    if Process32First(Handle, ProcEntry) then
     if UpperCase(ProcEntry.szExeFile) = upperCase(ProgramPath) then
       processID := ProcEntry.th32ProcessID;

    while Process32Next(Handle, ProcEntry) do
      if UpperCase(ProcEntry.szExeFile) = upperCase(ProgramPath) then
      begin
        processID := ProcEntry.th32ProcessID;
        break;
      end;
  finally
    CloseHandle(Handle);
  end;

  Handle := OpenProcess(PROCESS_TERMINATE, False, DWORD(processID));
  try
    GetExitCodeProcess(Handle, ex);
    TerminateProcess(Handle, ex);
  finally
    CloseHandle(Handle);
  end;
end;

procedure TCoolProgrLock.SetList(St: TStringList);
begin
  Stl.Assign(St);
end;

procedure TCoolProgrLock.SetActive(Value: Boolean);
begin
  if FActive <> Value then
  begin
    FActive := Value;
    FTimer.Enabled := FActive;
  end;
end;

procedure TCoolProgrLock.TimerAction(Sender: TObject);
var
  i, e: Integer;
  CStl: TStringList; // to get processes that are runing
  AllowRun: Boolean;
begin
  if not (csDesigning in ComponentState) then
  begin
    CStl := GetSystemProcess();
    try
      // comparing processes in lock list with already running
      for i := 0 to Pred(CStl.Count) do
      begin
        for e := 0 to Pred(Stl.Count) do
          if (upperCase(ExtractFileName(Stl.Strings[e])) = upperCase(CStl.Strings[i])) then
            // if find our process - kill it!
            if Assigned(FAppRunDetected) then
            begin
              AllowRun := False;
              FAppRunDetected(Self, upperCase(CStl.Strings[i]), AllowRun);
              if not AllowRun then
                Kill( CStl.Strings[i] );
            end else
              Kill( CStl.Strings[i] );
      end;
    finally
      CStl.Free;
    end;
  end;
end;

end.
