运行dos命令，并查看返回结果

方法一：

 

//1，声明变量

var
  CreateOk:     Boolean;
  hReadPipe,     hWritePipe,     hWriteFile,     hReadFile:     THandle;
  processinfo:     PROCESS_INFORMATION;
  function SendCmdToShell(const CmdStr: String):tstrings;
//2，初始化
procedure TForm0.iniClick(Sender: TObject);
var
  Pipeattr: SECURITY_ATTRIBUTES;
  ShellStartInfo: STARTUPINFO; 
  shellstr: array [0..256] of char; 
  RBuffer: array[0..25000] of char;
  I: Integer; 
  nByteReaden: DWORD; 
begin 
  CreateOK := False; //ok
  I := 0; 
//  memo1.ReadOnly := False;//  Wpos.X := 0;
//  WPos.Y := 0;
  with Pipeattr do
  begin 
      nLength := Sizeof(SECURITY_ATTRIBUTES);
      lpSecurityDescriptor := nil; 
      bInheritHandle := true; 
  end; 
  
  if CreatePipe(hReadPipe, hWriteFile, @Pipeattr, 0) then
    Inc(i);
  if CreatePipe(hReadFile, hWritePipe, @pipeattr, 0) then 
    Inc(i); 
  
  GetStartupInfo(ShellStartInfo);
  with ShellStartInfo do 
  begin 
    dwFlags     := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
    hStdInput   := hReadPipe;
    hStdError   := hWritePipe;
    hStdOutput  := hWritePipe;
    wShowWindow := SW_HIDE;
  end;  GetSystemDirectory(@Shellstr, MAX_PATH+1);
  StrCat(@ShellStr, Pchar( '\\cmd.exe '));  if CreateProcess(Shellstr, nil, nil, nil, True, 0,nil, nil, ShellStartInfo, processinfo) then
  begin
    Inc(i);
  end
  else
  begin
    MessageBox(Handle, Pchar( '调用Shell错误！ '), Pchar( '错误 '), (MB_OK or MB_ICONERROR));
  end;  if i = 3 then 
  begin 
    CreateOK := True; //ok
//    memo1.Lines.Clear;    sleep(250);
    ReadFile(hReadFile, RBuffer, 25000, nByteReaden, nil);
//    memo1.Lines.Add(StrPas(RBuffer));//    WPos.Y := memo1.Lines.Count-1;
//
//    WPos.X := Length(memo1.Lines[WPos.Y])-1;  end;
end;
//3，执行

function TForm0.SendCmdToShell(const CmdStr: String):tstrings;
var
  ShellCmdStr: array[0..256] of char;
  RBuffer: array[0..25000] of char;
  nByteToWrite: DWORD;
  nByteWritten: DWORD;
  nByteReaden: DWORD;
begin
//  if CreateOK then
  begin
    StrPCopy(ShellCmdStr, CmdStr);
    nByteToWrite := StrLen(ShellCmdStr);
    ShellCmdStr[nByteToWrite] := #13;
    ShellCmdStr[nByteToWrite+1] := #10;
        ShellCmdStr[nByteToWrite+2] := #0;
    Inc(nByteToWrite, 2);
    WriteFile(hWriteFile, ShellCmdStr, nByteToWrite, nByteWritten, nil);
    Sleep(1100);
//    memo1.Lines.Clear;
    result := tstringlist.Create ;
    FillChar(RBuffer, Sizeof(RBuffer), #0);
    ReadFile(hReadFile, RBuffer, 25000, nByteReaden, nil);
    result.Add(StrPas(RBuffer));
//    memo1.Lines.Add(StrPas(RBuffer));
//    WPos.Y := memo1.Lines.Count-1;
//    WPos.X := Length(memo1.Lines[WPos.Y])-1;
  end;
end;

//4，释放

procedure TForm0.btnendClick(Sender: TObject);
var
  shellexitcode: Cardinal;
begin
  if GetExitCodeProcess(processinfo.hProcess, shellexitcode) then
  begin
    if shellexitcode = STILL_ACTIVE then
      TerminateProcess(processinfo.hProcess, 0);
  end;

  if hWriteFile <> 0 then
    CloseHandle(hWriteFile);
  if hReadFile <> 0 then
    CloseHandle(hReadFile);
end;

//5，举例

procedure TForm0.ButtondoClick(Sender: TObject);
begin
  self.Memo1.Lines.Assign(  SendCmdToShell(self.Edit1.Text)   ) ;
end;

 

==================================================================================================

(*
procedure CheckResult(b: Boolean);
begin
  if not b then
    raise Exception.Create(SysErrorMessage(GetLastError));
end;

function RunDOS(const Prog, CommandLine, Dir: string; var ExitCode: DWORD): string;
var
  HRead, HWrite: THandle;
  StartInfo: TStartupInfo;
  ProceInfo: TProcessInformation;
  b: Boolean;
  sa: TSecurityAttributes;
  inS: THandleStream;
  sRet: TStrings;
begin
  Result := '';
  FillChar(sa, sizeof(sa), 0);
      //设置允许继承，否则在NT和2000下无法取得输出结果
  sa.nLength := sizeof(sa);
  sa.bInheritHandle := True;
  sa.lpSecurityDescriptor := nil;
  b := CreatePipe(HRead, HWrite, @sa, 0);
  CheckResult(b);
  FillChar(StartInfo, SizeOf(StartInfo), 0);
  StartInfo.cb := SizeOf(StartInfo);
  StartInfo.wShowWindow := SW_HIDE;
      //使用指定的句柄作为标准输入输出的文件句柄,使用指定的显示方式
  StartInfo.dwFlags := STARTF_USESTDHANDLES + STARTF_USESHOWWINDOW;
  StartInfo.hStdError := HWrite;
  StartInfo.hStdInput := GetStdHandle(STD_INPUT_HANDLE); //HRead;
  StartInfo.hStdOutput := HWrite;
  b := CreateProcess(PChar(Prog), //lpApplicationName:   PChar
    PChar(CommandLine), //lpCommandLine:   PChar
    nil, //lpProcessAttributes:   PSecurityAttributes
    nil, //lpThreadAttributes:   PSecurityAttributes
    True, //bInheritHandles:   BOOL
    CREATE_NEW_CONSOLE,
    nil,
    PChar(Dir),
    StartInfo,
    ProceInfo);
  CheckResult(b);
  WaitForSingleObject(ProceInfo.hProcess, INFINITE);
  GetExitCodeProcess(ProceInfo.hProcess, ExitCode);
  inS := THandleStream.Create(HRead);
  if inS.Size > 0 then
  begin
    sRet := TStringList.Create;
    sRet.LoadFromStream(inS);
    Result := sRet.Text;
    sRet.Free;
  end;
  inS.Free;
  CloseHandle(HRead);
  CloseHandle(HWrite);
end;

function GetDosOutput(const CommandLine: string): string;
var
  SA: TSecurityAttributes;
  SI: TStartupInfo;
  PI: TProcessInformation;
  StdOutPipeRead, StdOutPipeWrite: THandle;
  WasOK: Boolean;
  Buffer: array[0..255] of Char;
  BytesRead: Cardinal;
  WorkDir, Line: string;
begin
  Application.ProcessMessages;
  with SA do
  begin
    nLength := SizeOf(SA);
    bInheritHandle := True;
    lpSecurityDescriptor := nil;
  end;
  //   create   pipe   for   standard   output   redirection
  CreatePipe(StdOutPipeRead, //   read   handle
    StdOutPipeWrite, //   write   handle
    @SA, //   security   attributes
    0 //   number   of   bytes   reserved   for   pipe   -   0   default
    );
  try
  //   Make   child   process   use   StdOutPipeWrite   as   standard   out,
  //   and   make   sure   it   does   not   show   on   screen.
    with SI do
    begin
      FillChar(SI, SizeOf(SI), 0);
      cb := SizeOf(SI);
      dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
      wShowWindow := SW_HIDE;
      hStdInput := GetStdHandle(STD_INPUT_HANDLE); //   don't   redirect   stdinput
      hStdOutput := StdOutPipeWrite;
      hStdError := StdOutPipeWrite;
    end;
    //   launch   the   command   line   compiler
    WorkDir := ExtractFilePath(CommandLine);
    WasOK := CreateProcess(nil, PChar(CommandLine), nil, nil, True, 0, nil,
      PChar(WorkDir), SI, PI);
      //   Now   that   the   handle   has   been   inherited,   close   write   to   be   safe.
      //   We   don't   want   to   read   or   write   to   it   accidentally.
    CloseHandle(StdOutPipeWrite);
    //   if   process   could   be   created   then   handle   its   output
    if not WasOK then
      raise Exception.Create('Could   not   execute   command   line!')
    else
    try
    //   get   all   output   until   dos   app   finishes
      Line := '';
      repeat
        //   read   block   of   characters   (might   contain   carriage   returns   and   line   feeds)
        WasOK := ReadFile(StdOutPipeRead, Buffer, 255, BytesRead, nil);
        //   has   anything   been   read?
        if BytesRead > 0 then
        begin
          //   finish   buffer   to   PChar
          Buffer[BytesRead] := #0;
          //   combine   the   buffer   with   the   rest   of   the   last   run
          Line := Line + Buffer;
        end;
      until not WasOK or (BytesRead = 0);
      //   wait   for   console   app   to   finish   (should   be   already   at   this   point)
      WaitForSingleObject(PI.hProcess, INFINITE);
    finally
      //   Close   all   remaining   handles
      CloseHandle(PI.hThread);
      CloseHandle(PI.hProcess);
    end;
  finally
    result := Line;
    CloseHandle(StdOutPipeRead);
  end;
end;

  *)

//==============================================================================

 

方法三：

 

 

procedure TForm0.Button12Click(Sender: TObject);
var
  hReadPipe, hWritePipe: THandle;
  si: STARTUPINFO;
  lsa: SECURITY_ATTRIBUTES;
  pi: PROCESS_INFORMATION;
  cchReadBuffer: DWORD;
  ph: PChar;
  fname: PChar;
begin
  fname := allocmem(255);
  ph := AllocMem(5000);
  lsa.nLength := sizeof(SECURITY_ATTRIBUTES);
  lsa.lpSecurityDescriptor := nil;
  lsa.bInheritHandle := True;
  if CreatePipe(hReadPipe, hWritePipe, @lsa, 0) = false then
  begin
    ShowMessage('Can   not   create   pipe!');
    exit;
  end;
  fillchar(si, sizeof(STARTUPINFO), 0);
  si.cb := sizeof(STARTUPINFO);
  si.dwFlags := (STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW);
  si.wShowWindow := SW_SHOW;
  si.hStdOutput := hWritePipe;
  StrPCopy(fname, Edit1.text);
  if CreateProcess(nil, fname, nil, nil, true, 0, nil, nil, si, pi) = False then
  begin
    ShowMessage('can   not   create   process');
    FreeMem(ph);
    FreeMem(fname);
    Exit;
  end;
  while (true) do
  begin
    if not PeekNamedPipe(hReadPipe, ph, 1, @cchReadBuffer, nil, nil) then break;
    if cchReadBuffer <> 0 then
    begin
      if ReadFile(hReadPipe, ph^, 4096, cchReadBuffer, nil) = false then break;
      ph[cchReadbuffer] := chr(0);
      Memo1.Lines.Add(ph);// 在memo中显示输出
    end
    else if (WaitForSingleObject(pi.hProcess, 0) = WAIT_OBJECT_0) then break;
    Sleep(100);
  end;
  ph[cchReadBuffer] := chr(0);
  Memo1.Lines.Add(ph);   // 在memo中显示输出
  CloseHandle(hReadPipe);
  CloseHandle(pi.hThread);
  CloseHandle(pi.hProcess);
  CloseHandle(hWritePipe);
  FreeMem(ph);
  FreeMem(fname);
end;