Class for listing and killing processes - نسخة قابلة للطباعة

كود :
unit ProcListCls;

interface

uses
  Windows,
  SysUtils,
  Dialogs,
  TlHelp32;

type
  TProcess = packed record
    Filename: string;
    ProcID: DWORD;
    ParentID: DWORD;
    Priority: DWORD;
    Threads: DWORD;
  end;

  TOnProcListStart = procedure(Sender: TObject) of object;
  TOnProcListFinished = procedure(Sender: TObject; CountProcs: Integer) of object;
  TOnProcRetrieve = procedure(Sender: TObject; Process: TProcess) of object;
  TOnListFailure = procedure(Sender: TObject; ErrorCode: Integer; const ErrorString: string) of object;
  TOnKillFailure = procedure(Sender: TObject; ErrorCode: Integer; const ErrorString: string) of object;

  TProcList = class(TObject)
  private
    FProcess: TProcess;
    FCountProcs: Integer;
    FOnProcListStart: TOnProcListStart;
    FOnProcListFinished: TOnProcListFinished;
    FOnProcRetrieve: TOnProcRetrieve;
    FOnListFailure: TOnListFailure;
    FOnKillFailure: TOnKillFailure;
  protected
    function GetProcPath(ProcID: DWORD): string;
    function GetProcID(const Filename: String): DWORD;
  public
    constructor Create;
    procedure Execute;
    procedure KillProc(const Filename: string; TimeOut: DWORD); overload;
    procedure KillProc(ID: Integer; TimeOut: DWORD); overload;
    property OnProcListStart: TOnProcListStart read FOnProcListStart write FOnProcListStart;
    property OnProcListFinished: TOnProcListFinished read FOnProcListFinished write FOnProcListFinished;
    property OnProcRetrieve: TOnProcRetrieve read FOnProcRetrieve write FOnProcRetrieve;
    property OnListFailure: TOnListFailure read FOnListFailure write FOnListFailure;
    property OnKillFailure: TOnKillFailure read FOnKillFailure write FOnKillFailure;
  end;

implementation

{ TProcList }

constructor TProcList.Create;
begin
  inherited;
  FCountProcs := 0;
end;

procedure TProcList.Execute;
var
  hProcSnapShot : THandle;
  pe32 : TProcessEntry32;
  ModuleEntry : TModuleEntry32;
  FileName : string;
begin
  // make the snapshot
  if Assigned(OnProcListStart) then
    FOnProcListStart(self);
  hProcSnapShot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS or TH32CS_SNAPMODULE, 0);
  if hProcSnapShot <> INVALID_HANDLE_VALUE then
  begin
    pe32.dwSize := sizeof(TProcessEntry32);
    ModuleEntry.dwSize := SizeOf(TModuleEntry32);
    if Process32First(hProcSnapShot, pe32) then
    begin
      // first process (System Process)
      Inc(FCountProcs);
      FProcess.ProcID := pe32.th32ProcessID;
      FProcess.Filename := pe32.szExeFile;
      FProcess.Priority := pe32.pcPriClassBase;
      FProcess.Threads := pe32.cntThreads;
      if Assigned(OnProcRetrieve) then
        FOnProcRetrieve(self, FProcess);
      // walk the processes
      while Process32Next(hProcSnapShot, pe32) do
      begin
        FProcess.ProcID := pe32.th32ProcessID;
        FileName := GetProcPath(pe32.th32ProcessID);
        if FileName <> '' then
          FProcess.Filename := FileName
        else
          FProcess.Filename := pe32.szExeFile;
        FProcess.Priority := pe32.pcPriClassBase;
        FProcess.Threads := pe32.cntThreads;
        Inc(FCountProcs);
        if Assigned(OnProcRetrieve) then
          FOnProcRetrieve(self, FProcess);
      end;
    end
    else // Process32First = False
    begin
      if Assigned(OnListFailure) then
        FOnListFailure(self, GetLastError, SysErrorMessage(GetLastError));
      CloseHandle(hProcSnapShot);
    end;
  end
  else // hSnapShot = INVALID_HANDLE_VALUE
  begin
    if Assigned(OnListFailure) then
      FOnListFailure(self, GetLastError, SysErrorMessage(GetLastError));
  end;

  if Assigned(OnProcListFinished) then
    FOnProcListFinished(self, FCountProcs);
end;

function TProcList.GetProcPath(ProcID: DWORD): string;
var
  me32 : TModuleEntry32;
  h : THandle;
  s : string;
begin
  s := '';
  h := CreateToolhelp32Snapshot(TH32CS_SNAPMODULE, ProcID);
  if h <> INVALID_HANDLE_VALUE then
  begin
    me32.dwSize := sizeof(TModuleEntry32);
    Module32First(h, me32);
    s := me32.szExePath;
    CloseHandle(h);
  end;
  result := s;
end;

function TProcList.GetProcID(const Filename: String): DWORD;
var
  hProcSnap: THandle;
  pe32: TProcessEntry32;
begin
  result := 0;
  hProcSnap := CreateToolHelp32SnapShot(TH32CS_SNAPPROCESS, 0);
  if hProcSnap <> INVALID_HANDLE_VALUE then
  begin
    pe32.dwSize := SizeOf(ProcessEntry32);
    if Process32First(hProcSnap, pe32) then
    begin
      while Process32Next(hProcSnap, pe32) do
      begin
        if pos(AnsiLowerCase(pe32.szExeFile), AnsiLowerCase(ExtractFilename(Filename))) > 0 then
        begin
          result := pe32.th32ProcessID;
          break;
        end;
      end;
    end;
    CloseHandle(hProcSnap);
  end;
end;

procedure TProcList.KillProc(ID: Integer; TimeOut: DWORD);
var
  hProcess : Cardinal;
  err : DWORD;
begin
  // open the process and store the process-handle
  hProcess := OpenProcess(SYNCHRONIZE or PROCESS_TERMINATE, False, ID);
  // kill it
  if hProcess <> 0 then
  begin
    err := Integer(TerminateProcess(hProcess, 1));
    if err <> 0 then
    begin
      // TerminateProcess returns immediately, so wie have to verify the result via
      // WaitForSingleObject
      err := WaitForSingleObject(hProcess, TimeOut);
      if err = WAIT_FAILED then
      begin
        if Assigned(OnKillFailure) then
          FOnKillFailure(self, GetLastError, SysErrorMessage(GetLastError));
      end;
    end
    else
    begin
      if Assigned(OnKillFailure) then
        FOnKillFailure(self, GetLastError, SysErrorMessage(GetLastError));
    end;
    CloseHandle(hProcess);
  end
  else // hProcess = INVALID_HANDLE_VALUE
  begin
    if Assigned(OnKillFailure) then
      FOnKillFailure(self, GetLastError, SysErrorMessage(GetLastError));
  end;
end;

procedure TProcList.KillProc(const Filename: string; TimeOut: DWORD);
begin
  KillProc(GetProcID(Filename), TimeOut);
end;