///<summary>创建一个进程并读取其控制台输出内容</summary>
///<param name="AFileName">要执行的文件的完整路径</param>
///<param name="AParams">要执行的文件命令行参数</param>
///<param name="AOutputs">控制台内容输出目标</param>
///<param name="APath">程序运行的当前目录,默认为 AFileName 文件所在的目录</param>
///<param name="AExitCode">程序退出代码</param>
///<returns>创建进程成功,返回 true,否则返回 false</returns>
function DosCommand(AFileName, AParams: String; AOutputs: TStrings;
APath: String = '';AExitCode:PDWORD=nil): Boolean;
var
sa: SECURITY_ATTRIBUTES;
si: STARTUPINFO;
pi: PROCESS_INFORMATION;
hRead, hWrite: THandle;
buffer: array [0 .. 4095] of Byte;
bytesRead, bytesToRead: DWORD;
TotalBytesAvail: DWORD;
AStream: TBytesStream;
AEncoding: TEncoding;
ACode:DWORD;
begin
sa.nLength := sizeof(SECURITY_ATTRIBUTES);
sa.lpSecurityDescriptor := nil; // 使用系统默认的安全描述符
sa.bInheritHandle := true; // 创建的进程继承句柄
if not CreatePipe(hRead, hWrite, @sa, 0) then // 创建匿名管道
begin
Result := false;
if Assigned(AOutputs) then
AOutputs.Add(Format('匿名管道创建失败(%d):%s', [GetLastError(),
SysErrorMessage(GetLastError())]));
Exit;
end;
AStream := TBytesStream.Create;
try
FillChar(si, sizeof(si), 0);
si.cb := sizeof(STARTUPINFO);
GetStartupInfo(si);
si.hStdError := hWrite;
si.hStdOutput := hWrite; // 新创建进程的标准输出连在写管道一端
si.wShowWindow := SW_HIDE; // 隐藏窗口
si.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
if Length(APath) > 0 then
SetCurrentDirectory(PChar(APath))
else
APath:=ExtractFilePath(AFileName);
if not CreateProcess(nil, PChar(AnsiQuotedStr(AFileName,'"')+' '+AParams), nil, nil, true, CREATE_NEW_CONSOLE,
nil, PChar(APath), si, pi) then
begin
Result := false;
if Assigned(AOutputs) then
AOutputs.Add(Format('进程创建失败(%d):%s', [GetLastError(),
SysErrorMessage(GetLastError())]));
Exit;
end;
ACode:=0;
while PeekNamedPipe(hRead, nil, 0, nil, @TotalBytesAvail, nil) do
begin
if TotalBytesAvail > 4096 then
TotalBytesAvail := 4096;
if TotalBytesAvail > 0 then
begin
if ReadFile(hRead, buffer, TotalBytesAvail, bytesRead, nil) then
begin
AStream.WriteBuffer(buffer, TotalBytesAvail);
//如果要即时输出命令行内容,就应该在此尝试解析并加入到AOutputs中,此处默认不着急
end
else
break;
end
else if GetExitCodeProcess(pi.hProcess, ACode) then
begin
if ACode=STILL_ACTIVE then
Sleep(50)
else
break
end
else
break;
end;
if Assigned(AOutputs) and (AStream.Size>0) then
begin
AEncoding:=nil;
TEncoding.GetBufferEncoding(AStream.Bytes, AEncoding,TEncoding.ANSI);
AOutputs.Text := AEncoding.GetString(AStream.Bytes, 0, AStream.Size);
end;
ACode:=0;
if GetExitCodeProcess(pi.hProcess, ACode) then
begin
Result := ACode = 0;
if Assigned(AExitCode) then
AExitCode^:=ACode;
end
else
Result := false;
finally
CloseHandle(hWrite);
CloseHandle(hRead);
FreeAndNil(AStream);
end;
end;
示例
procedure TForm1.Button1Click(Sender: TObject);
var
AResult: TStringList;
begin
AResult := TStringList.Create;
try
DosCommand('C:\Windows\System32\cmd.exe', '/C dir/w', Memo1.Lines, 'c:\');
finally
FreeAndNil(AResult);
end;
end;
运行结果
