cmd fenster

[technik05]

so habe ich es gemacht ! bestimmt alles falsch oder

[delphi]
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(Cons oleStr));
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.

[pre][/pre][pre]

Code:

[dp][size=8][center][/size][size=24][cl][/dp]

[/pre]