执行命令并从与控制台进行交互

unit uConsole;

interface

uses windows;

type
TOnData = procedure(Sender: TObject; Data: String) of object;
TOnRun = procedure(Sender: TObject) of object;
TRedirectedConsole = Class(TObject)
private
fStdInRead, fStdInWrite: THandle;
fStdOutRead, fStdOutWrite: THandle;
fStdErrRead, fStdErrWrite: THandle;
fSA: TSecurityAttributes;
fPI: TProcessInformation;
fSI: TStartupInfo;
fCmdLine: String;
fOnStdOut, fOnStdErr: TOnData;
fOnRun, fOnEnd: TOnRun;
fIsRunning: Boolean;
fHidden: boolean;
fTerminate: boolean;
function ReadHandle(h: THandle; var s: string): integer;
protected
public
constructor Create(CommandLine: String);
destructor Destroy; override;
procedure Run;
procedure SendData(s: String);
property OnStdOut: TOnData read fOnStdOut write fOnStdOut;
property OnStdErr: TOnData read fOnStdErr write fOnStdErr;
property OnRun: TOnRun read fOnRun write fOnRun;
property OnEnd: TOnRun read fOnEnd write fOnEnd;
property IsRunning: boolean read fIsRunning;
property HideWindow: boolean read fHidden write fHidden;
end;

implementation

const BufSize = 1024;

constructor TRedirectedConsole.Create(CommandLine: String);
begin
inherited Create;
fCmdLine := CommandLine;
fIsRunning := False;
fHidden := True;
FillChar(fSA, SizeOf(fSA), 0);
fSA.nLength := SizeOf(fSA);
fSA.lpSecurityDescriptor := nil;
fSA.bInheritHandle := True;
CreatePipe(fStdInRead, fStdInWrite, @fSA, BufSize);
CreatePipe(fStdOutRead, fStdOutWrite, @fSA, BufSize);
CreatePipe(fStdErrRead, fStdErrWrite, @fSA, BufSize);
end;

destructor TRedirectedConsole.Destroy;
begin
if fIsRunning then
begin
fTerminate := True;
end;
CloseHandle(fStdInWrite);
CloseHandle(fStdOutRead);
CloseHandle(fStdErrRead);
inherited;
end;

function TRedirectedConsole.ReadHandle(h: THandle; var s: String): integer;
var
BytesWaiting: Cardinal;
Buf: Array[1..BufSize] of char;
{$IFDEF VER100}
BytesRead: Integer;
{$ELSE}
BytesRead: Cardinal;
{$ENDIF}
begin
Result := 0;
PeekNamedPipe(h, nil, 0, nil, @BytesWaiting, nil);
if BytesWaiting > 0 then
begin
if BytesWaiting > BufSize then
BytesWaiting := BufSize;
ReadFile(h, Buf[1], BytesWaiting, BytesRead, nil);
s := Copy(Buf, 1, BytesRead);
Result := BytesRead;
end;
end;

procedure TRedirectedConsole.SendData(s: String);
var
{$IFDEF VER100}
BytesWritten: Integer;
{$ELSE}
BytesWritten: Cardinal;
{$ENDIF}
begin
if fIsRunning then
begin
WriteFile(fStdInWrite, s[1], Length(s), BytesWritten, nil);
end;
end;

procedure TRedirectedConsole.Run;
var
s: String;
begin
fTerminate := False;
FillChar(fSI, SizeOf(fSI), 0);
fSI.cb := SizeOf(fSI);
if fHidden then
fSI.wShowWindow := SW_HIDE
else
fSI.wShowWindow := SW_SHOWDEFAULT;
fSI.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
fSI.hStdInput := fStdInRead;
fSI.hStdOutput := fStdOutWrite;
fSI.hStdError := fStdErrWrite;
if CreateProcess(nil, PChar(fCmdLine), nil, nil, True, NORMAL_PRIORITY_CLASS, nil, nil, fSI, fPI) then
begin
fIsRunning := True;
CloseHandle(fStdOutWrite);
CloseHandle(fStdErrWrite);
CloseHandle(fStdInRead);
CloseHandle(fPI.hThread);
While WaitForSingleObject(fPI.hProcess, 10) = WAIT_TIMEOUT do
begin
if fTerminate then
begin
TerminateProcess(fPi.hProcess, 0);
end;
if ReadHandle(fStdOutRead, s) > 0 then
if Assigned(fOnStdOut) then
fOnStdOut(Self, s);
if ReadHandle(fStdErrRead, s) > 0 then
if Assigned(fOnStdErr) then
fOnStdErr(Self, s);
if Assigned(fOnRun) then
fOnRun(Self);
end;
if ReadHandle(fStdOutRead, s) > 0 then
if Assigned(fOnStdOut) then
fOnStdOut(Self, s);
if ReadHandle(fStdErrRead, s) > 0 then
if Assigned(fOnStdErr) then
fOnStdErr(Self, s);
CloseHandle(fPI.hProcess);
fIsRunning := False;
if Assigned(fOnEnd) then
fOnEnd(Self);
end;
end;

end.