Трубы Delphi Console поменялись?

Я хотел бы прочитать консольные результаты от консоли с моим собственным модулем:

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. Кажется, что некоторые части отсутствуют, а затем внезапно выводит, что что-то пишет в консоль.

Screenshot1screenshot2

Что я делаю не так?

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 + ... очень неэффективно. Все содержание памятки будет как прочитанным, так и написанным.

Другие вопросы по тегам