Prozess starten + Rückgabewert für Delphi 2009

[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;