unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, ShellAPI, ComCtrls;
type
TForm1 =
class(TForm)
Memo1: TMemo;
Button2: TButton;
Panel1: TPanel;
Edit1: TEdit;
Label13: TLabel;
Button1: TButton;
Label15: TLabel;
procedure Button2Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure FormShow(Sender: TObject);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
//-----------------------------------------------------------------------------
procedure TForm1.Button1Click(Sender: TObject);
begin Application.terminate;
end;
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;
//C:\Windows\System32\
function GetSystemDir:
string;
var Dir:
string; Len: DWord;
begin
SetLength(Dir,MAX_PATH);
Len:=GetSystemDirectory(PChar(Dir),MAX_PATH);
if Len>0
then begin SetLength(Dir,Len); Result:=Dir;
end
else RaiseLastOSError;
end;
procedure TForm1.Button2Click(Sender: TObject);
var
Output : TStringList;
Errors : TStringList;
p : ANSIString;
SAnsi: AnsiString;
begin
p:=ExtractFilePath(Application.ExeName);
Memo1.clear;
Output := TStringList.Create;
Errors := TStringList.Create;
try
if GetConsoleOutput(GetSystemDir +'
\ping.exe '+Edit1.text, Output, Errors)
then
Memo1.Lines.AddStrings(Output);
SAnsi := AnsiString(Memo1.Text);
OemToCharBuffA(PAnsiChar(SAnsi), PAnsiChar(SAnsi), Length(SAnsi));
Memo1.Text :=
String(SAnsi);
finally
Output.free;
Errors.free;
end;
end;
procedure TForm1.FormShow(Sender: TObject);
begin
Button2.Click;
end;
end.