Einzelnen Beitrag anzeigen

Photoner

Registriert seit: 6. Dez 2012
Ort: Nürnberg
103 Beiträge
 
Delphi 10.1 Berlin Starter
 
#1

Kommando chcp mit CreateProcess ausführen

  Alt 4. Apr 2016, 14:42
Hi,

Ich habe gerade ein Problem das Codepages betrifft. Weil das Kommando "chcp" in einer von Hand geöffneten Konsole etwas anderes angibt als die Funktion GetACP war ich eine ganze Weile auf der falschen Fährte. Ich wollte das auch einmal parallel in einer Konsole sehen und habe dafür eine kleine Anwendung zusammengesteckt. Ich komme aber nicht darauf, warum diese keine richtige Ausgabe für das Kommando "chcp" liefert. Habt ihr eine Idee?

Der Code:

Die Funktion function GetConsoleOutput(Command : string;Output, Errors : TStringList) : Boolean; ist von Delphitreff.de.

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

  //Initialisierung SecurityAttr
  FillChar(SecurityAttr, SizeOf(TSecurityAttributes), 0);
  SecurityAttr.nLength := SizeOf(TSecurityAttributes);
  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(TStartupInfo);
  StartupInfo.hStdInput := 0;
  StartupInfo.hStdOutput := PipeOutputWrite;
  StartupInfo.hStdError := PipeErrorsWrite;
  StartupInfo.wShowWindow := SW_HIDE;
  StartupInfo.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;

  CreationFlags := CREATE_DEFAULT_ERROR_MODE or
                   CREATE_NEW_CONSOLE or
                   NORMAL_PRIORITY_CLASS;

  // Folgende Zeile ist nur für Delphi ab 2009 erforderlich:
{$IF System.CompilerVersion>=12}
  UniqueString(Command);
{$ENDIF}

  if CreateProcess(nil,
                   PChar(Command),
                   nil,
                   nil,
                   True,
                   CreationFlags,
                   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 ReadFile(PipeOutputRead, Buffer, 255, NumberOfBytesRead, nil) do
      begin
        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 ReadFile(PipeErrorsRead, Buffer, 255, NumberOfBytesRead, nil) do
      begin
        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;
Link dazu:
http://www.delphi-treff.de/tipps-tri...ramm-anzeigen/

Delphi-Quellcode:
program KonsolenTest;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  System.SysUtils,
  WinAPI.Windows,
  System.Classes,
  Console in 'Console.pas'; //für Funktion GetConsoleOutput

var
  outp : TStringList;
  err : TStringList;
  line : String;
begin
  outp := TStringList.Create;
  err := TStringList.Create;
  try
    try
      { TODO -oUser -cConsole Main : Code hier einfügen }
      WriteLn('GetACP Result:');
      WriteLn(IntToStr(GetACP));
      WriteLn('"cmd chcp" with CreateProcess:');
      if GetConsoleOutput('cmd chcp',outp,err) then
      begin
        WriteLn('OutPut:');
        Writeln(outp.Text);
        WriteLn('Errors:');
        Writeln(err.Text);
      end
      else
        Writeln('CreateProcess failed');
    except
      on E: Exception do
        Writeln(E.ClassName, ': ', E.Message);
    end;
    ReadLn(line);
  finally
    outp.Free;
    err.Free;
  end;
end.
Ergebnis ist nur der Standardtext (Windows Version + Copyright + Pfad):

Microsoft Windows [Version 6.1.7601]
Copyright (c) 2009 Microsoft Corporation. Alle Rechte vorbehalten.

<aktueller Pfad == Pfad zu Konsolentest.exe>
Chris
  Mit Zitat antworten Zitat