Delphi-PRAXiS
Seite 2 von 5     12 34     Letzte »    

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Win32/Win64 API (native code) (https://www.delphipraxis.net/17-win32-win64-api-native-code/)
-   -   Klasse zum Beenden eines Prozesses (https://www.delphipraxis.net/156073-klasse-zum-beenden-eines-prozesses.html)

s.h.a.r.k 19. Nov 2010 07:08

AW: Klasse zum Beenden eines Prozesses
 
Zitat:

Zitat von alzaimar (Beitrag 1062478)
Funktioniert immer! Natürlich werden auch diverse andere Programme beendet, auch Dienste. Das ist also die letzte aller Möglichkeiten.

Aber wie macht Windows das?

Ich weiß dies bzgl, dass Windows ein Patent auf das Herunterfahren des Rechners angemeldet hat. Ich suche gerade den Eintrag, den ich gelesen habe. Da stand nämlich etwas mehr drin, vielleicht auch genau das.

--EDIT
Nein, war nur eine darstellende Grafik...

mleyen 19. Nov 2010 07:17

AW: Klasse zum Beenden eines Prozesses
 
Zitat:

Zitat von Luckie (Beitrag 1062483)
Da muss ich um eine nähere Erklärung bitten.

Nunja, also das write in:
Delphi-Quellcode:
public
  property ProcessFile: string read FProcessFile write FProcessFile;
bringt momentan nichts, außer evtl ungewollte Verhaltensweisen.

Luckie 19. Nov 2010 07:21

AW: Klasse zum Beenden eines Prozesses
 
Oh. Danke für den Hinweis.

himitsu 19. Nov 2010 09:12

AW: Klasse zum Beenden eines Prozesses
 
Zitat:

Zitat von Luckie (Beitrag 1062473)
Eine Datei oder Verzeichnis ist kein Prozess und taucht nict in der Prozessliste auf. Was soll da passieren, außer, dass der Prozess nicht gefunden wird?

Hab ich das behauptet?

Delphi-Quellcode:
C:\Programme\Example.exetus\Demo.exe
und jetzt lass mal dein
Delphi-Quellcode:
POS('ample.exe'
darauf los. :stupid:

Zitat:

Zitat von Luckie (Beitrag 1062473)
Warum so umständlich?
Delphi-Quellcode:
if LowerCase(FProcessFile) = LowerCase(pe32.szExeFile)...

Könnt ich dich auch fragen :roll:
Delphi-Quellcode:
if AnsiSameText(FProcessFile, pe32.szExeFile) then...
.
PS: LowerCase = nur A bis Z wird übersetzt
AnsiLowerCase = alle Zeichen (ab D2009 ist AnsiLowerCase standardmäßig Unicode)

Und warum so lang ... so könnte man auch nach
Delphi-Quellcode:
Demo.exe
,
Delphi-Quellcode:
Example.exetus\Demo.exe
oder
Delphi-Quellcode:
C:\Programme\Example.exetus\Demo.exe
suchen. :angel2:

(und wehe einer sagt was über meine exetus-Wortschöpfung :warn: )

mirage228 19. Nov 2010 10:13

AW: Klasse zum Beenden eines Prozesses
 
Zwei Vorschläge auch von mir:
1. Der Parameter im Konstruktor sollte const sein, da er nicht verändert wird.
2. Ich würde eine statische Klassenfunktion mit Dateiname und Timeout vorschlagen, die ohne Umwege über eine Instanziierung einen Prozess killen kann. Für einfach gelagerte Fälle oder falls man keine Wiederverwendung anstrebt, fände ich das ganz praktisch.

Viele Grüße

Luckie 19. Nov 2010 10:54

AW: Klasse zum Beenden eines Prozesses
 
@himitsu: Wenn ich mich recht erinnere steht pe32.szExeFile nur der Prozessname, also kein Pfad.

@Mirage: Erster Vorschlag angenommen, zweiter muss noch überdacht werden.

himitsu 19. Nov 2010 11:29

AW: Klasse zum Beenden eines Prozesses
 
Zitat:

Zitat von Luckie (Beitrag 1062528)
@himitsu: Wenn ich mich recht erinnere steht pe32.szExeFile nur der Prozessname, also kein Pfad.

OK, dann halt doch nur AnsiSameText.
Hätte den vollständigen Pfad erwartet (wie bei Application.ExeName :stupid: ),
da ja mehrere Dateien auf einer Festplatte den selben Namen besitzen können.

Luckie 21. Nov 2010 01:35

AW: Klasse zum Beenden eines Prozesses
 
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.

toms 21. Nov 2010 04:28

AW: Klasse zum Beenden eines Prozesses
 
1. OpenProcess .... CloseHandle
2. Evtl. noch erweitern mit SE_DEBUG_NAME Privileg setzen

Luckie 21. Nov 2010 07:21

AW: Klasse zum Beenden eines Prozesses
 
Gut, dass ihr noch mal drüberguckt. Das CloseHandle habe ich übersehen.

Braucht man für SE_DEBUG_NAME nicht bestimmte rechte? Ich werde es aber mal ausprobieren. Scheint zu gehen.

Danke für die Hinweise.

Allerdings habe ich immer noch das Problem mit der Vollzugsmeldung beim erfolgreichen beenden bei WAIT_TIMEOUT.


Alle Zeitangaben in WEZ +1. Es ist jetzt 16:31 Uhr.
Seite 2 von 5     12 34     Letzte »    

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz