Delphi-PRAXiS - cmd fenster

Delphi-Quellcode:
			unit Unit1;

interface

uses

  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

  StdCtrls;

type

  TForm1 = class(TForm)

    Button1: TButton;

    Memo1: TMemo;

    procedure Button1Click(Sender: TObject);

    procedure Memo1Change(Sender: TObject);

  private

    { Private-Deklarationen }

  public

    { Public-Deklarationen }

  end;

var

  Form1: TForm1;

implementation

{$R *.DFM}

    function GetConsoleOutput(const Command: String; var 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;

procedure TForm1.Button1Click(Sender: TObject);

begin

var   Output,

      Errors          : TStringList;

      CmdInterpreter,

      Command         : String;

  function IsWindowsNT:Boolean;

  begin

    Result:=(Win32Platform=Ver_Platform_Win32_NT);

  end;

  function ConsoleStr2AnsiStr(ConsoleStr:String):String;

  var Buffer : pChar;

  begin

    Result:=ConsoleStr;

    GetMem(Buffer,length(ConsoleStr)+1);

    try

      OEMToCharBuff(pChar(ConsoleStr),Buffer,length(ConsoleStr));

      SetString    (Result,Buffer,length(ConsoleStr));

    finally

      FreeMem(Buffer,length(ConsoleStr)+1);

end;

procedure TForm1.Memo1Change(Sender: TObject);

begin

Memo1.Clear;

  Command:='dir c:\'; // <<< hier DEINEN BatchAufruf placieren!!!!!!

  if IsWindowsNT then CmdInterpreter:='cmd'

                 else CmdInterpreter:='command';

  Output:=TStringList.Create;

  try

    Errors:=TStringList.Create;

    if GetConsoleOutput(CmdInterpreter+' /c '+Command,Output,Errors) then begin

      Memo1.Lines.AddStrings(Output);

      Memo1.Text:=ConsoleStr2AnsiStr(Memo1.Text);

      end

  finally

    Output.Free;

    Errors.Free;

end;

end.
test