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

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

2007-11-24 22:03

procedure CmdExecAndView(FileName: string; memo: TMemo);

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);

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

http://blog.csdn.net/shao9900/article/details/43951633