Prozess starten + Rückgabewert für Delphi 2009

[dkoehler]

Ich bin gerade dabei, den Code auf Delphi 2009 und TBytes als Ausgabe umzuschreiben. Alles funktioniert wie gewünscht mit einer Ausnahme: Meine GUI-Applikation ruft eine Konsole-Applikation auf. Wie kann ich die Anzeige der Konsole unterdrücken? Wenn ich in CreateProcess() für den dwCreationFlags Parameter CREATE_NO_WINDOW angebe, erscheint die Konsole trotzdem.

[Apollonius]

Hast du mal DETACHED_PROCESS ausprobiert? Bezüglich der anonymen Pipes: Ich habe eine benannte Pipe verwendet, weil nur dort Overlapped IO möglich ist. Genau dafür habe ich das Beispiel aber geschrieben.

[dkoehler]

Ich habe Apollonius' Code in eine Komponente umgeschrieben. Die CreateNoWindow Flag gibt an, ob das externe Programm in einem eigenen Fenster gestartet werden soll oder nicht. Über das OnProgress Ereignis kann man beim Einlesen der Were den Stand des internen Streams auswerten, wobei man über die ProcessInfo Variable erfährt, mit welchem Prozeß man es zu tun hat. Zum Starten und Einlesen der Rückgabewerte muß man ExecuteA() bzw. ExecuteW() aufrufen (es handelt sich um die AnsiString- und die WideString-Version von im Prinzip derselben Funktion).

Delphi-Quellcode:

interface

uses
  Windows, Classes, SysUtils;

type

  TAppLauncherProgressEvent = procedure(Sender: TObject; ProcessInfo: PROCESS_INFORMATION; Position: Int64) of object;

  TAppLauncher = class(TComponent)
  private
    FCreateNoWindow: Boolean;
    FOnProgress: TAppLauncherProgressEvent;
    FSecurityAttributes: SECURITY_ATTRIBUTES;
    FSecurityDescriptor: SECURITY_DESCRIPTOR;
    function CentralLoop(const ProcessInfo: PROCESS_INFORMATION; const ReadHandle: THandle; const OutputStream: TStream): DWord; inline;
  protected
    procedure DoProgress(ProcessInfo: PROCESS_INFORMATION; Position: Int64); virtual;
    procedure PreparePipe(out ReadHandle, WriteHandle: THandle); virtual; 
    function PrepareStartupInfoA(const StdOutput: THandle): STARTUPINFOA; virtual; 
    function PrepareStartupInfoW(const StdOutput: THandle): STARTUPINFOW; virtual; 

    property SecurityAttributes: SECURITY_ATTRIBUTES read FSecurityAttributes;
    property SecurityDescriptor: SECURITY_DESCRIPTOR read FSecurityDescriptor;
  public
    constructor Create(AOwner: TComponent); override;
    function ExecuteA(const Path, CmdLine: AnsiString; out Output: TBytes): DWORD;
    function ExecuteW(const Path, CmdLine: WideString; out Output: TBytes): DWORD;
  published
    property CreateNoWindow: Boolean read FCreateNoWindow write FCreateNoWindow default false;
    property OnProgress: TAppLauncherProgressEvent read FOnProgress write FOnProgress;
  end;

implementation

uses
  TeCanvas, Forms;

{ TAppLauncher }

constructor TAppLauncher.Create(AOwner: TComponent);
begin
  inherited;

  FCreateNoWindow := false;

  ZeroMemory(@FSecurityAttributes, SizeOf(FSecurityAttributes));

  if IsWindowsNT then
  begin
    InitializeSecurityDescriptor(@FSecurityDescriptor, SECURITY_DESCRIPTOR_REVISION);
    SetSecurityDescriptorDacl(@FSecurityDescriptor, True, nil, False);
    FSecurityAttributes.lpSecurityDescriptor := @FSecurityDescriptor;
  end else
    FSecurityAttributes.lpSecurityDescriptor := nil;

  FSecurityAttributes.nLength := SizeOf(SECURITY_ATTRIBUTES);
  FSecurityAttributes.bInheritHandle := True;
end;

procedure TAppLauncher.DoProgress(ProcessInfo: PROCESS_INFORMATION; Position: Int64);
begin
  if Assigned(FOnProgress) then
    FOnProgress(Self, ProcessInfo, Position);
end;

procedure TAppLauncher.PreparePipe(out ReadHandle,
  WriteHandle: THandle);
var
  PipeName: string;
begin
  PipeName := '\\.\pipe\' + IntToHex(Random(MaxInt), 8) + IntToHex(GetCurrentProcessId, 8) + IntToHex(Random(MaxInt), 8);

  ReadHandle := CreateNamedPipe(PChar(PipeName), PIPE_ACCESS_INBOUND or FILE_FLAG_OVERLAPPED, 0, 1, 1024, 1024, 0, nil);
  if ReadHandle = INVALID_HANDLE_VALUE then
    RaiseLastOSError;
  try
    WriteHandle := CreateFile(PChar(PipeName), GENERIC_WRITE, FILE_SHARE_READ, @SecurityAttributes, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
    if WriteHandle = INVALID_HANDLE_VALUE then
      RaiseLastOSError;
  except
    CloseHandle(ReadHandle);
  end;
end;

function TAppLauncher.PrepareStartupInfoA(const StdOutput: THandle): STARTUPINFOA;
begin
  ZeroMemory(@Result, SizeOf(Result));
  Result.cb := SizeOf(Result);
  Result.dwFlags := STARTF_USESTDHANDLES;
  Result.hStdInput := GetStdHandle(STD_INPUT_HANDLE);
  Result.hStdOutput := StdOutput;
  Result.hStdError := StdOutput;
end;

function TAppLauncher.PrepareStartupInfoW(const StdOutput: THandle): STARTUPINFOW;
begin
  ZeroMemory(@Result, SizeOf(Result));
  Result.cb := SizeOf(Result);
  Result.dwFlags := STARTF_USESTDHANDLES;
  Result.hStdInput := GetStdHandle(STD_INPUT_HANDLE);
  Result.hStdOutput := StdOutput;
  Result.hStdError := StdOutput;
end;

function TAppLauncher.CentralLoop(const ProcessInfo: PROCESS_INFORMATION; const ReadHandle: THandle; const OutputStream: TStream): DWord;
const
  BUFFER_SIZE = 512;
var
  OvLapped: OVERLAPPED;
  BytesRead: Cardinal;
  Buffer: array[0..BUFFER_SIZE - 1] of Byte;

  HandleArray: array[0..1] of THandle;
begin
  ZeroMemory(@OvLapped, SizeOf(OvLapped));
  OvLapped.hEvent := CreateEvent(nil, True, False, nil);
  try
    HandleArray[0] := ProcessInfo.hProcess;
    HandleArray[1] := OvLapped.hEvent;
    if not ReadFile(ReadHandle, Buffer, BUFFER_SIZE, BytesRead, @OvLapped)
       and (GetLastError <> ERROR_IO_PENDING) then
      RaiseLastOSError;

    while WaitForMultipleObjects(2, @HandleArray, False, INFINITE) = WAIT_OBJECT_0 + 1 do
    begin
      if not GetOverlappedResult(ReadHandle, OvLapped, BytesRead, False) then
        RaiseLastOSError;
      OutputStream.Write(Buffer, BytesRead);

      ResetEvent(OvLapped.hEvent);
      if not ReadFile(ReadHandle, Buffer, BUFFER_SIZE, BytesRead, @OvLapped)
         and (GetLastError <> ERROR_IO_PENDING) then
        RaiseLastOSError;

      DoProgress(ProcessInfo, OutputStream.Position);
    end;

    GetExitCodeProcess(ProcessInfo.hProcess, Result);
  finally
    CloseHandle(OvLapped.hEvent);
  end;
end;

function TAppLauncher.ExecuteA(const Path, CmdLine: AnsiString;
  out Output: TBytes): DWORD;
var
  lpPath, lpCmdLine: PAnsiChar;
  StartupInf: STARTUPINFOA;
  ProcessInfo: PROCESS_INFORMATION;

  WriteHandle, ReadHandle: THandle;
  dwCreationFlags: Cardinal;
  BytesStream: TBytesStream;
begin
  PreparePipe(ReadHandle, WriteHandle);
  try
    try

      StartupInf := PrepareStartupInfoA(WriteHandle);

      if CreateNoWindow then
        dwCreationFlags := CREATE_NO_WINDOW
      else
        dwCreationFlags := 0;
      if Path = '' then
        lpPath := nil
      else
        lpPath := PAnsiChar(Path);
      if CmdLine = '' then
        lpCmdLine := nil
      else begin
        lpCmdLine := PAnsiChar(CmdLine);
      end;
      if not CreateProcessA(lpPath, lpCmdLine, nil, nil, True, dwCreationFlags, nil, nil, StartupInf, ProcessInfo) then
        RaiseLastOSError;

      try
        CloseHandle(ProcessInfo.hThread);

        BytesStream := TBytesStream.Create(nil);
        try
          Result := CentralLoop(ProcessInfo, ReadHandle, BytesStream);
          Output := BytesStream.Bytes;
        finally
          BytesStream.Free;
        end;

      finally
        CloseHandle(ProcessInfo.hProcess);
      end;

    finally
      CloseHandle(WriteHandle);
    end;
  finally
    CloseHandle(ReadHandle);
  end;
end;

function TAppLauncher.ExecuteW(const Path, CmdLine: WideString; out Output: TBytes): DWORD;
var
  lpPath, lpCmdLine: PWideChar;
  StartupInf: STARTUPINFOW;
  ProcessInfo: PROCESS_INFORMATION;

  WriteHandle, ReadHandle: THandle;
  dwCreationFlags: Cardinal;
  BytesStream: TBytesStream;

  CmdLineCopy: WideString;
begin
  PreparePipe(ReadHandle, WriteHandle);
  try
    try

      StartupInf := PrepareStartupInfoW(WriteHandle);

      if CreateNoWindow then
        dwCreationFlags := CREATE_NO_WINDOW
      else
        dwCreationFlags := 0;
      if Path = '' then
        lpPath := nil
      else
        lpPath := PWideChar(Path);
      if CmdLine = '' then
        lpCmdLine := nil
      else begin
        // We need to work with a copy of CmdLine. Cf. the Microsoft
        // documentation on the CreateProcess method: "The Unicode version of
        // this function, CreateProcessW, can modify the contents of this
        // string. Therefore, this parameter cannot be a pointer to read-only
        // memory (such as a const variable or a literal string). If this
        // parameter is a constant string, the function may cause an access
        // violation.
        CmdLineCopy := CmdLine;
        UniqueString(CmdLineCopy);
        lpCmdLine := PWideChar(CmdLineCopy);
      end;
      if not CreateProcessW(lpPath, lpCmdLine, nil, nil, True, dwCreationFlags, nil, nil, StartupInf, ProcessInfo) then
        RaiseLastOSError;

      try
        CloseHandle(ProcessInfo.hThread);

        BytesStream := TBytesStream.Create(nil);
        try
          Result := CentralLoop(ProcessInfo, ReadHandle, BytesStream);
          Output := BytesStream.Bytes;
        finally
          BytesStream.Free;
        end;

      finally
        CloseHandle(ProcessInfo.hProcess);
      end;

    finally
      CloseHandle(WriteHandle);
    end;
  finally
    CloseHandle(ReadHandle);
  end;
end;

[Apollonius]

:thumb: Dank dir. Drei Kommentare hätte ich noch:
1. Den Wert von hStdInput in der STARTUPINFO-Struktur auf den eigenen zu setzen, ist in einer GUI-Anwendung nicht sinnvoll, da dort kein Standard-Input zur Verfügung steht. Dort sollte also entweder 0 hin oder eine andere Pipe, über die dann mit dem gestarteten Prozess kommuniziert werden kann.
2. In einer GUI-Anwendung müssen Fenster-Nachrichten verarbeitet werden. Daher würde ich die zentrale Schleife folgendermaßen ändern:

Delphi-Quellcode:

while not Application.Terminated do
begin
  WaitResult := MsgWaitForMultipleObjects(2, @HandleArray, False, INFINITE, QS_ALLINPUT);
  if WaitResult = WAIT_OBJECT_0 + 1 then
  begin
    //neuen Lesevorgang starten
  end
  else if WaitResult = WAIT_OBJECT_0 + 2 then //Nachricht eingetroffen
    Application.ProcessMessages
  else //Prozessende
    break; 
end;

3. Sofort nach dem Starten des Prozesses schließt du das Handle des Hauptthreads. Ich würde darauf verzichten, da der Callback damit möglicherweise noch etwas anfangen kann. Falls du das Handle doch schließen willst, solltest du es zumindest in der PROCESS_INFORMATION-Struktur auf 0 setzen, damit ein Callback nicht fälschlicherweise darauf zugreifen kann.

[dkoehler]

Deinen Vorschlag 1 und 3 habe ich direkt übernommen. Bei Vorschlag 2 gibt es Probleme: Der zweite Parameter von MsgWaitForMultipleObjects() ist in Delphi 2009 als var deklariert. Ich habe darum Folgendes gemacht:

Delphi-Quellcode:

var
  PHandleArray: Pointer;
...
PHandleArray := @HandleArray;
while not Application.Terminated do
begin
  WaitResult := MsgWaitForMultipleObjects(2, PHandleArray, False, INFINITE, QS_ALLINPUT);
  if WaitResult = WAIT_OBJECT_0 + 1 then
  begin
    //neuen Lesevorgang starten
  end
  else if WaitResult = WAIT_OBJECT_0 + 2 then //Nachricht eingetroffen
    Application.ProcessMessages
  else //Prozessende
    break; 
end;

Trotzdem funktioniert auch jetzt der Code noch nicht, da WaitResult nach zwei oder drei Aufrufen von Application.ProcessMessages den Wert $FFFFFFFF zurückgibt und dann break aufgerufen wird.

[Apollonius]

Na, diese Deklaration ist ja wirklich bescheuert. Übergib statt dem Zeiger HandleArray[0], dann müsste das funktionieren.

[dkoehler]

Ich habe nun die AppLauncher-Komponente mit einem Icon versehen und in eine Package gepackt. Sie kann von http://www.philo.de/xml/downloads.shtml (ganz nach unten scrollen) heruntergeladen werden.

[dkoehler]

Ich bin nun dabei, den AppLauncher noch etwas komfortabler zu gestalten, das heißt ich möchte Standard-Output und Standard-Error separat auswerten. Dazu verwende ich zwei Pipes. Wenn ich richtig sehe, muß ich dazu einen Hauptthread starten, der zwei Kind-Threads erzeugt, einen um die Standard-Output-Pipe und einen um Standard-Error-Pipe abzuhören. Der Hauptthread terminiert und liefert die Abhörergebnisse seiner Kind-Threads zurück, sobald die Kind-Applikation terminiert. Oder geht es einfacher?

[Apollonius]

Ja, es geht einfacher. In der bisherigen Variante siehst du doch auch keinen extra-Thread. :wink: Das ist der Witz an Overlapped IO: Du gibst eine Operation in Auftrag, kannst aber weiter arbeiten und wirst benachrichtigt, wenn die Operation abgeschlossen ist. Konkret heißt das, dass du eine weitere Pipe und eine weitere OVERLAPPED-Struktur anlegst. Das Event dieser zweiten Overlapped-Struktur kommt auch in das Handle-Array. Du wartest damit nun auf drei Handles. In der Schleife ändert sich nun die Auswertung von WaitResult: WAIT_OPBJECT_0 heißt weiterhin, dass der Kindprozess nicht mehr läuft, WAIT_OBJECT_0 + 1 heißt, dass an der ersten Pipe ein Lesevorgang abgeschlossen wurde, WAIT_OBJECT_0 + 2 entsprechend an der zweiten Pipe und WAIT_OBJECT_0 + 3 steht für eine Fensternachricht. Darauf reagierst du dann entsprechend.

[dkoehler]

Danke für die Erläuterung! Ich hatte etwas in der Richtung mit zwei Overlapped-Events schon versucht, aber dann trat dabei Datenverlust auf. Jedenfalls weiß ich nun, daß ich grundsätzlich auf der richtigen Spur war und jetzt "nur" noch nach dem Bug suchen muß.