执行控制台程序并将结果返回给程序

时间:2010-02-05 17:12:35  来源:第二电脑网  作者:第二电脑网

  第二电脑网导读: />TRaConsoleRun = class(TComponent)privateFExitCode: DWORD;FCommandLine: string;FProgramName: string;FDir: string;FOnException: TOnException;FOnGetConsole: TOnGetConsole;{ Private declarations }protectedprocedure CheckResult(b: Boolean);publicconstructor Create(AOwner: TComponent...
  正文: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.lphotoshop/ target=_blank class=infotextkey>psecurityDescriptor := 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

"执行控制台程序并将结果返回给程序"由第二电脑网原创提供,转载请注明:http://www.002pc.com/master/College/Language/Delphi/12796.html


关键字:

关于《执行控制台程序并将结果返回给程序》文章的评论

站内搜索: 高级搜索

热门搜索: Windows style 系统 tr IP QQ CPU 安装 function 注册 if td