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);

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

似乎输出应用程序（worldserver.exe）的时间需要更长时间，就像我自己打开它一样（比如3秒延迟）。
管道似乎是在我的delphi应用程序上切换或导致错误输出的原因。（见截图2）
我的服务器（worldserver.exe）完全运行mysql（工作正常）并让它在我的delphi应用程序中输出。看起来有些部分缺失，然后突然输出一些内容写入控制台。

Screenshot1 Screenshot2

我做错了什么？

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 + ...效率非常低。备忘录的全部内容将被读取和写入。

德尔福控制台管道切换？

1 个答案: