delphi 超精简无卡顿调用dos命令输出结果

procedure CaptureConsoleOutput(const ACommand, AParameters: String; AMemo: TMemo);

const

CReadBuffer = 2400;

var

saSecurity: TSecurityAttributes;

hRead: THandle;

hWrite: THandle;

suiStartup: TStartupInfo;

piProcess: TProcessInformation;

pBuffer: array[0..CReadBuffer] of Char;

dRead: DWord;

dRunning: DWord;

inS: THandleStream;

sRet: TStrings;

begin

saSecurity.nLength := SizeOf(TSecurityAttributes);

saSecurity.bInheritHandle := True;

saSecurity.lpSecurityDescriptor := nil;

if CreatePipe(hRead, hWrite, @saSecurity, 0) then

begin

FillChar(suiStartup, SizeOf(TStartupInfo), #0);

suiStartup.cb := SizeOf(TStartupInfo);

suiStartup.hStdInput := hRead;

suiStartup.hStdOutput := hWrite;

suiStartup.hStdError := hWrite;

suiStartup.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;

suiStartup.wShowWindow := SW_HIDE;

if CreateProcess(nil, PChar(ACommand + ' ' + AParameters), @saSecurity,

@saSecurity, True, NORMAL_PRIORITY_CLASS, nil, nil, suiStartup, piProcess)

then

begin

repeat

dRunning := WaitForSingleObject(piProcess.hProcess, 100);

Application.ProcessMessages();

repeat

inS := THandleStream.Create(hRead);

if inS.Size > 0 then

begin

sRet := TStringList.Create;

sRet.LoadFromStream(inS);

AMemo.Lines.Add(sRet.Text);

sRet.Free;

end;

inS.Free;

// www.delphitop.com

until (dRead < CReadBuffer);

until (dRunning <> WAIT_TIMEOUT);

CloseHandle(piProcess.hProcess);

CloseHandle(piProcess.hThread);

end;

CloseHandle(hRead);

CloseHandle(hWrite);

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

CaptureConsoleOutput('cmd.exe /c ','ping www.baidu.com',memo1);

end;

推荐分享