捕获控制台输出信息

启动DOS或者控制台程序，如何捕获运行时的输出信息？

比如，在dos窗口下，输入dir捕获文件夹列表信息？

有两篇文章已经说明了这个问题：

http://www.delphi3000.com/articles/article_2112.asp
http://www.delphi3000.com/articles/article_2298.asp
但是，他们都是在进程结束之后才获取输出信息

这样会有一些问题:

1）createPipe必须制定足够的size，否则，程序会死掉

2）如果程序createProcess成功，但是内部命令出错，会导致readfile时死掉

Microsoft Knowledge Base Article - Q190351
HOWTO: Spawn Console Processes with Redirected Standard Handles
http://support.microsoft.com/default.aspx?scid=kb;en-us;Q190351

Microsoft Knowledge Base Article - Q150956
INFO: Redirection Issues on Windows 95 MS-DOS Applications
http://support.microsoft.com/default.aspx?scid=KB;EN-US;Q150956

基本的思想是用CreateProcess启动一个控制台程序，把输入和输出用管道重定向，

允许调用进程访问控制台程序的输出信息

在进程依然运行中捕获输出时非常重要的，如果输出管道发生溢出，就会被阻止，

控制台程序就不能够将新的信息就覆盖到输出管道，并且导致程序停止，这种情况下

会锁死的：父进程等待子进程结束，而子进程等待父进程清空缓冲区

具体的实现如下：

procedure CaptureConsoleOutput(DosApp : string;AMemo : TMemo);
const
  ReadBuffer = 1048576;  // 1 MB Buffer
var
  Security            : TSecurityAttributes;
  ReadPipe,WritePipe  : THandle;
  start               : TStartUpInfo;
  ProcessInfo         : TProcessInformation;
  Buffer              : Pchar;
  TotalBytesRead,
  BytesRead           : DWORD;
  Apprunning,n,
  BytesLeftThisMessage,
  TotalBytesAvail : integer;
begin
  with Security do
  begin
    nlength              := SizeOf(TSecurityAttributes);
    binherithandle       := true;
    lpsecuritydescriptor := nil;
  end;

  if CreatePipe (ReadPipe, WritePipe, @Security, 0) then
  begin
    // Redirect In- and Output through STARTUPINFO structure

    Buffer  := AllocMem(ReadBuffer + 1);
    FillChar(Start,Sizeof(Start),#0);
    start.cb          := SizeOf(start);
    start.hStdOutput  := WritePipe;
    start.hStdInput   := ReadPipe;
    start.hStdError   := WritePipe; //控制台错误信息也输出
    start.dwFlags     := STARTF_USESTDHANDLES + STARTF_USESHOWWINDOW;
    start.wShowWindow := SW_HIDE;

    // Create a Console Child Process with redirected input and output

    if CreateProcess(nil      ,PChar(DosApp),
                     @Security,@Security,
                     true     ,CREATE_NO_WINDOW or NORMAL_PRIORITY_CLASS,
                     nil      ,nil,
                     start    ,ProcessInfo) then
    begin
      n:=0;
      TotalBytesRead:=0;
      repeat
        // Increase counter to prevent an endless loop if the process is dead
        Inc(n,1);
        
        // wait for end of child process
        Apprunning := WaitForSingleObject(ProcessInfo.hProcess,100);
        Application.ProcessMessages;

        // it is important to read from time to time the output information
        // so that the pipe is not blocked by an overflow. New information
        // can be written from the console app to the pipe only if there is
        // enough buffer space.

        if not PeekNamedPipe(ReadPipe        ,@Buffer[TotalBytesRead],
                             ReadBuffer      ,@BytesRead,
                             @TotalBytesAvail,@BytesLeftThisMessage) then break
        else if BytesRead > 0 then
          ReadFile(ReadPipe,Buffer[TotalBytesRead],BytesRead,BytesRead,nil);
        TotalBytesRead:=TotalBytesRead+BytesRead;
      until (Apprunning <> WAIT_TIMEOUT) or (n > 150);

      Buffer[TotalBytesRead]:= #0;
      OemToChar(Buffer,Buffer);
      AMemo.Text := AMemo.text + StrPas(Buffer);
    end;
    FreeMem(Buffer);
    CloseHandle(ProcessInfo.hProcess);
    CloseHandle(ProcessInfo.hThread);
    CloseHandle(ReadPipe);
    CloseHandle(WritePipe);
  end;
end; 

摘自http://www.delphi3000.com/articles/article_3361.asp