Delphi 控制台管道已切换？

Question

我想用我自己的设备从控制台读取控制台输出:

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 = 20;
var
  Security    : TSecurityAttributes;
  ReadPipe,
  WritePipe   : THandle;
  start       : TStartUpInfo;
  ProcessInfo : TProcessInformation;
  Buffer      : Pchar;
  BytesRead   : DWord;
  Apprunning  : DWord;
begin
  Security.nlength := SizeOf(TSecurityAttributes) ;
  Security.lpsecuritydescriptor := nil;
  Security.binherithandle := true;
  if Createpipe (ReadPipe, WritePipe, @Security, 0) then begin
    Buffer := AllocMem(ReadBuffer + 1) ;
    FillChar(Start,Sizeof(Start),#0) ;
    start.cb := SizeOf(start) ;
    start.hStdOutput  := WritePipe;
    start.hStdError   := WritePipe;
    start.hStdInput   := ReadPipe;
    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
        BytesRead := 0;
        if Terminated then break;
        ReadFile(ReadPipe,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(ReadPipe) ;
      CloseHandle(WritePipe) ;
    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.

我使用这个控制台应用程序在(worldserver.exe)上测试它: https://dl.dropboxusercontent.com/u/349314/Server.rar (已编译)

该项目的来源在这里: https://github.com/TrinityCore/TrinityCore

有关如何编译项目的教程在这里: http://archive.trinitycore.info/How-to:Win

要启动 worldserver.exe，我只需使用我自己的单元，如下所示:

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

应用程序启动正常，只是有一些问题/错误，我不明白:

1. 输出应用程序(worldserver.exe)的时间似乎比我自己打开它要长(大约有3秒的延迟)。
2. 管道似乎被切换或其他原因导致我的delphi应用程序输出错误的方式。 (参见截图2)
3. 我让服务器(worldserver.exe)与mysql一起完整运行(工作正常)并让它在我的delphi应用程序中输出。似乎缺少某些部分，然后突然输出有东西正在写入控制台。

我做错了什么？

Answer 1

基本问题是您创建了一个管道，并使外部进程使用同一管道的两端。管道用于连接两个不同的进程。所以每个进程应该只知道它的一端。

假设您希望 app1 向 app2 发送信息。创建一个具有写入端和读取端的管道。典型的配置如下所示。

app1, stdout --> pipe write end --> pipe read end --> app2, stdin

这就是如果你写的话你会得到的

app1 | app2

在命令解释器处。

但是您已将管道的读取端附加到 app1、stdin。所以在你的例子中，图表是这样的

app1, stdout --> pipe write end ---
|                                 |
|                                 |
app1, stdin  <-- pipe read end  <--

你的程序中有一个明显的错误。当 app1 写入其标准输出时，它写入的任何内容都会出现在其自己的标准输入中!绝对不是你想要的。

故事中的额外转折是您的应用程序还尝试读取管道的读取端。因此您的应用程序和外部进程都在读取该内容。现在，这是一场比赛。谁能确定哪一个获得了内容？

也许您需要的只是删除分配 hStdInput 的行并将其保留为 0。

最后一点。编写 Text := Text + ... 效率非常低。备忘录的全部内容将被读取和写入。