|
无聊时写的控件，能够直接执行控制台程序，并捕获控制台的输出到程序
未测试，是否有bug不知，如果哪位用过了，请给点意见，谢谢
unit RaConsoleRun;
interface
uses
SysUtils, Classes, windows;
type
TOnGetConsole = procedure(ConsoleText: string) of object;
TOnException = procedure(Ex: string) of object;
TRaConsoleRun = class(TComponent)
private
FExitCode: DWORD;
FCommandLine: string;
FProgramName: string;
FDir: string;
FOnException: TOnException;
FOnGetConsole: TOnGetConsole;
{ Private declarations }
protected
procedure CheckResult(b: Boolean);
public
constructor Create(AOwner: TComponent); override;
function RunProg(const Prog, CommandLine, Dir: string; var ExitCode: DWORD): string; overload;
function RunProg: string; overload;
published
property ProgramName: string read FProgramName write FProgramName;
property CommandLine: string read FCommandLine write FCommandLine;
property Dir: string read FDir write FDir;
property ExitCode: DWORD read FExitCode;
property OnGetConsole: TOnGetConsole read FOnGetConsole write FOnGetConsole;
property OnException: TOnException read FOnException write FOnException;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Rarnu Components', [TRaConsoleRun]);
end;
{ TRaConsoleRun }
procedure TRaConsoleRun.CheckResult(b: Boolean);
begin
if not b then
if Assigned(OnException) then
OnException(SysErrorMessage(GetLastError))
else
raise Exception.Create(SysErrorMessage(GetLastError));
end;
constructor TRaConsoleRun.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FExitCode := 0;
FCommandLine := '';
FProgramName := '';
FDir := '';
end;
function TRaConsoleRun.RunProg(const Prog, CommandLine, Dir: string;
var ExitCode: DWORD): string;
var
hread, hwrite: THandle;
StartInfo: TStartupInfo;
ProceInfo: TProcessInformation;
b: Boolean;
sa: TSecurityAttributes;
inS: THandleStream;
sRet: TStrings;
begin
Result := '';
FillChar(sa, SizeOf(sa), 0);
//设置允许继承，否则在NT和2000下无法取得输出结果
sa.nLength := SizeOf(sa);
sa.bInheritHandle := True;
sa.lpSecurityDescriptor := nil;
b := CreatePipe(hread, hwrite, @sa, 0);
CheckResult(b);
FillChar(StartInfo, SizeOf(StartInfo), 0);
StartInfo.cb := SizeOf(StartInfo);
StartInfo.wShowWindow := SW_HIDE;
//使用指定的句柄作为标准输入输出的文件句柄,使用指定的显示方式
StartInfo.dwFlags := STARTF_USESTDHANDLES + STARTF_USESHOWWINDOW;
StartInfo.hStdError := hwrite;
StartInfo.hStdInput := GetStdHandle(STD_INPUT_HANDLE); //HRead;
StartInfo.hStdOutput := hwrite;
b := CreateProcess(PChar(Prog), //lpApplicationName: PChar
PChar(CommandLine), //lpCommandLine: PChar
nil, //lpProcessAttributes: PSecurityAttributes
nil, //lpThreadAttributes: PSecurityAttributes
True, //bInheritHandles: BOOL
CREATE_NEW_CONSOLE,
nil,
PChar(Dir),
StartInfo,
ProceInfo);
CheckResult(b);
WaitForSingleObject(ProceInfo.hProcess, INFINITE);
GetExitCodeProcess(ProceInfo.hProcess, ExitCode);
inS := THandleStream.Create(hread);
if inS.Size > 0 then
begin
sRet := TStringList.Create;
sRet.LoadFromStream(inS);
Result := sRet.Text;
sRet.Free;
end;
inS.Free;
FExitCode := ExitCode;
CloseHandle(hread);
CloseHandle(hwrite);
if Assigned(OnGetConsole) then
OnGetConsole(Result);
end;
function TRaConsoleRun.RunProg: string;
begin
Result := RunProg(FProgramName, FCommandLine, FDir, FExitCode);
end;
end.
|
|