Doskonsole nutzen und Rückgabewerte einlesen

[fuchsle]

Hallo zusammen,

die Suchfunktion ist mir bekannt und ich habe auch schon einige Beiträge gefunden.
Bevorzugt wird von mir die Lösung mit der Funtion GetConsoleOutput, welche hier bekannt sein dürfte.

Delphi-Quellcode:

function TForm1.GetConsoleOutput(const Command: string; Output,
  Errors: TStringList): Boolean;
var
  StartupInfo: TStartupInfo;
  ProcessInfo: TProcessInformation;
  SecurityAttr: TSecurityAttributes;
  PipeOutputRead: THandle;
  PipeOutputWrite: THandle;
  PipeErrorsRead: THandle;
  PipeErrorsWrite: THandle;
  Succeed: Boolean;
  Buffer: array [0..255] of Char;
  NumberOfBytesRead: DWORD;
  Stream: TMemoryStream;
begin
  //Initialisierung ProcessInfo
  FillChar(ProcessInfo, SizeOf(TProcessInformation), 0);

  //Initialisierung SecurityAttr
  FillChar(SecurityAttr, SizeOf(TSecurityAttributes), 0);
  SecurityAttr.nLength := SizeOf(SecurityAttr);
  SecurityAttr.bInheritHandle := true;
  SecurityAttr.lpSecurityDescriptor := nil;

  //Pipes erzeugen
  CreatePipe(PipeOutputRead, PipeOutputWrite, @SecurityAttr, 0);
  CreatePipe(PipeErrorsRead, PipeErrorsWrite, @SecurityAttr, 0);

  //Initialisierung StartupInfo
  FillChar(StartupInfo, SizeOf(TStartupInfo), 0);
  StartupInfo.cb:=SizeOf(StartupInfo);
  StartupInfo.hStdInput := 0;
  StartupInfo.hStdOutput := PipeOutputWrite;
  StartupInfo.hStdError := PipeErrorsWrite;
  StartupInfo.wShowWindow := sw_Hide;
  StartupInfo.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;

  if CreateProcess(nil, PChar(command), nil, nil, true,
  CREATE_DEFAULT_ERROR_MODE or CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS, nil, nil,
  StartupInfo, ProcessInfo) then begin
    result:=true;
    //Write-Pipes schließen
    CloseHandle(PipeOutputWrite);
    CloseHandle(PipeErrorsWrite);

    //Ausgabe Read-Pipe auslesen
    Stream := TMemoryStream.Create;
    try
      while true do begin
        succeed := ReadFile(PipeOutputRead, Buffer, 255, NumberOfBytesRead, nil);
        if not succeed then break;
        Stream.Write(Buffer, NumberOfBytesRead);
      end;
      Stream.Position := 0;
      Output.LoadFromStream(Stream);
    finally
      Stream.Free;
    end;
    CloseHandle(PipeOutputRead);

    //Fehler Read-Pipe auslesen
    Stream := TMemoryStream.Create;
    try
      while true do begin
        succeed := ReadFile(PipeErrorsRead, Buffer, 255, NumberOfBytesRead, nil);
        if not succeed then break;
        Stream.Write(Buffer, NumberOfBytesRead);
      end;
      Stream.Position := 0;
      Errors.LoadFromStream(Stream);
    finally
      Stream.Free;
    end;
    CloseHandle(PipeErrorsRead);

    WaitForSingleObject(ProcessInfo.hProcess, INFINITE);
    CloseHandle(ProcessInfo.hProcess);
  end
  else begin
    result:=false;
    CloseHandle(PipeOutputRead);
    CloseHandle(PipeOutputWrite);
    CloseHandle(PipeErrorsRead);
    CloseHandle(PipeErrorsWrite);
  end;
end;

Habe diese Funktion eingebunden und rufe diese wie folgt auf

Delphi-Quellcode:

procedure TForm1.Button2Click(Sender: TObject);
var output, errors: TStringList;
begin
  output:=TStringList.Create;
  try
    errors:=TStringList.Create;
    if GetConsoleOutput('cmd /c dir c:\', output, errors) then
      Memo1.Lines.AddStrings(output);
  finally
    output.free;
    errors.free;
  end;
end;

Meine Fehlermeldung:
Zugriffsverletzung bei Adresse ... in Modul 'kernel32.dll'.
Schreiben von Adresse ...

Fehler tritt an folgender Stelle auf

Delphi-Quellcode:

  if CreateProcess(nil, PChar(command), nil, nil, true,
  CREATE_DEFAULT_ERROR_MODE or CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS, nil, nil,
  StartupInfo, ProcessInfo) then begin

Arbeite mit Windows7 und Delphi 2010 Prof
Habe nur den Quellcode übernommen, ich bin mir nicht sicher ober ich noch etwas einbinden oder die dll wie manch Andere ins Verzeichnis der Exe kopieren.

[DeddyH]

Das kann ich unter XE nachvollziehen, unter Delphi 2007 keine Probleme. Es ist zwar nicht doll, aber wenn Du explizit auf Ansi einstellst, dann klappt das auch unter XE. Auf die Schnelle:

Delphi-Quellcode:

function GetConsoleOutput(const Command: Ansistring; Output,
  Errors: TStringList): Boolean;
var
  StartupInfo: TStartupInfoA;
  ProcessInfo: TProcessInformation;
  SecurityAttr: TSecurityAttributes;
  PipeOutputRead: THandle;
  PipeOutputWrite: THandle;
  PipeErrorsRead: THandle;
  PipeErrorsWrite: THandle;
  Succeed: Boolean;
  Buffer: array [0..255] of AnsiChar;
  NumberOfBytesRead: DWORD;
  Stream: TMemoryStream;
begin
  //Initialisierung ProcessInfo
  FillChar(ProcessInfo, SizeOf(TProcessInformation), 0);

  //Initialisierung SecurityAttr
  FillChar(SecurityAttr, SizeOf(TSecurityAttributes), 0);
  SecurityAttr.nLength := SizeOf(SecurityAttr);
  SecurityAttr.bInheritHandle := true;
  SecurityAttr.lpSecurityDescriptor := nil;

  //Pipes erzeugen
  CreatePipe(PipeOutputRead, PipeOutputWrite, @SecurityAttr, 0);
  CreatePipe(PipeErrorsRead, PipeErrorsWrite, @SecurityAttr, 0);

  //Initialisierung StartupInfo
  FillChar(StartupInfo, SizeOf(StartupInfo), 0);
  StartupInfo.cb:=SizeOf(StartupInfo);
  StartupInfo.hStdInput := 0;
  StartupInfo.hStdOutput := PipeOutputWrite;
  StartupInfo.hStdError := PipeErrorsWrite;
  StartupInfo.wShowWindow := sw_Hide;
  StartupInfo.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;

  if CreateProcessA(nil, PAnsiChar(command), nil, nil, true,
  CREATE_DEFAULT_ERROR_MODE or CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS, nil, nil,
  StartupInfo, ProcessInfo) then begin
    result:=true;
    //Write-Pipes schließen
    CloseHandle(PipeOutputWrite);
    CloseHandle(PipeErrorsWrite);

    //Ausgabe Read-Pipe auslesen
    Stream := TMemoryStream.Create;
    try
      while true do begin
        succeed := ReadFile(PipeOutputRead, Buffer, 255, NumberOfBytesRead, nil);
        if not succeed then break;
        Stream.Write(Buffer, NumberOfBytesRead);
      end;
      Stream.Position := 0;
      Output.LoadFromStream(Stream);
    finally
      Stream.Free;
    end;
    CloseHandle(PipeOutputRead);

    //Fehler Read-Pipe auslesen
    Stream := TMemoryStream.Create;
    try
      while true do begin
        succeed := ReadFile(PipeErrorsRead, Buffer, 255, NumberOfBytesRead, nil);
        if not succeed then break;
        Stream.Write(Buffer, NumberOfBytesRead);
      end;
      Stream.Position := 0;
      Errors.LoadFromStream(Stream);
    finally
      Stream.Free;
    end;
    CloseHandle(PipeErrorsRead);

    WaitForSingleObject(ProcessInfo.hProcess, INFINITE);
    CloseHandle(ProcessInfo.hProcess);
  end
  else begin
    result:=false;
    CloseHandle(PipeOutputRead);
    CloseHandle(PipeOutputWrite);
    CloseHandle(PipeErrorsRead);
    CloseHandle(PipeErrorsWrite);
  end;
end;

Zwar nicht schön, klappt aber.

[Uwe Raabe]

MSDN sagt dazu:

Zitat:

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.

[DeddyH]

Dann scheint das MSDN wohl Recht zu haben

[jaenicke]

Sehr einfach zu fixen:

Delphi-Quellcode:

if CreateProcess(nil, PChar(command + ''), nil, nil, true,
...

Dadurch wird der String neu erzeugt und ist beschreibbar.

[Uwe Raabe]

Ein simples Weglassen des const vor Command tuts aber auch.

[DeddyH]

Hätte ich auch vermutet, stimmt aber leider nicht.

[Uwe Raabe]

Zitat von DeddyH:

Hätte ich auch vermutet, stimmt aber leider nicht.

Stimmt! Copy-on-write.

Aber ein UniqueString(Command) müsste doch gehen?

[DeddyH]

Japp, so geht' s. Ich habe die Funktion mal schnell umgeschrieben(TStringlist -> TStrings, UniqueString, etc.), Fehler vorbehalten.

Delphi-Quellcode:

function GetConsoleOutput(Command: string; Output, Errors: TStrings): Boolean;
var
  StartupInfo: TStartupInfo;
  ProcessInfo: TProcessInformation;
  SecurityAttr: TSecurityAttributes;
  PipeOutputRead: THandle;
  PipeOutputWrite: THandle;
  PipeErrorsRead: THandle;
  PipeErrorsWrite: THandle;
  Succeed: Boolean;
  Buffer: array [0 .. 255] of Char;
  NumberOfBytesRead: DWORD;
  Stream: TMemoryStream;
begin
  // Initialisierung ProcessInfo
  FillChar(ProcessInfo, SizeOf(TProcessInformation), 0);

  // Initialisierung SecurityAttr
  FillChar(SecurityAttr, SizeOf(TSecurityAttributes), 0);
  SecurityAttr.nLength := SizeOf(SecurityAttr);
  SecurityAttr.bInheritHandle := true;
  SecurityAttr.lpSecurityDescriptor := nil;

  // Pipes erzeugen
  CreatePipe(PipeOutputRead, PipeOutputWrite, @SecurityAttr, 0);
  CreatePipe(PipeErrorsRead, PipeErrorsWrite, @SecurityAttr, 0);

  // Initialisierung StartupInfo
  FillChar(StartupInfo, SizeOf(TStartupInfo), 0);
  StartupInfo.cb := SizeOf(StartupInfo);
  StartupInfo.hStdInput := 0;
  StartupInfo.hStdOutput := PipeOutputWrite;
  StartupInfo.hStdError := PipeErrorsWrite;
  StartupInfo.wShowWindow := sw_Hide;
  StartupInfo.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;

  UniqueString(Command);
  if CreateProcess(nil, PChar(Command), nil, nil, true,
    CREATE_DEFAULT_ERROR_MODE or CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS,
    nil, nil, StartupInfo, ProcessInfo) then
    begin
      result := true;
      // Write-Pipes schließen
      CloseHandle(PipeOutputWrite);
      CloseHandle(PipeErrorsWrite);

      if Assigned(Output) then
        begin
          // Ausgabe Read-Pipe auslesen
          Stream := TMemoryStream.Create;
          try
            while true do
              begin
                Succeed := ReadFile(PipeOutputRead, Buffer, 255,
                  NumberOfBytesRead, nil);
                if not Succeed then
                  break;
                Stream.Write(Buffer, NumberOfBytesRead);
              end;
            Stream.Position := 0;
            Output.LoadFromStream(Stream);
          finally
            Stream.Free;
          end;
        end;
      CloseHandle(PipeOutputRead);

      if Assigned(Errors) then
        begin
          // Fehler Read-Pipe auslesen
          Stream := TMemoryStream.Create;
          try
            while true do
              begin
                Succeed := ReadFile(PipeErrorsRead, Buffer, 255,
                  NumberOfBytesRead, nil);
                if not Succeed then
                  break;
                Stream.Write(Buffer, NumberOfBytesRead);
              end;
            Stream.Position := 0;
            Errors.LoadFromStream(Stream);
          finally
            Stream.Free;
          end;
        end;
      CloseHandle(PipeErrorsRead);

      WaitForSingleObject(ProcessInfo.hProcess, INFINITE);
      CloseHandle(ProcessInfo.hProcess);
    end
  else
    begin
      result := false;
      CloseHandle(PipeOutputRead);
      CloseHandle(PipeOutputWrite);
      CloseHandle(PipeErrorsRead);
      CloseHandle(PipeErrorsWrite);
    end;
end;

Damit kann der Aufruf vereinfacht werden:

Delphi-Quellcode:

procedure TForm1.Button1Click(Sender: TObject);
begin
  GetConsoleOutput('cmd /c dir c:\', Memo1.Lines, nil);
end;

[fuchsle]

Zitat von DeddyH:

Japp, so geht' s. Ich habe die Funktion mal schnell umgeschrieben(TStringlist -> TStrings, UniqueString, etc.), Fehler vorbehalten.

...

Damit kann der Aufruf vereinfacht werden:

Delphi-Quellcode:

procedure TForm1.Button1Click(Sender: TObject);
begin
  GetConsoleOutput('cmd /c dir c:\', Memo1.Lines, nil);
end;

Habe den Aufruf nun so modifiziert, da es Fehlermeldungen gab durch Verwendung von TStringList und TStrings.

Delphi-Quellcode:

procedure TForm1.Button2Click(Sender: TObject);
var
  SLOut, SLErr: TStringList;
  I: Integer;
begin
  SLOut := TStringList.Create;
  SLErr := TStringList.Create;
  if GetConsoleOutput('cmd /c dir c:\', SLOut, SLErr) then
  begin
    for I := 0 to SLOut.Count - 1 do
    begin
      Memo1.Lines.Add(SLOut.Strings[I]);
    end;
  end;
end;

Bin mir jedoch nicht sicher, ob es da noch eine elegantere Lösung gibt, aber es funktioniert.
Vielen Dank für die Unterstützung.