unit uConsole;
interface
uses windows, SysUtils;
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;
fpath: 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, path: string);
destructor Destroy;
override;
function Run: integer;
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, path: string);
begin
inherited Create;
fCmdLine := CommandLine;
fIsRunning := False;
fHidden := True;
fpath := path;
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;
function TRedirectedConsole.Run: integer;
var
s: string;
code: Dword;
ppath: pchar;
begin
result := -1;
fTerminate := False;
FillChar(fSI, SizeOf(fSI), 0);
fSI.cb := SizeOf(fSI);
//fHidden := false;
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;
}
ppath := nil;
if fpath = '' then
else
begin
//getmem(ppath,length(fpath)+1);
//strpcopy(ppath,fpath);
//getmem(ppath,4);
//strpcopy(ppath,'c:/');
end;
if CreateProcess(nil, // 模块名或执行文件名
PChar(fCmdLine), // 参数
nil, // 安全属性
nil, // 安全属性
True, // 安全属性继承性
NORMAL_PRIORITY_CLASS, // 线程优先等级
nil, // 环境块
ppath, // 当前路径
fSI, // 启动信息
fPI // 过程信息
) then
begin
fIsRunning := True;
CloseHandle(fStdOutWrite);
CloseHandle(fStdErrWrite);
CloseHandle(fStdInRead);
CloseHandle(fPI.hThread);
while WaitForSingleObject(fPI.hProcess, 10) = WAIT_TIMEOUTdo
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 GetExitCodeProcess(fpi.hProcess, code) then
result := code;
CloseHandle(fPI.hProcess);
fIsRunning := False;
end;
end;
end.