Klasse zum Beenden eines Prozesses

[Luckie]

Anbei die überarbeitet Version mit euren Vorschlägen:

Delphi-Quellcode:

// Klasse zum Benden eines Processes mittels TerminateProcess
// Class for terminating a process via TerminateProcess
// Michael Puff [http://www.michael-puff.de]
// 2010-11-21

unit MpuKillProcessCls;

interface

uses
  Windows, SysUtils, TlHelp32;

type
  TOnTerminated = procedure(Sender: TObject) of Object;
  TKillProcess = class(TObject)
  private
    FFilename: string;
    FProcessID: Cardinal;
    FTimeOut: Cardinal;
    FOnTerminated: TOnTerminated;
    procedure GetProcessID;
    procedure SetFilename(const Value: string);
    procedure SetPID(Value: Cardinal);
  public
    property Filename: string read FFilename write SetFilename;
    property PID: Cardinal read FProcessID write SetPID;
    property TimeOutMSecs: Cardinal read FTimeOut write FTimeOut;
    property OnTerminated: TOnTerminated read FOnTerminated write FOnTerminated;
    constructor Create;
    procedure Kill;
  end;

implementation

constructor TKillProcess.Create;
begin
  FTimeOut := 0;
end;

procedure TKillProcess.GetProcessID;
var
  ProcessSnapShot: THandle;
  pe32: TProcessEntry32;
begin
  ProcessSnapShot := CreateToolHelp32SnapShot(TH32CS_SNAPPROCESS, 0);
  if ProcessSnapShot <> INVALID_HANDLE_VALUE then
  begin
    pe32.dwSize := SizeOf(ProcessEntry32);
    if Process32First(ProcessSnapShot, pe32) then
    begin
      while Process32Next(ProcessSnapShot, pe32) do
      begin
        if AnsiSameText(FFilename, pe32.szExeFile) then
          FProcessID := pe32.th32ProcessID;
      end;
    end
    else
    begin
      RaiseLastOSError;
    end;
  end
  else
  begin
    RaiseLastOSError;
  end;
  CloseHandle(ProcessSnapShot);
  if FProcessID = 0 then
    raise Exception.Create('Process not found');
end;

procedure TKillProcess.Kill;
var
  ProcessHandle: Cardinal;
  WFSOReturnCode: DWORD;
begin
  ProcessHandle := OpenProcess(SYNCHRONIZE or PROCESS_TERMINATE, False, FProcessID);
  if ProcessHandle <> 0 then
  begin
    if TerminateProcess(ProcessHandle, 0) then
    begin
      WFSOReturnCode := WaitForSingleObject(ProcessHandle, FTimeOut);
      case WFSOReturnCode of
        WAIT_TIMEOUT:
          begin
            if FTimeOut > 0 then
              raise Exception.Create('Timeout');
          end;
        WAIT_FAILED:
          begin
            RaiseLastOSError;
          end;
        WAIT_OBJECT_0:
        begin
          if Assigned(OnTerminated) then
            OnTerminated(self);
        end;
      end;
    end
    else
    begin
      RaiseLastOSError;
    end;
  end
  else
  begin
    RaiseLastOSError;
  end;
end;

procedure TKillProcess.SetFilename(const Value: string);
begin
  FFilename := Value;
  GetProcessID;
end;

procedure TKillProcess.SetPID(Value: Cardinal);
begin
  FProcessID := Value;
end;

end.

Demo:

Delphi-Quellcode:

program Project2;

{$APPTYPE CONSOLE}

uses
  SysUtils,
  MpuKillProcessCls in 'MpuKillProcessCls.pas';

type
  TMain = class(TObject)
  public
    procedure OnTerminated(Sender: TObject);
  end;

procedure TMain.OnTerminated(Sender: TObject);
begin
  Writeln('Prozess beendet');
end;

var
  Main: TMain;
  KillProcess: TKillProcess;
begin
  Main := TMain.Create;
  try
    KillProcess := TKillProcess.Create;
    try
      try
        KillProcess.OnTerminated := Main.OnTerminated;
        KillProcess.TimeOutMSecs := 5000;
        KillProcess.Filename := 'notePad++.exe';
        //KillProcess.PID := 2696;
        KillProcess.Kill;
      except
        on E: Exception do
          Writeln(E.Message);
      end;
    finally
      KillProcess.Free;
    end;
  finally
    Main.Free;
  end;
  Readln;
end.

Bestehendes Problem ist noch die Benachrichtigung beim erfolgreichen Beenden. Da habe ich noch keine Idee, die mir gefällt. Problem ist der TimeOut von 0. Da geht er auch in den WAIT_TIMEOUT Zweig rein und der Prozess könnte trotzdem erfolgreich beendet worden sein - oder auch nicht. Das ist das Problem. Und bis das Problem nicht gelöst ist, kann und will ich den Code nicht offiziell veröffentlichen. Zur Zeit habe ich nur ein Ereignis, wenn das Objekt signalisiert wird.