Problem mit CreateProcess

[turboPASCAL]

Ich verwende diese Methode da sie auch "zwischendurch" die Ausgaben umleitet.

Delphi-Quellcode:

procedure RunConsoleApp(const CommandLine: string; AStrings: TStrings);
type
  TCharBuffer = array[0..MaxInt - 1] of Char;
const
  MaxBufSize = 1024;
var
  I: Longword;
  SI: TStartupInfo;
  PI: TProcessInformation;
  SA: PSecurityAttributes;
  SD: PSECURITY_DESCRIPTOR;
  NewStdIn: THandle;
  NewStdOut: THandle;
  ReadStdOut: THandle;
  WriteStdIn: THandle;
  Buffer: ^TCharBuffer;
  BufferSize: Cardinal;
  Last: WideString;
  Str: WideString;
  ExitCode: DWORD;
  Bread: DWORD;
  Avail: DWORD;
begin
  GetMem(SA, SizeOf(TSecurityAttributes));
  case Win32Platform of
    VER_PLATFORM_WIN32_NT:
      begin
        GetMem(SD, SizeOf(SECURITY_DESCRIPTOR));
        SysUtils.Win32Check(InitializeSecurityDescriptor(SD, SECURITY_DESCRIPTOR_REVISION));
        SysUtils.Win32Check(SetSecurityDescriptorDacl(SD, True, nil, False));
        SA.lpSecurityDescriptor := SD;
      end; {end VER_PLATFORM_WIN32_NT}
  else
    SA.lpSecurityDescriptor := nil;
  end; {end case}
  SA.nLength := SizeOf(SECURITY_ATTRIBUTES);
  SA.bInheritHandle := True;
  SysUtils.Win32Check(CreatePipe(NewStdIn, WriteStdIn, SA, 0));
  if not CreatePipe(ReadStdOut, NewStdOut, SA, 0) then
  begin
    CloseHandle(NewStdIn);
    CloseHandle(WriteStdIn);
    SysUtils.RaiseLastWin32Error;
  end; {end if}
  GetStartupInfo(SI);
  SI.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
  SI.wShowWindow := {SW_SHOWNORMAL} SW_HIDE;
  SI.hStdOutput := NewStdOut;
  SI.hStdError := NewStdOut;
  SI.hStdInput := NewStdIn;
  if not CreateProcess(nil, PChar(CommandLine), nil, nil, True,
    CREATE_NEW_CONSOLE, nil, nil, SI, PI) then
  begin
    CloseHandle(NewStdIn);
    CloseHandle(NewStdOut);
    CloseHandle(ReadStdOut);
    CloseHandle(WriteStdIn);
    SysUtils.RaiseLastWin32Error;
  end; {end if}
  Last := '';
  BufferSize := MaxBufSize;
  Buffer := AllocMem(BufferSize);
  try
    repeat
      SysUtils.Win32Check(GetExitCodeProcess(PI.hProcess, ExitCode));
      PeekNamedPipe(ReadStdOut, Buffer, BufferSize, @Bread, @Avail, nil);
      if (Bread <> 0) then
      begin
        if (BufferSize < Avail) then
        begin
          BufferSize := Avail;
          ReallocMem(Buffer, BufferSize);
        end; {end if}
        FillChar(Buffer^, BufferSize, #0);
        ReadFile(ReadStdOut, Buffer^, BufferSize, Bread, nil);
        Str := Last;
        I := 0;
        while (I < Bread) do
        begin
          case Buffer^[I] of
            #0: inc(I);
            #10:
              begin
                inc(I);
                AStrings.Add(Str);
                Str := '';
              end; {end #10}
            #13:
              begin
                inc(I);
                if (I < Bread) and (Buffer^[I] = #10) then
                  inc(I);
                AStrings.Add(Str);
                Str := '';
              end; {end #13}
          else
            begin
              Str := Str + Buffer^[I];
              inc(I);
            end; {end else}
          end; {end case}
        end; {end while}
        Last := Str;
      end; {end if}
      Sleep(1);
      Application.ProcessMessages;
    until (ExitCode <> STILL_ACTIVE);
    if Last <> '' then
      AStrings.Add(Last);
  finally
    FreeMem(Buffer);
  end; {end try/finally}
  CloseHandle(PI.hThread);
  CloseHandle(PI.hProcess);
  CloseHandle(NewStdIn);
  CloseHandle(NewStdOut);
  CloseHandle(ReadStdOut);
  CloseHandle(WriteStdIn);
end; {end procedure}

.. wo hab ich den jetzt her?

Aufruf z.B.:

Delphi-Quellcode:

procedure TForm1.Button1Click(Sender: TObject);
begin
  Memo1.Clear;
  RunConsoleApp('cmd.exe /c dir c:\windows\*.*', Memo1.Lines);
end.

...bei dem Umleiten mit ">" konnte ich noch keine Probleme feststellen.

[edit=SirThornberry]Neu abgespeichert um Higlighting zu korrigieren. Mfg, SirThornberry[/edit]