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. パイプが切り替えられているように見えるか、私のデルファイアプリで何かが原因で間違った方法で出力されます。(スクリーンショット 2 を参照)
  3. サーバー（worldserver.exe）をmysql（正常に動作）で完全に実行し、デルファイアプリに出力させます。一部の部品が欠落しているように見えますが、突然、何かがコンソールに書き込んでいると出力されます。

スクリーンショット1 スクリーンショット2

私は何を間違っていますか？

4

1 に答える 1

4

The basic problem is that you have created a single pipe, and made the external process use both ends of the same pipe. The pipe is used to connect two distinct processes. So each process should only know about one end of it.

So imagine you want to app1 to send information to app2. Create a pipe with a write end and a read end. A typical configuration looks like this. 

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

This is what you would get if you wrote

app1 | app2

at the command interpretor.

But you have attached the read end of your pipe to app1, stdin. So in your case the diagram is like this

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

That's a clear mistake in your program. When app1 writes to its stdout, whatever it writes appears in its own stdin! Absolutely not what you intended.

The extra twist in the tale is that your app is also trying to read the read end of the pipe. So both your app and the external process are reading that. Now, that's a race. Who's to say which one gets the content?

Perhaps all you need is to remove the line that assigns hStdInput and leave it as 0 instead.

One final point. Writing Text := Text + ... is very inefficient. The entire contents of the memo will be both read, and written.

于 2013-04-20T16:44:06.687 に答える