运行Dos命令并得到dos的输出文本（使用管道函数CreatePipe和PeekNamedPipe）

function RunDOS(const CommandLine: string): 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);
  Assert(b);

FillChar(StartInfo, SizeOf(StartInfo), 0);
  StartInfo.cb := SizeOf(StartInfo);
  StartInfo.wShowWindow := SW_HIDE;
//使用指定的句柄作为标准输入输出的文件句柄,使用指定的显示方式
  StartInfo.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
  StartInfo.hStdError := HWrite;
  StartInfo.hStdInput := GetStdHandle(STD_INPUT_HANDLE); //HRead;
  StartInfo.hStdOutput := HWrite;
 
  b := CreateProcess(nil, //lpApplicationName: PChar
    PChar(CommandLine), //lpCommandLine: PChar
    nil, //lpProcessAttributes: PSecurityAttributes
    nil, //lpThreadAttributes: PSecurityAttributes
    True, //bInheritHandles: BOOL
    CREATE_NEW_CONSOLE,
    nil,
    nil,
    StartInfo,
    ProceInfo);
 
  Assert(b);
  WaitForSingleObject(ProceInfo.hProcess, INFINITE);

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;

这个函数在长时间运行dos命令时，会发生无法退出的问题，因此需要另一个实现版本：

function GetDosOutput(Command: string): string;
var
hReadPipe : THandle;
hWritePipe : THandle;
SI : TStartUpInfo;
PI : TProcessInformation;
SA : TSecurityAttributes;
BytesRead : DWORD;
Dest : array[0..32767] of char;
CmdLine : array[0..512] of char;
Avail, ExitCode, wrResult : DWORD;
osVer : TOSVERSIONINFO;
tmpstr :AnsiString;
Line: String;
begin
osVer.dwOSVersionInfoSize := Sizeof(TOSVERSIONINFO);
GetVersionEX(osVer);
if osVer.dwPlatformId = VER_PLATFORM_WIN32_NT then
begin
    SA.nLength := SizeOf(SA);
    SA.lpSecurityDescriptor := nil;
    SA.bInheritHandle := True;
    CreatePipe(hReadPipe, hWritePipe, @SA, 0);
end
else
    CreatePipe(hReadPipe, hWritePipe, nil, 1024);
try
    FillChar(SI, SizeOf(SI), 0);
    SI.cb := SizeOf(TStartUpInfo);
    SI.wShowWindow := SW_HIDE;
    SI.dwFlags := STARTF_USESHOWWINDOW;
    SI.dwFlags := SI.dwFlags or STARTF_USESTDHANDLES;
    SI.hStdOutput := hWritePipe;
    SI.hStdError := hWritePipe;
    StrPCopy(CmdLine, Command);
    if CreateProcess(nil, CmdLine, nil, nil, True, NORMAL_PRIORITY_CLASS, nil, nil, SI, PI) then
    begin
       ExitCode := 0;
       while ExitCode = 0 do
       begin
          wrResult := WaitForSingleObject(PI.hProcess, 1000);
          if PeekNamedPipe(hReadPipe, @Dest[0], 32768, @Avail, nil, nil) then
          begin
             if Avail > 0 then
             begin
               try
                 FillChar(Dest, SizeOf(Dest), 0);
                 ReadFile(hReadPipe, Dest[0], Avail, BytesRead, nil);
                 TmpStr := Copy(Dest,0 , BytesRead-1);
                 Line:=Line+TmpStr; 
               Except
               end;
             end;
          end;
            if wrResult <> WAIT_TIMEOUT then ExitCode := 1;
       end;
       GetExitCodeProcess(PI.hProcess, ExitCode);
       CloseHandle(PI.hProcess);
       CloseHandle(PI.hThread);
     end;
     finally
       if line='' then line:='NULL';    //命令没有输出回应!
       result:=Line;
       CloseHandle(hReadPipe);
       CloseHandle(hWritePipe);
   end;
end;

http://blog.****.net/henreash/article/details/7095744