CreateProcess & TerminateProcess schlägt fehl

[AScomp]

Hallo zusammen,

meine Problemstellung ist wie folgt:

Ich rufe den Windows Explorer (explorer.exe) auf und übergebe /root,X: als Parameter, um Netzlaufwerk X: aufzuwecken. Das funktioniert soweit auch, allerdings möchte ich die geöffnete Explorer-Instanz auch wieder sauber schließen.

Ganz egal, ob ich das mit ShellExecuteEx oder CreateProcess probiere, ich erhalte immer eine ProcessID, die nicht mit der im Taskmgr übereinstimmt. Entsprechend kriege ich den Prozess auch nicht wieder geschlossen.

Hier mal mein Beispielcode (habe versch. TerminateProcess-Varianten ausprobiert, auch vor und nach dem CloseHandle-Aufruf, alles erfolglos):

Delphi-Quellcode:

function ExecuteProcess(const FileName, Params: string; Folder: string; RunMinimized: boolean; iWaitMS: Integer): boolean;
var
  CmdLine: string;
  WorkingDirP: PChar;
  StartupInfo: TStartupInfo;
  ProcessInfo: TProcessInformation;
begin
  Result := true;
  CmdLine := '"' + FileName + '" ' + Params;
  if Folder = '' then Folder := ExcludeTrailingPathDelimiter(ExtractFilePath(FileName));
  ZeroMemory(@StartupInfo, SizeOf(StartupInfo));
  StartupInfo.cb := SizeOf(StartupInfo);
  if RunMinimized then
    begin
      StartupInfo.dwFlags := STARTF_USESHOWWINDOW;
      StartupInfo.wShowWindow := SW_HIDE;
    end;
  if Folder <> '' then WorkingDirP := PChar(Folder)
  else WorkingDirP := nil;
  if not CreateProcess(nil, PChar(CmdLine), nil, nil, false, 0, nil, WorkingDirP, StartupInfo, ProcessInfo) then
    begin
      Result := false;
      exit;
    end;
  with ProcessInfo do
    begin
      CloseHandle(hThread);
      repeat
            Sleep(100);
            Application.ProcessMessages;
            iWaitMS := iWaitMS - 100;
      until iWaitMS <= 0;
      CloseHandle(hProcess);
      //TerminateProcess(OpenProcess(PROCESS_ALL_ACCESS, false, GetProcessID(ProcessInfo.hProcess)), 0);
      TerminateProcess(OpenProcess(PROCESS_TERMINATE, false, ProcessInfo.dwProcessId), 0);
      //TerminateProcess(ProcessInfo.hProcess, 0);
    end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
     ExecuteProcess('explorer.exe', '/root,' + ExtractFileDrive('C:\Temp\'), '', false, 3000);
end;

Hinweis: Im Beispiel teste ich mit C:, das macht allerdings von der Problematik her keinen Unterschied.

Sobald ich die im taskmgr angezeigte ProcessID an TerminateProcess übergebe, wird die Exporer-Instanz sauber geschlossen. Ich scheitere einzig daran, die korrekte ProcessID zu ermitteln.

Hat jemand eine Idee?

[AScomp]

Hallo zusammen,

habe eine Lösung gefunden, auch wenn sie nicht die eleganteste unter ihresgleichen ist:

Ich ermittle vor und nach dem Start meiner Explorer-Instanz mit Process32First und Process32Next alle Explorer-Instanzen und prüfe, welche neu hinzugekommen ist. Diese Instanz schließe ich dann am Ende wieder mit TerminateProcess.

Nicht schön, aber selten.

[KodeZwerg]

Ich habe Deinen Code nicht getestet sondern einfach mal was getippst, ausgeführt und war alles gut.

Vielleicht hilft es dir.

Delphi-Quellcode:

unit Unit1;

interface

uses

Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,

Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls;

type

 TForm1 = class(TForm)

 Panel1: TPanel;
 Panel2: TPanel;
 Label1: TLabel;
 edtFilename: TEdit;
 Panel3: TPanel;
 Panel4: TPanel;
 Label2: TLabel;
 edtPH: TEdit;
 Panel5: TPanel;
 Label3: TLabel;
 edtTH: TEdit;
 Panel6: TPanel;
 Label4: TLabel;
 edtPI: TEdit;
 Panel7: TPanel;
 Button1: TButton;
 btnTerminate: TButton;
 Panel8: TPanel;
 Label5: TLabel;
 edtTI: TEdit;
 procedure Button1Click(Sender: TObject);
 procedure btnTerminateClick(Sender: TObject);
 procedure FormDestroy(Sender: TObject);

 private

 { Private declarations }
 ProcessInfo: TProcessInformation;
 procedure ResetGUI;

 public

 { Public declarations }

end;

var

 Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.ResetGUI;
begin
 edtPH.Text := '';
 edtTH.Text := '';
 edtPI.Text := '';
 edtTI.Text := '';
 btnTerminate.Enabled := False;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
 StartUpInfo: TStartUpInfo;
begin
  if (not FileExists(edtFilename.Text)) then
    begin
      ResetGUI;
      Exit;
    end;
  FillMemory(@StartUpInfo, SizeOf(StartUpInfo), 0);
  StartUpInfo.cb := SizeOf(StartUpInfo);
  if CreateProcess(nil, PChar(edtFilename.Text), nil, nil, False, NORMAL_PRIORITY_CLASS, nil, nil, StartUpInfo, ProcessInfo) then
  begin
    edtPH.Text := IntToStr(ProcessInfo.hProcess);
    edtTH.Text := IntToStr(ProcessInfo.hThread);
    edtPI.Text := IntToStr(ProcessInfo.dwProcessId);
    edtTI.Text := IntToStr(ProcessInfo.dwThreadId);
    btnTerminate.Enabled := True;
  end;
end;

procedure TForm1.btnTerminateClick(Sender: TObject);
begin
  if ((ProcessInfo.hProcess <> 0) and (ProcessInfo.hProcess <> INVALID_HANDLE_VALUE)) then
  if TerminateProcess(ProcessInfo.hProcess, 0) then
    begin
      if ((ProcessInfo.hProcess <> 0) and (ProcessInfo.hProcess <> INVALID_HANDLE_VALUE)) then
        CloseHandle(ProcessInfo.hProcess);
      if ((ProcessInfo.hThread <> 0) and (ProcessInfo.hThread <> INVALID_HANDLE_VALUE)) then
        CloseHandle(ProcessInfo.hThread);
      btnTerminate.Enabled := False;
    end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  if ((ProcessInfo.hProcess <> 0) and (ProcessInfo.hProcess <> INVALID_HANDLE_VALUE)) then
    CloseHandle(ProcessInfo.hProcess);
  if ((ProcessInfo.hThread <> 0) and (ProcessInfo.hThread <> INVALID_HANDLE_VALUE)) then
    CloseHandle(ProcessInfo.hThread);
end;

end.

/edit
Dies ist nur eine Vorlage zum testen.
Argumente müssen noch nachgetragen werden.
Kann man auch als function mit rückgabe des handles schreiben.

Viel Erfolg

[himitsu]

Zitat:

Delphi-Quellcode:

procedure TForm1.FormDestroy(Sender: TObject);
begin
  if ((ProcessInfo.hProcess <> 0) and (ProcessInfo.hProcess <> INVALID_HANDLE_VALUE)) then
    CloseHandle(ProcessInfo.hProcess);
  if ((ProcessInfo.hThread <> 0) and (ProcessInfo.hThread <> INVALID_HANDLE_VALUE)) then
    CloseHandle(ProcessInfo.hThread);
end;

Da jemand keine Rückgaben der API "CloseHandle" prüft .... wozu dann die Eingaben prüfen?

Delphi-Quellcode:

procedure TForm1.FormDestroy(Sender: TObject);
begin
  CloseHandle(ProcessInfo.hProcess);
  CloseHandle(ProcessInfo.hThread);
end;

Zitat:

Delphi-Quellcode:

procedure TForm1.btnTerminateClick(Sender: TObject);
begin
  if ((ProcessInfo.hProcess <> 0) and (ProcessInfo.hProcess <> INVALID_HANDLE_VALUE)) then
  if TerminateProcess(ProcessInfo.hProcess, 0) then
    begin
      if ((ProcessInfo.hProcess <> 0) and (ProcessInfo.hProcess <> INVALID_HANDLE_VALUE)) then
        CloseHandle(ProcessInfo.hProcess);
      if ((ProcessInfo.hThread <> 0) and (ProcessInfo.hThread <> INVALID_HANDLE_VALUE)) then
        CloseHandle(ProcessInfo.hThread);
      btnTerminate.Enabled := False;
    end;
end;

Aber egal ob du oder Windows die Werte prüfen, wie soll eine Prüfung funktionieren, wenn sie ungültige oder gar total "falsche" Daten bekommt?

Delphi-Quellcode:

procedure TForm1.btnTerminateClick(Sender: TObject);
begin
  if ((ProcessInfo.hProcess <> 0) and (ProcessInfo.hProcess <> INVALID_HANDLE_VALUE)) then
  if TerminateProcess(ProcessInfo.hProcess, 0) then
    begin
      CloseHandle(ProcessInfo.hProcess);
      CloseHandle(ProcessInfo.hThread);
      ProcessInfo.hProcess := INVALID_HANDLE_VALUE;  // oder 0
      ProcessInfo.hThread := INVALID_HANDLE_VALUE;
      btnTerminate.Enabled := False;
    end;
end;

Denn ratet mal was passiert, wenn das Handle in der Zwischenzeit schonwieder durch was Anderes belegt ist?
-> Genau, anstatt nichts zu machen, wird "irgendwas" Anderes geschlossen.

Also nochmal auf den Knopf drücken (OK, btnTerminate.Enabled:=False) oder spätstens beim FormDestroy.

[KodeZwerg]

Nächster Versuch

Delphi-Quellcode:

unit Unit1;

(*
Der zweite Anlauf ...

Dieses mal wird in einem Record die PID plus dazugehöriger Dateiname gespeichert.

Create und Close methoden sind nun entkoppelt.

Es können nun auch Argumente/Parameter angegeben werden.

Diese Variante funktioniert solange der aufgerufene Prozess sich nicht selbst schließt und wieder öffnet.

Diese Variante stellt nur grob dar wie ich es machen würde.

Diese Vorgehensweise ist bei weitem nicht perfekt sondern nur rasch skizziert und Alpha-Status (Erfolg beim testen) wurde erreicht.

Danke an himitsu für Hinweise.
*)

interface

uses

  Winapi.Windows, Winapi.PsApi,
  System.SysUtils, System.Classes,
  Vcl.Forms, Vcl.Controls, Vcl.StdCtrls, Vcl.ExtCtrls;

type

  TLastPID = packed record
    dwPID: DWORD;
    sFileName: string;
  end;

  TForm1 = class(TForm)
    pnlMain: TPanel;
    pnlFilename: TPanel;
    lblFilename: TLabel;
    edtFilename: TEdit;
    edtParams: TEdit;
    pnlButtons: TPanel;
    btnExecute: TButton;
    btnTerminate: TButton;
    procedure FormCreate(Sender: TObject);
    procedure btnExecuteClick(Sender: TObject);
    procedure btnTerminateClick(Sender: TObject);
  private
    (* Falls Deine Anwendung viele Sachen öffnen soll empfehle ich hier ein array fürs management. *)
    LastPID: TLastPID; // hier werden die zuletzt gültigen Daten hinterlegt.
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

// methode um eine ausführbare datei zu starten und die PID übermitteln.
function CreatePID(const Filename, Params: string; var PID: DWORD): Boolean;
var
  ProcessInfo: TProcessInformation;
  StartUpInfo: TStartUpInfo;
  CommandLine: string;
begin
  PID := 0;
  CommandLine := '"' + Filename + '"';
  if (Params <> '') then
    CommandLine := CommandLine + ' ' + Params;
  FillMemory(@StartUpInfo, SizeOf(StartUpInfo), 0);
  StartUpInfo.cb := SizeOf(StartUpInfo);
  if CreateProcess(nil, PChar(CommandLine), nil, nil, BOOL(False), NORMAL_PRIORITY_CLASS, nil, nil, StartUpInfo, ProcessInfo) then
    begin
      PID := ProcessInfo.dwProcessId;
      CloseHandle(ProcessInfo.hProcess);
      CloseHandle(ProcessInfo.hThread);
      Result := True;
    end
    else
      Result := False;
end;

// methode um eine PID abzuschießen, inkl. optionaler Namensprüfung 
function ClosePID(const PID: DWORD; const Filename: string = ''): Boolean;
var
  hProcess: THandle;
  Path: Array [0..MAX_PATH -1] of Char;
  Checked: Boolean;
begin
  Result := False;
  if (PID = 0) then
    Exit;
  if (Filename <> '') then
    begin
      hProcess := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, BOOL(False), PID);
      if ((hProcess <> 0) and (hProcess <> INVALID_HANDLE_VALUE)) then
        begin
          try
            Checked := False;
            // für GetModuleFileNameEx die PsApi unit einbinden
            if (GetModuleFileNameEx(hProcess, 0, Path, MAX_PATH) = 0) then
              RaiseLastOSError
            else
              // extrem simplifizierte Prüfung auf Namensgleichheit 
              Checked := LowerCase(ExtractFileName(Filename)) = LowerCase(ExtractFileName(Path));
          finally
            CloseHandle(hProcess);
            if ((Checked) and (TerminateProcess(OpenProcess(PROCESS_TERMINATE, BOOL(False), PID), 0))) then
              Result := True;
          end;
        end;
    end
    else
      if (TerminateProcess(OpenProcess(PROCESS_TERMINATE, BOOL(False), PID), 0)) then
        Result := True;
end;

// programm start
procedure TForm1.FormCreate(Sender: TObject);
begin
  ReportMemoryLeaksOnShutdown := True;
  LastPID.dwPID := 0;
  LastPID.sFileName := '';
  btnTerminate.Enabled := False;
end;

// ausfhren klick
procedure TForm1.btnExecuteClick(Sender: TObject);
begin
  btnTerminate.Enabled := False;
  if (not FileExists(edtFilename.Text)) then
    Exit;
  if CreatePID(edtFilename.Text, edtParams.Text, LastPID.dwPID) then
    begin
      LastPID.sFileName := edtFilename.Text;
      btnTerminate.Enabled := True;
    end;
end;

// beenden klick
procedure TForm1.btnTerminateClick(Sender: TObject);
begin
  btnTerminate.Enabled := False;
  ClosePID(LastPID.dwPID, LastPID.sFileName);
  LastPID.dwPID := 0;
  LastPID.sFileName := '';
end;

end.

[KodeZwerg]

Da noch nichts gegenteiliges geschah betrachte ich dieses Thema nun als erledigt.