Есть методы перехвата консольного ввода-вывода и есть методы инкапсуляции реальной консоли.
Первые отлично работают, но полностью адекватного эмулятора терминала я так и не нашел и то что я вижу в "эмуляторе терминала" часто совершенно не похоже на то что видно в реальной консоле.
Вторые могут нормально отображать вывод консольной программы но я совершенно не имею доступа выводу, а его желательно как-то парсить .
Отсюда вопрос: как добраться до консольного "тестового буфера" и прочитать то что в нем находится или просто дублировать захваченный вывод обратно в консоль
Захват консоли
- Код: Выделить всё
Procedure RunDosInMemo(CmdLine: String; AMemo: TMemo);
Const
ReadBuffer = 1023;
Var
Security: TSecurityAttributes;
OutReadPipe, OutWritePipe: tHandle; // труба для output'a консольной проги.
InReadPipe, InWritePipe: tHandle; // труба для input'a консольной проги.
ErrReadPipe, ErrWritePipe: tHandle; // труба для error's консольной проги.
// InReadPipe, ErrReadPipe и объявлены для полноты картины,но не создаются и не используются.
start: TStartUpInfo;
ProcessInfo: TProcessInformation;
Buffer: Pchar;
BytesRead: DWord;
Apprunning: DWord;
avail : dword;
notread:dword;
stop:boolean;
Begin
stop := false;
With Security Do Begin // инициализация структуры
nlength := SizeOf(TSecurityAttributes);
binherithandle := true;
lpsecuritydescriptor := Nil;
End;
Createpipe(InReadPipe, InWritePipe, @Security, 0);
Createpipe(ErrReadPipe, ErrWritePipe, @Security, 0);
If Createpipe(OutReadPipe, OutWritePipe, @Security, 0) Then Begin
// создали трубу для выхлопа бэкграунд-приложения
Buffer := AllocMem(ReadBuffer + 1);
// создали буфер для чтения
FillChar(Start, Sizeof(Start), #0);
// заполнили содержимое стартовой структуры #0
start.cb := SizeOf(start);
start.hStdOutput := OutWritePipe;
start.hStdError := OutWritePipe;
start.hStdInput := InReadPipe;
(*************************************************************
такой себе опширненьний комментарий...
Оказывается, мать их так, если сделать перенаправление
вывода в трубы, но не читать его, то если он(вывод)
будет достаточно длинный и сможет переполнить буфер,
который изначально отводится под трубу, то пишущий поток
остановится и будет ждать пока не освободится место в
буфере трубы. Как только оно освободилось, он сможет
продолжать работу и писать дальше.
start.hStdOutput := OutWritePipe;
start.hStdError := OutWritePipe;
почему собственно такой странный код: два потока
перенаправлены в одну трубу?
Потому что некоторые замечательные проги типа 7zip свой
вывод направляют не в StdOut, а почему то в StdErr...
и если для этих двух потоков назначить две разных трубы,
а читать только одну, то произойдет то, что описано выше.
РРРРРРРРРРРРРРРРРРРРРРРРР!!!!!!!!! сопли, слюни, ярость и
буйное помешательство на почве программирования под винду.
Может стоит сделать две трубы и читать каждую в отдельное
мемо???
**************************************************************)
start.dwFlags := STARTF_USESTDHANDLES + STARTF_USESHOWWINDOW;
start.wShowWindow := SW_HIDE;
// окно прячем
If CreateProcess(Nil, PChar(CmdLine), @Security, @Security, true, NORMAL_PRIORITY_CLASS,
Nil, Nil, start, ProcessInfo) Then Begin
// создали процесс
Repeat
Apprunning := WaitForSingleObject(ProcessInfo.hProcess, 100);
PeekNamedPipe(OutReadPipe, @Buffer[0], ReadBuffer, @BytesRead, @avail, @notread);
// PeekNamedPipe копирует из буфера трубы и оставляет его в первоначальном состоянии
// в то время как ReadFile читая из трубы - опустошает ее.
// PeekNamedPipe можно использовать для того чтобы узнать сколько данных есть в трубе
// и если в PeekNamedPipe передать 2 и 3 параметры пустыми, то она просто скажет
// сколько данных есть в трубе
if avail > 0 then begin
ReadFile(OutReadPipe, Buffer[0], BytesRead, BytesRead, Nil); // *******
// ReadFile при чтении из трубы опустошает ее(трубы) буфер.
end
else begin
if Apprunning <> 258 then
stop := true;
end;
// читаем через читающий конец трубы из вывода консоли
Buffer[BytesRead] := #0;
// последний символ #0 - конец буфера
OemToAnsi(Buffer, Buffer);
// перевели из кодировки DOS в кодировку WIN
AMemo.Text := AMemo.text + String(Buffer);
// то что прочитали приписали к тексту в мемо
Application.ProcessMessages;
// обработали очередь сообщений
// Until ((Apprunning <> WAIT_TIMEOUT) or (avail < 0));
Until stop;
// прервемся когда процесс завершится
End;
FreeMem(Buffer); // освободили буфер
CloseHandle(ProcessInfo.hProcess); // закрыли все хендлы
CloseHandle(ProcessInfo.hThread);
CloseHandle(OutReadPipe);
CloseHandle(OutWritePipe);
CloseHandle(InReadPipe);
CloseHandle(InWritePipe);
CloseHandle(ErrReadPipe);
CloseHandle(ErrWritePipe);
End;
// конец.
End;
Инкапсуляция консоли
- Код: Выделить всё
Const Con_h:hwnd =0;
SearchHandle:hwnd =0;
function EnumProc(h:HWND; lParam:DWord):boolean; stdcall;
var
ProcessId, z:cardinal;
begin
Result:=True;
GetWindowThreadProcessId(h, ProcessId);
If ProcessId=lParam then
begin
SearchHandle:=h;
Result:=False;
end;
end;
procedure TForm1.Run_IN_RealConsle;
var
ExecInfo: TShellExecuteInfoA;
buf:array[1..100] of char;
S:String;
P:Pointer;
Var
StartTime:QWord;
begin
..
ZeroMemory(@si, sizeof(si));
si.cb:=SizeOf(si);
P:=@EnumProc;
CreateProcess(nil, 'cmd /C TmpListCmd.Bat', nil, nil, false, 0, nil, nil, @si,@pi);
SearchHandle:=0;
sleep(150);
StartTime:=GetTickCount64;
While (SearchHandle=0) and ( GetTickCount64-StartTime<2000) do
begin
Windows.EnumWindows(@EnumProc,Lparam( pi.dwProcessId) );
Application.ProcessMessages;
end;
if SearchHandle<>0 then begin
Con_H:=SearchHandle;
...
windows.SetWindowLong(Con_H, GWL_STYLE, WS_VISIBLE + WS_POPUP);
windows.SetParent(Con_h,panel11.Handle);
windows.MoveWindow(Con_h,0,0,panel11.Width,panel11.Height,true);
end;
end;
То есть мне нужен некий гибрид обоих методов работы с консолью (захватить без скрытия и дублировать вывод обратно в консоль которую в свою очередь можно инкапсулировать ) или дополнительная надстройка над "инкапсуляцией" ( с периодическим чтением тестового буфера консоли ).
Добавлено спустя 36 минут 39 секунд:
Зы
Что-то такое нашел но как-то это пока что криво у меня выходит. ( + Еще бы событие на обновление найти бо отслеживать по таймеру не очень надежно )
https://delphisources.ru/forum/showthread.php?t=7520
Добавлено спустя 12 минут 28 секунд:
Бр голова распухает ...
https://question-it.com/questions/67219 ... stochnikov
)