学步园

// 自己写的，绝对可用
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TShowMethod = procedure(str: string) of object;
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    Edit1: TEdit;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure ShowMethod(str: string);
  end;

  function RunCommand(const cmd: string; Show: TShowMethod = nil): string;
var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.ShowMethod(str: string);
begin
  Memo1.Lines.Add(str);
end;

function RunCommand(const cmd: string; Show: TShowMethod = nil): string;
var
  hReadPipe,hWritePipe:THandle;
  si:STARTUPINFO;
  lsa:SECURITY_ATTRIBUTES;
  pi:PROCESS_INFORMATION;
  cchReadBuffer:DWORD;
  pOutStr, pCMD:PChar;
  res, strCMD:string;
begin
  strcmd := 'cmd.exe /k ' + cmd;
  pOutStr := AllocMem(5000);
  lsa.nLength := SizeOf(SECURITY_ATTRIBUTES);
  lsa.lpSecurityDescriptor := nil;
  lsa.bInheritHandle := True;
  if not CreatePipe(hReadPipe, hWritePipe, @lsa, 0) 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;

  if not CreateProcess(nil, PChar(strCMD), nil, nil, true, 0, nil, nil, si, pi) then Exit;
  while(true) do
  begin
    if not PeekNamedPipe(hReadPipe, pOutStr, 1, @cchReadBuffer, nil, nil) then break;
    if cchReadBuffer <> 0 then
    begin
      if not ReadFile(hReadPipe, pOutStr^, 4096, cchReadBuffer, nil) then break;
      pOutStr[cchReadbuffer]:=chr(0);
      if @Show <> nil then Show(pOutStr);
      res := res + pOutStr;
    end else if(WaitForSingleObject(pi.hProcess ,0) = WAIT_OBJECT_0) then break;
    Sleep(10);
    Application.ProcessMessages;
  end;
  pOutStr[cchReadBuffer]:=chr(0);

  CloseHandle(hReadPipe);
  CloseHandle(pi.hThread);
  CloseHandle(pi.hProcess);
  CloseHandle(hWritePipe);
  FreeMem(pOutStr);
  Result := res;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  res: string;
begin
  res := RunCommand('ping 192.168.0.1', ShowMethod);
  ShowMessage(res);
end;

end.