![]() |
| ||
|
|
Новости |
Поиск |
FAQ |
Статьи |
Книги |
Новости VCL
| | Форумы ЧАТ |
Орешник |
|
| |||
| |||
« предыдущая ветвь | форум | следующая ветвь »
Редирект консольного вывода
бывший © (2005-07-18 22:22:00)Есть клиент-серверное приложение. сервер сделан в виде консоли. необходим редирект вывода информации из консоли в мое приложение в "реальном масштабе времени" ) понимаю что необходим отдельный поток в котором я и буду совершать действо.
Пробовал создавать пайп и переадресовывать вывод при запуске консоли (createprocess) на этот пайп, постепенно читая из него. во-первых - передается не все, во-вторых в определенный момент консоль виснит. Подобные решения видел на www.sources.ru, к примеру.
В общем, мне нужна именно постепенная передача всего текста, отображаемого в консоле в мое приложение по мере его появления.
Я так понял выхода два - переадресация вывода (к примеру через пайп) - с этим вариантом по непонятным мне причинам облом вышел, чтение из некоего буфера консоли. Мастера, помогите!
Если необходимо привести те коды, что пробовал использовать, приведу. Пока для экономии места оставляю вопрос в таком виде.
бывший (2005-07-21 15:26:00) [1]буду смотреть, спасибо.
еще остался вариант с редиректом в файл (хотя думаю будет тоже самое), кстати, вопрос относительно console.exe > 1.txt - разве такое на всех консолях срабатывает? по-моему консоль должна "уметь" обрабатывать сей ключ. он же не универсален?
ну и вариант с ReadConsoleOutput [alpet]
Ботвин Дмитрий (2005-07-21 10:48:00) [2]Последнее, что могу предложить:
1. Задать ReadBuffer = 4096;
2. Поправь цикл:
repeat
Apprunning := WaitForSingleObject(ProcessInfo.hProcess, 30000);
ReadFile(ReadPipe, Buffer[0],
ReadBuffer, BytesRead, nil);
Buffer[BytesRead] := #0;
OemToAnsi(Buffer, Buffer);
AMemo.Text := AMemo.text + string(Buffer);
Application.ProcessMessages;
until (Apprunning <> WAIT_TIMEOUT) or (Apprunning <>WAIT_OBJECT_0);
бывший (2005-07-21 10:12:00) [3]проверил пример Slym'a: результат тот же! редирект не полностью. значит дело не в StdError (
@alpet © (20.07.05 12:07) [51]
по поводу статуса ReadFile - везде все путем. проверка сама собой получилась (см. пример Slym'a):
if not ReadFile(ChildStdoutRd,buffer^,bytesRead,bytesRead,nil) then
RaiseLastOSError;
исключения не было.
Slym (2005-07-20 14:09:00) [4]Коряво но работает:
type
TConsoleThread=class(TThread)
private
FCMD:string;
FCloseHandles:boolean;
FStdIn:TStrings;
FStdOut:TStrings;
FExitCode:DWord;
protected
procedure Execute;override;
public
constructor Create(const CMD:string;Commands:TStrings;CloseHandles:boolean=false);reintroduce;
destructor Destroy; override;
property ExitCode:DWord read FExitCode;
property StdOut:TStrings read FStdOut;
end;
implementation
uses SysUtils;
{ TConsole }
constructor TConsoleThread.Create(const CMD:string;Commands:TStrings;CloseHandles:boolean=false);
var i:integer;
begin
FCMD:=CMD;
FCloseHandles:=CloseHandles;
FStdIn:=TStringList.Create;
FStdOut:=TStringList.Create;
if assigned(Commands) then
begin
FStdIn.BeginUpdate;
try
for I:= 0 to Commands.Count - 1 do
FStdIn.AddObject(Commands[I]+#13#10, Commands.Objects[I]);
finally
FStdIn.EndUpdate;
end;
end;
inherited Create(false);
end;
destructor TConsoleThread.Destroy;
begin
FStdIn.Free;
FStdOut.Free;
inherited;
end;
procedure TConsoleThread.Execute;
var
sa:TSecurityAttributes;
si:TStartupInfo;
pi:TProcessInformation;
ChildStdInWr,ChildStdoutRd:THandle;
ChildStdoutWr,ChildStdInRd:THandle;
Tmp1,Tmp2:THandle;
buffer:Pointer;
bytesRead:DWORD;
p:PChar;
begin
ChildStdInWr:=0;ChildStdoutRd:=0;
ChildStdoutWr:=0;ChildStdInRd:=0;
Tmp1:=0;Tmp2:=0;
sa.nLength:=sizeof(TSecurityAttributes);
sa.bInheritHandle:=true;
sa.lpSecurityDescriptor:=nil;
try
if not CreatePipe(ChildStdoutRd,ChildStdoutWr,@sa,0) then
RaiseLastOSError;
if not CreatePipe(ChildStdinRd,ChildStdinWr,@sa,0) then
RaiseLastOSError;
if not DuplicateHandle(GetCurrentProcess(),ChildStdoutRd,GetCurrentProcess(),@Tmp1,0,False,DUPLICATE_SAME_ACCESS) then
RaiseLastOSError;
if not DuplicateHandle(GetCurrentProcess(),ChildStdinWr,GetCurrentProcess(),@Tmp2,0,False,DUPLICATE_SAME_ACCESS) then
RaiseLastOSError;
if ChildStdoutRd<>0 then
if CloseHandle(ChildStdoutRd) then
ChildStdoutRd:=0;
if ChildStdinWr<>0 then
if CloseHandle(ChildStdinWr) then
ChildStdinWr:=0;
ChildStdoutRd:=Tmp1;Tmp1:=0;
ChildStdinWr:=Tmp2;Tmp2:=0;
GetStartupInfo(si);
si.cb:=sizeof(TStartupInfo);
si.dwFlags:=STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
si.hStdInput:=ChildStdInRd;
si.hStdOutput:=ChildStdOutWr;
si.hStdError:=ChildStdOutWr;
si.wShowWindow:=SW_HIDE;
if not CreateProcess(nil,PChar(FCMD),nil,nil,true,CREATE_NEW_CONSOLE,nil,nil,si,pi) then
RaiseLastOSError;
while not Terminated do
begin
if WaitForSingleObject(pi.hProcess,0)=WAIT_OBJECT_0 then
begin
GetExitCodeProcess(pi.hProcess,FExitCode);
CloseHandle(pi.hProcess);
CloseHandle(pi.hThread);
Terminate;
end;
PeekNamedPipe(ChildStdoutRd,nil,0,nil,@bytesRead,nil);
if bytesRead>0 then
begin
GetMem(buffer,bytesRead+1);
try
if not ReadFile(ChildStdoutRd,buffer^,bytesRead,bytesRead,nil) then
RaiseLastOSError;
PChar(buffer)[bytesRead]:=#0;
OemToChar(buffer,buffer);
FStdOut.Append(PChar(buffer));
finally
FreeMem(buffer);
end;
end;
while FStdIn.Count>0 do
begin
p:=PChar(FStdIn[0]);
CharToOem(p,p);
if not WriteFile(ChildStdinWr,p^,Length(FStdIn[0]),bytesRead,nil) then
RaiseLastOSError;
FStdIn.Delete(0);
end;
if FCloseHandles and (ChildStdinWr<>0) then
if CloseHandle(ChildStdinWr) then
ChildStdinWr:=0;
end;
finally
if ChildStdoutRd<>0 then CloseHandle(ChildStdoutRd);
if ChildStdoutWr<>0 then CloseHandle(ChildStdoutWr);
if ChildStdinRd<>0 then CloseHandle(ChildStdinRd);
if ChildStdinWr<>0 then CloseHandle(ChildStdinWr);
if Tmp1<>0 then CloseHandle(Tmp1);
if Tmp2<>0 then CloseHandle(Tmp2);
end;
end;
Slym (2005-07-20 14:04:00) [5]А прога у тебя не запускаться может от того что hStdError=0
Slym (2005-07-20 14:02:00) [6]А где start.hStdError?
у консоли 1 вход и 2! выхода
Без перенаправления выходы указывают в одно место, перенаправляешь ты только hStdOutput, а hStdError?
Перенаправь hStdError тудаже (в hStdOutput)
alpet (2005-07-20 13:41:00) [7]В MSDN приведен пример с пайпами. Вот кусочек его (чтение из пайпа в stdout):
for (;;)
{
if( !ReadFile( hChildStdoutRdDup, chBuf, BUFSIZE, &dwRead,
NULL) || dwRead == 0) break;
if (! WriteFile(hSaveStdout, chBuf, dwRead, &dwWritten, NULL))
break;
}
Единственно что заметно в отличии от предлагаемых программ - размер буфера (BUFSIZE) = 4096.
Ботвин Дмитрий (2005-07-20 13:36:00) [8]Через перенаправление тоже будет реалтайм. Запускаешь в основном
потоке перенаправление, а во втором читаешь. Попробуй с тем же
пингом с параметром -t, а текстовым редактором открывай созданный файл и смотри как в него добавляются строки :-)))
alpet (2005-07-20 13:35:00) [9]Потом добавление результата у тебя происходит как-то странно на мой взгляд:
Line := '';
...
Line := Line + Buffer;
...
uMain.MainForm.richLog.Lines.Add(Line);
Это по идее приводит к разбиению строк.
Попробуй так (строки должны получаться нормально):
with uMain.MainForm.richLog do
Text := Text + Buffer;
alpet (2005-07-20 13:21:00) [10]бывший (20.07.05 13:15) [55]
Неполный видимо потому, что твоя программа считывает не все данные из пайпа, что может быть следствием того что они туда не все попадают, или какой-нибудь ошибки в программе. Статус выполнения ReadFile мы так и неувидели.
бывший (2005-07-20 13:15:00) [11]Ботвин Дмитрий (20.07.05 12:20) [53]
=) нужен real-time )ибо то что я показал - есть всего лишь процесс инициализации сервера (загрузка данных, открытие портов), далее следует коннект клиентов, работа с ними и т.д. - все это надо парсить в real-time и определенным образом реагировать на события.
alpet © (20.07.05 12:24) [54]
спасибо. буду смотреть.
Digitman © (20.07.05 11:40) [47]
спасибо, буду иметь в виду.
и все-таки кто как думает - почему редирект не полный? это остался последний вопрос )
alpet (2005-07-20 12:24:00) [12]бывший (20.07.05 12:11) [52]
The ReadConsoleOutputfunction reads character and color attribute data from a rectangular block of character cells in a console screen buffer, and the function writes the data to a rectangular block at a specified location in the destination buffer.
Прототип есть в Delphi/Source/Rtl/Win/Windows.pas.
Я для эмуляции ввода с клавиатуры использую подобную ей функцию WriteConsoleInput (si.hStdInput...) Работает нормально с консольными и DOS прогами. Эта функция соотвественно должна работать с STARTUPINFO.hStdOutput.
Ботвин Дмитрий (2005-07-20 12:20:00) [13]Если тебе нужна эта непонятная инфа, может проще перенаправить
консоль в файл, например:
ping 192.168.28.200 > c:\123.txt
и непарится с редиректом :-)))
бывший (2005-07-20 12:11:00) [14]alpet © (20.07.05 12:07) [51]
2. ReadConsoleOutput? енто что? F1 не помог (
1. гляну ща...
что можете сказать относительно столь кривого редиректа? каким образом сервер может выводить на консоль минуя редирект? странно все это очень (
alpet (2005-07-20 12:07:00) [15]бывший (20.07.05 12:03) [50]
1. Какой статус выполнения ReadFile (GetLastError) в случаях считывания и не считывания данных.
2. Может попробывать ReadConsoleOutput?
бывший (2005-07-20 12:03:00) [16]сорри, ну я констатацию фактов и имел в виду. извините, ей богу. (
Digitman (2005-07-20 12:00:00) [17]
> короче привожу сравнительный анализ
мог бы и еще короче
мне, к примеру, этот "анализ" ни о чем не говорит, да и не анализ это никакой, а просто констатация фактов
бывший (2005-07-20 11:43:00) [18]ага, ща засуну =) самому уже смешно. короче привожу сравнительный анализ:
лог сервера без моего редиректа:
14:34:17:M:Loading address cache ... skipped.
OS version 5.1.2600 (Service Pack 2) platform 2
14:34:18:U: *** ****** win32 console release multithread
14:34:18:M:Config file scripts/defines.scp loaded, 0 sections done.
14:34:18:M:Config file scripts/***.conf loaded, 5 sections done.
14:34:18:M:Spells loaded, max=23702
14:34:18:M:WorldSafeLocs loaded, total=99
14:34:18:M:AreaTable loaded, total=1043
14:34:18:M:WorldMapArea loaded, total=50
14:34:18:M:Talents loaded, total=430
14:34:18:M:Taxinodes loaded, total=76
14:34:18:M:Taxipathes loaded, total=223
14:34:18:M:Taxipathnodes loaded, total=8400
14:34:18:M:EmotesText loaded, total=169
14:34:18:M:Factions loaded, total=175
14:34:18:M:FactionTemplates loaded, total=274
14:34:18:M:DurabilityCosts loaded, total=100
14:34:18:M:MapCache inited, 41 maps.
14:34:18:M:water.dat loaded, 19241 recs.
14:34:18:M:Config file scripts/classes.scp loaded, 58 sections done.
14:34:18:M:classes.scp stat tables loaded.
14:34:18:M:File scripts/items.scp, max 19326, total 11809 sections.
14:34:18:M:Config file scripts/gameobjects.scp loaded, 7608 sections done.
14:34:18:M:Config file scripts/specific_loots.scp loaded, 6 sections done.
14:34:18:M:Config file scripts/loottemplates.scp loaded, 4191 sections done.
14:34:18:M:Config file scripts/creatures_missing_models.scp loaded, 533 sections
done.
14:34:18:M:Config file scripts/creatures.scp loaded, 7887 sections done.
14:34:18:M:File scripts/spellcost.scp, max 117925, total 18352 sections.
14:34:18:M:File scripts/area/area_gm.scp, max 802004, total 215 sections.
14:34:18:M:File scripts/area/area_poi.scp, max 802004, total 69 sections.
14:34:18:M:File scripts/area/area_quest.scp, max 802004, total 7 sections.
14:34:18:M:File scripts/areatriggers.scp, max 802004, total 618 sections.
14:34:18:M:File scripts/quests.scp, max 13131312, total 3234 sections.
14:34:18:M:File scripts/pages.scp, max 2606, total 671 sections.
14:34:18:M:File scripts/qdbtexts.scp, max 13101560, total 5298 sections.
14:34:18:M:File scripts/npctext.scp, max 13101560, total 6726 sections.
14:34:23:M:Patching ... #569 ... #56E ... #568 ... <WS> ... <SN> ... <MOTD> ...
<FCKSTF> ... #57 ... #61 ... #63 ... #62 ... #67 ... done.
14:34:23:M:Saving address cache ... done.
[*** Plugin] v0.6.2 Loading database ...
[*** Plugin] TCLTool : Loading Quests Definitions ...
[*** Plugin] TCLTool : Loading Quests Definitions ... OK
[*** Plugin] TCLTool : Loading NPC Definitions ...
[*** Plugin] TCLTool : Loading NPC Definitions ... OK
[*** Plugin] TCLTool : Compiling NPCs ...
[*** Plugin] TCLTool : Compiling NPCs ... OK
[*** Plugin] Loading frase Database ...
[*** Plugin] Loading frase Database ... OK
[*** Plugin] Loading Spell Database ...
[*** Plugin] Loading Spell Database ... OK
[*** Plugin] Loading Global configuration ...
[*** Plugin] Loading Global configuration ... OK
[*** Plugin] Loading User configuration ...
[*** Plugin] User configuration not found ! (It's OK)
[*** Plugin] Loading Temporary Pool ...
[*** Plugin] Temporary Pool not found ! (It's OK)
[*** Plugin] Loaded OK
14:34:18:M:TCL:Init... done. 726 files loaded.( If error occured -> )
14:34:18:M:Main thread started.
14:34:18:M:Loading guilds...
14:34:18:M:done.
14:34:18:M:Loading world...
14:34:18:M:Rehashing.
14:34:18:M:done.
14:34:18:M:Loading PP...
14:34:18:M:done, 328995 ppoints.
14:34:49:M:WS:Socket opened TCP port 8085
14:34:49:M:HS:Socket opened TCP port 8080
14:34:49:M:RS:Socket opened TCP port 3724
а вот редирект полученный мною:
14:37:30:M:Loading config file wel_server.conf ... done.
14:37:30:M:Loading address cache ... skipped.
14:37:34:M:Patching ... #569 ... #56E ... #568 ... <WS> ... <SN> ... <MOTD> ... <FCKSTF> ... #57 ... #61 ... #63 ... #62 ... #67 ... done.
14:37:34:M:[PavkaM Plugin] v0.6.2 Loading database ...
[*** Plugin] TCLTool : Loading Quests Definitions ...
[*** Plugin] TCLTool : Loading Quests Definitions ... OK
[*** Plugin] TCLTool : Loading NPC Definitions ...
[*** Plugin] TCLTool : Loading NPC Definitions ... OK
[*** Plugin] TCLTool : Compiling NPCs ...
[*** Plugin] TCLTool : Compiling NPCs ... OK
[*** Plugin] Loading frase Database ...
[*** Plugin] Loading frase Database ... OK
[*** Plugin] Loading Spell Database ...
[*** Plugin] Loading Spell Database ... OK
[*** Plugin] Loading Global configuration ...
[*** Plugin] Loading Global configuration ... OK
[*** Plugin] Loading User configuration ...
[*** Plugin] User configuration not found ! (It's OK)
[*** Plugin] Loading Temporary Pool ...
[*** Plugin] Temporary Pool not found ! (It's OK)
[*** Plugin] Loaded OK
Digitman (2005-07-20 11:40:00) [19]
> поставил таймаут в 1000 - заработало
вот дался тебе этот тайм-аут !
не нужны тут никакие тайм-авуты вообще)
стартуешь первый поток, в нем :
- создаешь пайп,
- стартуешь свой сервер,
- стартуешь второй поток c параметром - хэндлом пайпа
- следишь за сервером
- как только сервер завершится (или будет принудительно снят) закрываешь пайп
второй поток, получив параметром хэндл пайпа, просто в цикле читает из пайпа, пока не получит 6-й ошибки
Ботвин Дмитрий (2005-07-20 11:34:00) [20]Тогда Priority := tpIdle засунь в Execute первой строкой.
Быть не может, что бы это вызывало исключение.