Трубы 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);
Приложение запускается нормально только с несколькими проблемами / ошибками, которые я не понимаю:
- Похоже, что время для вывода приложения (worldserver.exe) занимает больше времени, как если бы я открывал его самостоятельно (например, 3-секундная задержка).
- Кажется, что каналы переключены или что-то из-за этого в моем приложении delphi выводит неправильный путь. (см. скриншот 2)
- У меня есть сервер (worldserver.exe) в комплекте с MySQL (который работает нормально), и пусть он выводится в моем приложении Delphi. Кажется, что некоторые части отсутствуют, а затем внезапно выводит, что что-то пишет в консоль.
Что я делаю не так?
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 + ...
очень неэффективно. Все содержание памятки будет как прочитанным, так и написанным.