Prozess starten + Rückgabewert für Delphi 2009

[Zerolith]

Habe heute nach genau so einer Funktion hier gesucht. Musste aber für Delphi 2009 ein paar Anpassungen machen.
(Leider find ich den Link grad nicht mehr)

Konnte den Code hier nur mit 2009 und XP testen. Theoretisch müsste es schon mit Delphi 6 funktionieren.

Hoffe es hilft jemandem.

Delphi-Quellcode:

function RunWaitAndCaptureOutput(CommandLine: ansistring; var Output: ansistring): DWord;
const
  BufSize = 1024;
var
  buf: array[0..BufSize - 1] of ansichar;
  si: STARTUPINFOA;
  sa: SECURITY_ATTRIBUTES;
  sd: SECURITY_DESCRIPTOR;
  pi: PROCESS_INFORMATION;
  newstdout, read_stdout: THandle;
  bytes_read: cardinal;
  bytes_available: cardinal;

  procedure ZeroBuffer;
  begin
    FillChar(Buf, SizeOf(Buf), 0);
  end;

  procedure RaiseError(str: string);
  var
    n: DWord;
  begin
    n := GetLastError;
    raise EReadError.CreateFmt('%s: %d/0x%x -%s', [Str, n, n, SysErrorMessage(n)]);
  end;

  procedure GetData;
  begin
    PeekNamedPipe(read_stdout, @buf, BufSize - 1, @bytes_read, @bytes_available, nil);
    if (bytes_read <> 0) then
    begin
      ZeroBuffer;
      if (bytes_available > BufSize - 1)
        then
        while (bytes_read >= BufSize - 1) do
        begin
          ReadFile(read_stdout, buf, BufSize - 1, bytes_read, nil);
          Output := Output + Buf;
          ZeroBuffer;
        end
      else
      begin
        ReadFile(read_stdout, buf, BufSize - 1, bytes_read, nil);
        Output := Output + Buf;
      end;
    end;
  end;

begin
  Output := '';
  Result := 255;

  if IsWindowsNT then
  begin
    InitializeSecurityDescriptor(@sd, SECURITY_DESCRIPTOR_REVISION);
    SetSecurityDescriptorDacl(@sd, true, nil, False);
    sa.lpSecurityDescriptor := @sd;
  end else
    sa.lpSecurityDescriptor := nil;

  sa.nLength := sizeof(SECURITY_ATTRIBUTES);
  sa.bInheritHandle := true; //allow inheritable handles

  if not (CreatePipe(read_stdout, newstdout, @sa, 0)) then
    RaiseError('CreatePipe');

  GetStartupInfoA(si);

  si.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
  si.wShowWindow := SW_HIDE;
  si.hStdOutput := newstdout;
  si.hStdError := newstdout;

  if not (CreateProcessA(nil, PAnsiChar(CommandLine), nil, nil, TRUE, CREATE_NEW_CONSOLE, nil, nil, si, pi)) then
  begin
    CloseHandle(newstdout);
    CloseHandle(read_stdout);
    RaiseError('CreateProcess');
  end;

  ZeroBuffer;
  while True do
  begin
    GetExitCodeProcess(pi.hProcess, Result);
    if (Result <> STILL_ACTIVE) then break;
    GetData;
  end;

  GetData;

  CloseHandle(pi.hThread);
  CloseHandle(pi.hProcess);
  CloseHandle(newstdout);
  CloseHandle(read_stdout);
end;

[Luckie]

Und was musstest du wie für D2009 anpassen?

[Zerolith]

zum einen die Parameter von String auf AnsiString

den Buffer auf AnsiChar

si: STARTUPINFO => auf STARTUPINFOA

CreateProcess auf CreateProcessA

und den Parameter PChar(CommandLine) auf PAnsiChar(CommandLine)

[toms]

Zitat:

Zitat von Zerolith

Habe heute nach genau so einer Funktion hier gesucht. Musste aber für Delphi 2009 ein paar Anpassungen machen.
(Leider find ich den Link grad nicht mehr)
[/delphi]

Die ursprüngliche Version wurde hier veröffentlicht.

[Zerolith]

Zitat:

Zitat von toms

Zitat:

Zitat von Zerolith

Habe heute nach genau so einer Funktion hier gesucht. Musste aber für Delphi 2009 ein paar Anpassungen machen.
(Leider find ich den Link grad nicht mehr)
[/delphi]

Die ursprüngliche Version wurde hier veröffentlicht.

Ah, Dankeschön!

[Luckie]

Zitat:

Zitat von Zerolith

zum einen die Parameter von String auf AnsiString

den Buffer auf AnsiChar

si: STARTUPINFO => auf STARTUPINFOA

CreateProcess auf CreateProcessA

und den Parameter PChar(CommandLine) auf PAnsiChar(CommandLine)

Warum denn das? D2009 benutzt standardmäßig Unicode und du biegst alles wieder auf Ansi zurück?

[Apollonius]

Overlapped IO ist etwas Feines. Ich hasse es, wenn ich Code mit derartigen Schleifen sehe. Windows stellt nicht umsonst Funktionen zum Warten bereit.

[Luckie]

Ah, das wollte ich auch schon mal machen, habe es aber nicht hinbekommen. Könntest du das mal bitte machen, wenn du weißt, wie es geht?

[Apollonius]

Bitte sehr.

Delphi-Quellcode:

//Either Path or CmdLine may be empty.
function CreateProcessAndReadOutput(Path: String; CmdLine: String; out Output: String): DWord;
const BUFFER_SIZE = 512;
var lpPath, lpCmdLine: PChar;
    StartupInf: STARTUPINFO;
    ProcessInfo: PROCESS_INFORMATION;

    PipeName: String;
    SecAttr: SECURITY_ATTRIBUTES;
    WriteHandle, ReadHandle: THandle;

    OvLapped: OVERLAPPED;
    BytesRead: Cardinal;
    Buffer: array[0..BUFFER_SIZE - 1] of Byte;
    BufStr: AnsiString;

    HandleArray: array[0..1] of THandle;
begin
  Output := '';

  if Path = '' then
    lpPath := nil
  else
    lpPath := PChar(Path);
  if CmdLine = '' then
    lpCmdLine := nil
  else
    lpCmdLine := PChar(CmdLine);

  ZeroMemory(@SecAttr, SizeOf(SecAttr));
  SecAttr.nLength := SizeOf(SecAttr);
  SecAttr.bInheritHandle := True;

  PipeName := '\\.\pipe\8F66970600BF4D84BAA77F3936C04BE0' + 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, @SecAttr, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
    if WriteHandle = INVALID_HANDLE_VALUE then
      RaiseLastOSError;
    try
      ZeroMemory(@StartupInf, SizeOf(StartupInf));
      StartupInf.cb := SizeOf(StartupInf);
      StartupInf.dwFlags := STARTF_USESTDHANDLES;
      StartupInf.hStdOutput := WriteHandle;
      StartupInf.hStdError := WriteHandle;
      //Input uses our console.
      StartupInf.hStdInput := GetStdHandle(STD_INPUT_HANDLE);

      if not CreateProcess(lpPath, lpCmdLine, nil, nil, True, 0, nil, nil, StartupInf, ProcessInfo) then
        RaiseLastOSError;

      CloseHandle(ProcessInfo.hThread);
      try
        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, nil, @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;
            SetString(BufStr, PAnsiChar(@Buffer), BytesRead);
            Output := Output + BufStr;

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

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

[Dezipaitor]

Die Serverseite der Pipe sollte durch

Delphi-Quellcode:

1. FlushFileBuffers(hPipe); 
2. DisconnectNamedPipe(hPipe); 
CloseHandle(hPipe);

beendet werden.
Durch 1. wird der letzte WriteCall (vom Server) auch vollständig durchgeführt.
Durch 2. wird die Pipe auch wirklich geschlossen und nicht einfach der Pipe Handle Referenzzähler um eins nach unten gesetzt.

[dkoehler]

Sind die Aufrufe von ZeroMemory hier wirklich notwendig?

[Apollonius]

Bei SecAttr reicht es, manuell den Security Descriptor auf nil zu setzen. Bei StartupInf ist es angebracht, weil es dort einige Felder gibt, die in jedem Fall ausgewertet werden.

Prinzipiell kann man fast alle Aufrufe von ZeroMemory durch manuelles Nullen ersetzen.

[Luckie]

Wenn man nicht alle Felder initialisiert, ja. Ansonsten könnte da Schrott drinne stehe, was zu einem Fehler der Funktion führen könnte, deswegen "nullt" man vorher alle Felder.

[Dezipaitor]

Vorsicht ist die Mutter der Porzellankiste, oder wie war das? :)

[Luckie]

Aber noch mal die Frage. Delphi2009 unterstützt standardmäßig nicode. Warum wurde, um die Funktion unter Delphi2009 zum Laufen zu brigen, alles wieder auf Ansi zurückgebogen?

[Apollonius]

Grundsätzlich gibt es keinen Grund, alles auf ANSI umzustellen. Allerdings kann durch den umgeleiteten Standard-Output nur Ansi-Text empfangen werden. Daher steht in meinem Code auch manchmal String und manchmal AnsiString.

[Dezipaitor]

CreateProcessW ohne lokale Variable für AppName wäre eh falsch.

[dkoehler]

It is not possible to use an anonymous pipe with the last code example, or?

[dkoehler]

Entschuldigung, ich war gerade beim Lesen der MS-Doku ganz auf englisch eingestellt. Also: Es ist nicht möglich beim letzten Beispiel eine anonyme Pipe zu verwenden, oder doch?

[Dezipaitor]

Zitat:

Zitat von dkoehler

It is not possible to use an anonymous pipe with the last code example, or?

Das deutsche "oder", am Ende eines Satzes wird im englischen durch die Negation des Verbs (aber nur "sein" und Hilfsverben (can)) + Subjekt am Schluss gebildet. Hier also : ",is it". Nur so :)

---
Mit CreateProcess und dem Parameter "inheritHandles" auf True, erbt der neue Prozess alle vererbaren Handles und kann somit auch auf eine anonyme Pipe zugreifen.

[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ß.

[dkoehler]

Der Fehler in meinem Code war einer jener kleinen Bugs, wie man sie gerne übersieht, weil eine Änderung an einer einen Nebeneffekt an anderer Stelle mit sich führt: Ich hatte vergessen, den ersten Parameter von MsgWaitForMultipleObjects() von 2 auf 3 zu erhöhen. Statt einen expliziten Wert anzugeben, schreibe ich darum jetzt lieber Length(HandleArray).

Jedenfalls funktioniert nun auch das separate Auslesen des standard output und des standard error output. Eine entsprechend aktualisierte Version 1.0.1 der Application Launcher package kann via http://www.philo.de/xml/downloads.shtml heruntergeladen werden.