0

我有一个外部控制台应用程序，我想将它的完整输出（StdOut 和 StdError）实时捕获到备忘录中（就像我双击它一样）。

带有屏幕截图的应用程序信息： Delphi 控制台管道已切换？

我写了一个单元来读取管道：

unit uConsoleOutput;
interface

uses  Classes,
      StdCtrls,
      SysUtils,
      Messages,
      Windows;

  type
  ConsoleThread = class(TThread)
  private
    OutputString : String;
    procedure SetOutput;
  protected
    procedure Execute; override;
  public
    App           : WideString;
    Memo          : TMemo;
    Directory     : WideString;
  end;

  type
    PConsoleData = ^ConsoleData;
    ConsoleData = record
    OutputMemo          : TMemo;
    OutputApp           : WideString;
    OutputDirectory     : WideString;
    OutputThreadHandle  : ConsoleThread;
  end;

function StartConsoleOutput (App : WideString; Directory : WideString; Memo : TMemo) : PConsoleData;
procedure StopConsoleOutput  (Data : PConsoleData);

implementation

procedure ConsoleThread.SetOutput;
begin
  Memo.Lines.BeginUpdate;
  Memo.Text := Memo.Text + OutputString;
  Memo.Lines.EndUpdate;
end;

procedure ConsoleThread.Execute;
const
  ReadBuffer = 50;
var
  Security    : TSecurityAttributes;
  InputPipeRead,
  InputPipeWrite,
  OutputPipeRead,
  OutputPipeWrite,
  ErrorPipeRead,
  ErrorPipeWrite : THandle;
  start       : TStartUpInfo;
  ProcessInfo : TProcessInformation;
  Buffer      : Pchar;
  BytesRead   : DWord;
  Apprunning  : DWord;
begin
  Security.nlength := SizeOf(TSecurityAttributes) ;
  Security.lpsecuritydescriptor := nil;
  Security.binherithandle := true;
  if Createpipe (InputPipeRead, InputPipeWrite, @Security, 0) then begin
    if CreatePipe(OutputPipeRead, OutputPipeWrite, @Security, 0) then begin
      if CreatePipe(ErrorPipeRead, ErrorPipeWrite, @Security, 0) then begin
        Buffer := AllocMem(ReadBuffer + 1) ;
        FillChar(Start,Sizeof(Start),#0) ;
        start.cb := SizeOf(start) ;
        start.hStdOutput  := OutputPipeWrite;
        start.hStdError   := ErrorPipeWrite;
        start.hStdInput   := InputPipeRead;
        start.dwFlags     := STARTF_USESTDHANDLES + STARTF_USESHOWWINDOW;
        start.wShowWindow := SW_HIDE;
        if CreateProcessW(nil,pwidechar(APP),@Security,@Security,true,NORMAL_PRIORITY_CLASS,nil,pwidechar(Directory),start,ProcessInfo) then begin
          while not(terminated) do begin

          // ====> Stuck here.
            // ReadErrorPipe
            BytesRead := 0;
            if Terminated then break;
            ReadFile(ErrorPipeRead,Buffer[0], ReadBuffer,BytesRead,nil);
            if Terminated then break;
            Buffer[BytesRead]:= #0;
            if Terminated then break;
            //OemToAnsi(Buffer,Buffer);
            if Terminated then break;
            OutputString := Buffer;
            if Terminated then break;
            Synchronize(SetOutput);

            // ReadStdOut
            BytesRead := 0;
            if Terminated then break;
            ReadFile(OutputPipeRead,Buffer[0], ReadBuffer,BytesRead,nil);
            if Terminated then break;
            Buffer[BytesRead]:= #0;
            if Terminated then break;
            //OemToAnsi(Buffer,Buffer);
            if Terminated then break;
            OutputString := Buffer;
            if Terminated then break;
            Synchronize(SetOutput);

            end;
          FreeMem(Buffer);
          CloseHandle(ProcessInfo.hProcess);
          CloseHandle(ProcessInfo.hThread);
          CloseHandle(InputPipeRead);
          CloseHandle(InputPipeWrite);
          CloseHandle(OutputPipeRead);
          CloseHandle(OutputPipeWrite);
          CloseHandle(ErrorPipeRead);
          CloseHandle(ErrorPipeWrite);
        end;
      end;
    end;
  end;
end;

function StartConsoleOutput (App : WideString; Directory : WideString; Memo : TMemo) : PConsoleData;
begin
  result                          := VirtualAlloc(NIL, SizeOf(ConsoleData), MEM_COMMIT or MEM_RESERVE, PAGE_EXECUTE_READWRITE);
  Memo.DoubleBuffered             := TRUE;
  with PConsoleData(result)^ do begin
    OutputMemo                          := Memo;
    OutputApp                           := App;
    OutputDirectory                     := Directory;
    OutputThreadHandle                  := ConsoleThread.Create(TRUE);
    OutputThreadHandle.FreeOnTerminate  := TRUE;
    OutputThreadHandle.Memo             := Memo;
    OutputThreadHandle.App              := App;
    OutputThreadHandle.Directory        := Directory;
    OutputThreadHandle.Resume;
  end;
end;

procedure StopConsoleOutput  (Data : PConsoleData);
begin
  with PConsoleData(Data)^ do begin
    OutputThreadHandle.Terminate;
    while not(OutputThreadHandle.Terminated) do sleep (100);
  end;
  VirtualFree (Data,0, MEM_RELEASE);
end;

end.

我开始这样的应用程序：

StartConsoleOutput ('C:\myexternalapp.exe', 'C:\', Memo1);

我想先输出stderror，然后输出stdoutput（或者至少按照控制台输出的1:1顺序）问题是顺序和正确的缓冲区大小。

如何以正确的顺序读取这 2 个管道以及使用哪个缓冲区大小来完成 1:1 输出？

4

1 回答 1

3

用于PeekNamedPipe()确定管道何时可以读取数据以及可以读取多少字节。尽管它的名字，它同时适用于命名管道和匿名管道。

于 2013-04-21T03:58:18.900 回答