Delphi执行DOS命令显示到文本框

procedure _AddInfo(mmInfo:TMemo; S: string; var line: string);

var

i, p: Integer;

begin

if mmInfo.Lines.Count > 800 then

mmInfo.Lines.Clear;

//去掉 \r

for i := 0 to Length(S) - 1 do

if S[i] = #13 then S[i] := ‘ ‘;

line := line + S;

// \n 断行

p := Pos(#10, line);

if p > 0 then

begin

// \n 前面的加入一行，后面的留到下次

mmInfo.Lines.Add(Copy(line, 1, p - 1));

line := Copy(line, p + 1, Length(line) - p);

end;

end;

var

hReadPipe, hWritePipe: THandle;

si: STARTUPINFO;

lsa: SECURITY_ATTRIBUTES;

pi: PROCESS_INFORMATION;

cchReadBuffer: DWORD;

ph: PChar;

fname: PChar;

line: string;

begin

fname := allocmem(1024);

ph := AllocMem(1024);

lsa.nLength := sizeof(SECURITY_ATTRIBUTES);

lsa.lpSecurityDescriptor := nil;

lsa.bInheritHandle := True;

if CreatePipe(hReadPipe, hWritePipe, @lsa, 0) = false then

Exit;

fillchar(si, sizeof(STARTUPINFO), 0);

si.cb := sizeof(STARTUPINFO);

si.dwFlags := (STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW);

si.wShowWindow := SW_HIDE;

si.hStdOutput := hWritePipe;

si.hStdError := hWritePipe;

StrPCopy(fname, FileName);

if CreateProcess(nil, fname, nil, nil, true, 0, nil, nil, si, pi) = False then

begin

FreeMem(ph);

FreeMem(fname);

Exit;

end;

CloseHandle(hWritePipe);

while (true) do

begin

if not PeekNamedPipe(hReadPipe, ph, 1, @cchReadBuffer, nil, nil) then break;

if cchReadBuffer <> 0 then

begin

if ReadFile(hReadPipe, ph^, 512, cchReadBuffer, nil) = false then break;

ph[cchReadbuffer] := chr(0);

_AddInfo(memo, ph, line);

end

else if (WaitForSingleObject(pi.hProcess, 0) = WAIT_OBJECT_0) then break;

Application.ProcessMessages;

Sleep(200);

end;

ph[cchReadBuffer] := chr(0);

_AddInfo(memo, ph, line);

CloseHandle(hReadPipe);

CloseHandle(pi.hThread);

CloseHandle(pi.hProcess);

FreeMem(ph);

FreeMem(fname);

end;

————————————————

调用方法（例如）：CmdExecAndView(‘ping 202.96.134.134‘,Memo1);

有个问题：如果是CmdExecAndView(‘ping 202.96.134.134 -t‘,Memo1);

执行起来会不停的输出，没办法停止，点关闭窗口的按钮没反应，只能结束任务，期待着解决这个问题。