Klasse zum Beenden eines Prozesses

[Luckie]

OK, überredet.

[stOrM]

Zitat:

Ähem, das ist Mumpitz, oder? Denn erstens braucht man mindestens die gleichen Rechte wie für TerminateProcess und zweitens wird diese Methode hier nicht zwischen Sitzungen funktionieren (Vista aufwärts). Sagen wir mal so, mit einem Datum von 1999 ist der Code mehr oder weniger "abgelaufen".

Naja als ich damals den Artikel über Winlogon Notification Packages geschrieben hatte stolperte ich immer wieder bei der Recherche über das besagte SafeTerminateProcess, was dann irgendwann meinen Jagdinstinkt geweckt hat Als ich dann die Erklärung dazu endlich gefunden hatte dachte ich mir gut, jetzt wo ich es weiss setzt ich es nach Delphi um. Mehr oder weniger hat die Umsetzung auf meinen Blog auch nicht zu sagen...

[Dezipaitor]

Madshi hatte glaube ich eine CreateRemoteThread, die auch über Sitzungen funkz. Naja, ich sehe schon wieder ne Menge Virenscanner, die da anschlagen würde.
Und dann einfach PostQuitMessage aufrufen muss auch nicht funkzen. Irgendein Verrückter könnte ein Fenster pro Thread gebaut haben, um Einfrieren zu verhindern.

[Assarbad]

Zitat von Dezipaitor:

Madshi hatte glaube ich eine CreateRemoteThread, die auch über Sitzungen funkz.

Den Code rückt er aber nicht so freizügig raus, soweit ich weiß. Damit eher ungeeignet als Basis für Michael's Klasse

[Luckie]

Aktuelle Version:

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-22

unit MpuKillProcessCls;

interface

uses
  Windows,
  Messages,
  SysUtils,
  TlHelp32;

type
  TOnTerminated = procedure(HasTerminated: Boolean; ProcessExefile: string) of object;
  TOnProcessNotFound = procedure(ProcessExefile: string) of object;
  TKillProcess = class(TObject)
  private
    FProcessExefile: string;
    FProcessID: Cardinal;
    FTimeOut: Cardinal;
    FOnTerminated: TOnTerminated;
    FOnProcessNotFound: TOnProcessNotFound;
    function GetProcessID: Cardinal;
    procedure SetProcessExefile(const Value: string);
    procedure SetPID(Value: Cardinal);
    function EnablePrivilege(const Privilege: string; fEnable: Boolean; out
      PreviousState: Boolean): DWORD;
  public
    property ProcessExefile: string read FProcessExefile write SetProcessExefile;
    property PID: Cardinal read FProcessID write SetPID;
    property TimeOutMSecs: Cardinal read FTimeOut write FTimeOut;
    property OnTerminated: TOnTerminated read FOnTerminated write FOnTerminated;
    property OnProcessNotFound: TOnProcessNotFound read FOnProcessNotFound write FOnProcessNotFound;
    constructor Create;
    procedure Kill;
  end;

implementation

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

function TKillProcess.EnablePrivilege(const Privilege: string;
  fEnable: Boolean; out PreviousState: Boolean): DWORD;
var
  Token: THandle;
  NewState: TTokenPrivileges;
  Luid: TLargeInteger;
  PrevState: TTokenPrivileges;
  Return: DWORD;
begin
  PreviousState := True;
  if (GetVersion() > $80000000) then
    // Win9x
    Result := ERROR_SUCCESS
  else
  begin
    // WinNT
    if not OpenProcessToken(GetCurrentProcess(), MAXIMUM_ALLOWED, Token) then
      Result := GetLastError()
    else
    try
      if not LookupPrivilegeValue(nil, PChar(Privilege), Luid) then
        Result := GetLastError()
      else
      begin
        NewState.PrivilegeCount := 1;
        NewState.Privileges[0].Luid := Luid;
        if fEnable then
          NewState.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED
        else
          NewState.Privileges[0].Attributes := 0;
        if not AdjustTokenPrivileges(Token, False, NewState,
          SizeOf(TTokenPrivileges), PrevState, Return) then
          Result := GetLastError()
        else
        begin
          Result := ERROR_SUCCESS;
          PreviousState :=
            (PrevState.Privileges[0].Attributes and SE_PRIVILEGE_ENABLED <> 0);
        end;
      end;
    finally
      CloseHandle(Token);
    end;
  end;
end;

function TKillProcess.GetProcessID: Cardinal;
var
  ProcessSnapShot: THandle;
  pe32: TProcessEntry32;
  ProcessID: Cardinal;
begin
  ProcessID := 0;
  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(FProcessExefile, pe32.szExeFile) then
        begin
          ProcessID := pe32.th32ProcessID;
          Break;
        end;
      end;
    end
    else
    begin
      RaiseLastOSError;
    end;
  end
  else
  begin
    RaiseLastOSError;
  end;
  CloseHandle(ProcessSnapShot);
  if ProcessID = 0 then
  begin
    if Assigned(OnProcessNotFound) then
      OnProcessNotFound(FProcessExefile);
  end;
  Result := ProcessID;
end;

procedure TKillProcess.Kill;
var
  EnablePrivelege: DWORD;
  PreviousPriviliegeState: Boolean;
  ProcessHandle: Cardinal;
  WFSOReturnCode: DWORD;
begin
  FProcessID := GetProcessID;
  if FProcessID <> 0 then
  begin
    repeat
      EnablePrivelege := EnablePrivilege('SE_DEBUG_NAME', true, PreviousPriviliegeState);
      if EnablePrivelege <> 0 then
      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 GetProcessID = 0 then
                  begin
                    if Assigned(OnTerminated) then
                      OnTerminated(True, FProcessExefile);
                  end
                  else
                  begin
                    if Assigned(OnTerminated) then
                      OnTerminated(False, FProcessExefile);
                    Exit;
                  end;
                  if FTimeOut > 0 then
                  begin
                    raise Exception.Create('Timeout');
                  end;
                end;
              WAIT_FAILED:
                begin
                  RaiseLastOSError;
                end;
              WAIT_OBJECT_0:
                begin
                  if Assigned(OnTerminated) then
                    OnTerminated(True, FProcessExefile);
                end;
            end;
          end
          else
          begin
            RaiseLastOSError;
          end;
          CloseHandle(ProcessHandle);
        end
        else
        begin
          RaiseLastOSError;
        end;
      end
      else
      begin
        raise Exception.Create(SysErrorMessage(GetLastError));
      end;
      FProcessID := GetProcessID;
    until FProcessID = 0;
  end;
end;

procedure TKillProcess.SetProcessExefile(const Value: string);
begin
  FProcessExefile := Value;
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(HasTerminated: Boolean; ProcessExefile: string);
    procedure OnProcessNotFound(ProcessExefile: string);
  end;

procedure TMain.OnProcessNotFound(ProcessExefile: string);
begin
  Writeln('Fehler. Process ' + ProcessExeFile + ' nicht gefunden.');
end;

procedure TMain.OnTerminated(HasTerminated: Boolean; ProcessExefile: string);
begin
  if HasTerminated then
    Writeln('Prozess ' + ProcessExefile + ' beendet')
  else
    Writeln('Fehler beim Beenden des Prozesses ' + ProcessExefile);
end;

var
  Main: TMain;
  KillProcess: TKillProcess;
begin
  Main := TMain.Create;
  try
    KillProcess := TKillProcess.Create;
    try
      try
        KillProcess.OnTerminated := Main.OnTerminated;
        KillProcess.OnProcessNotFound := Main.OnProcessNotFound;
        KillProcess.TimeOutMSecs := 5000;
        KillProcess.ProcessExefile := 'photofiltre.exe';
        //KillProcess.ProcessExefile := 'svchost.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.

[HeikoAdams]

Ich habe den kompletten Thread jetzt nicht durchgelesen, aber was mir noch fehlen würde, wäre die Möglichkeit, Prozesse anhand des Fenstertitels zu beenden.

[Luckie]

Immer langsam mit den jungen Pferden. Man muss sich ja noch für Version 2 was aufheben.

[Delphi-Laie]

Zitat von Luckie:

Zitat von himitsu:

Zitat:

if ... = true then

Das hätt ich jetzt nicht von dir erwartet.

Autsch, das passiert, wenn man alten Code per Copy and paste übernimmt.

Luckie, das wäre nicht nötig gewesen. Darob unterhielten wir uns schon wiederholt, erst vor Jahren (als ich zum ersten Mal darüber stolperte und sogar eine Diskussion dazu eröffnete, die recht lebhaft wurde), und dann vor einigen Monaten noch einmal im (gleichnamigen) Delphiforum.

Auch Dein

Zitat von Luckie:

Delphi-Quellcode:

if Process32First(ProcessSnapShot, pe32) = true then
begin
  while Process32Next(ProcessSnapShot, pe32) = true do
  begin
    if pos(LowerCase(FProcessFile), LowerCase(pe32.szExeFile)) <> 0 then
      FProcessID := pe32.th32ProcessID;
   end;
end

ist ein Quentchen eleganter möglich (auch das schrieb ich Dir schon):

Delphi-Quellcode:

if Process32First(ProcessSnapShot, pe32) then
  repeat
  if pos(LowerCase(FProcessFile), LowerCase(pe32.szExeFile)) <> 0 then
      FProcessID := pe32.th32ProcessID
  until not Process32Next(ProcessSnapShot, pe32)

Das nur so als Ergänzung zu dem ansonsten guten und bewährten (und deshalb auch von mir ursprünglich so übernommenen Code).

Gruß Delph-Laie

[Delphi-Laie]

Zitat von Luckie:

@himitsu: Wenn ich mich recht erinnere steht pe32.szExeFile nur der Prozessname, also kein Pfad.

Unter Win9x der gesamte Pfad, unter NTx nur der Dateiname des Prozesse.

Für den Pfad benötigt man deshalb unter NTx beim ersten Eintrag des Modulschnappschusses den Eintrag "szExePath".

[Luckie]

@Delphi-Laie: Du beziehst dich da gerade auf veralteten Code.