1

我想用我自己的单元从控制台读取控制台输出：

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 应用程序中输出。似乎某些部分丢失了，然后突然输出一些东西正在写入控制台。

截图1 截图2

我做错了什么？

4

1 回答 1

4

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

所以想象一下你想让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 + ...效率很低。备忘录的全部内容将被读取和写入。

于 2013-04-20T16:44:06.687 回答