Вывод StdOut консоли в TMemo (сразу, не после закрытия консоли)

[northener]

Сообщение от hexor_boo

Причина глюка: если ping, например, выводит последовательно строчки в консоль, то 7z.exe при упаковке больших объёмов меняет значение в одной строчке консоли.

Ну тогда да. Мой код не поможет выводить прогресс, если Vapaamies прав в отношении

Сообщение от Vapaamies

похоже, 7-Zip определяет, выводится ли прогресс в экранную консоль или в файл, и в файл ничего не выводит

[hexor_boo]

Нашёл вот тут принципиально другое решение (переделал под себя), по сравнению с большинством описанных в интернете.

Unit unMethods;

Interface
 Uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

 Type

  TThreadConsole=Class(TThread)
   Private
    Caption: String;
     Procedure UpdateCaption;
   Protected
    Procedure Execute; Override;
  End;

 // writes InStr to the pipe handle described by OutputPipe
 Procedure WritePipeOut(OutputPipe : THandle; InStr : String);

 // reads console output from InputPipe.  Returns the input in function
 // result.  Returns bytes of remaining information to BytesRem
 Function ReadPipeInput(InputPipe : THandle; Var BytesRem : Integer) : String;

 Procedure ConsoleExecute(strCommand : String);
 Procedure ConsoleTerminate;

 Function Win2Dos(Const aStr: String): String;
 Function Dos2Win(Const aStr: String): String;

 Var
  InputPipeRead   : THandle;
  InputPipeWrite  : THandle;
  OutputPipeRead  : THandle;
  OutputPipeWrite : THandle;
  ErrorPipeRead   : THandle;
  ErrorPipeWrite  : THandle;
  ProcessInfo     : TProcessInformation;
  thrdConsole     : TThreadConsole;
  
Implementation

 Uses
  unMain;

 // writes InStr to the pipe handle described by OutputPipe
 Procedure WritePipeOut(OutputPipe : THandle; InStr : String);
  Var
   BytesWritten : DWord;
  Begin
   // most console programs require CR/LF after their input.
   InStr:=InStr+#13#10;
   WriteFile(OutputPipe, InStr[1], Length(InStr), BytesWritten, Nil);
  End;

 // reads console output from InputPipe.  Returns the input in function
 // result.  Returns bytes of remaining information to BytesRem
 Function ReadPipeInput(InputPipe : THandle; Var BytesRem : Integer) : String;
  Var
   TextBuf   : Array [1..32767] Of Char;
   TextStr   : String;
   BytesRead : Integer;
   PipeSize  : Integer;
  Begin
   Result:='';
   PipeSize:=SizeOf(TextBuf);

   // check if there is something to read in pipe
   PeekNamedPipe(InputPipe, Nil, PipeSize, @BytesRead, @PipeSize, @BytesRem);

    If (BytesRead>0) then
     Begin
      ReadFile(
       InputPipe, TextBuf, Cardinal(PipeSize), Cardinal(BytesRead), Nil
      );
      // a requirement for Windows OS system components
      OemToChar(@TextBuf, @TextBuf);
      TextStr:=String(TextBuf);
      SetLength(TextStr, BytesRead);
      Result:=TextStr;
     End;
     
  End;

 Procedure ConsoleExecute(strCommand : String);
  Var
   saSecurity : TSecurityAttributes;
   siStart    : TStartupInfo;
  Begin

   // create pipes
    With saSecurity Do
     begin
      nLength:=SizeOf(TSecurityAttributes);
      bInheritHandle:=True;
      lpSecurityDescriptor:=Nil;
     End;
   CreatePipe(InputPipeRead, InputPipeWrite, @saSecurity, 0);
   CreatePipe(OutputPipeRead, OutputPipeWrite, @saSecurity, 0);
   CreatePipe(ErrorPipeRead, ErrorPipeWrite, @saSecurity, 0);

   // start console
   FillChar(siStart, SizeOf(siStart),#0) ;
   siStart.CB:=SizeOf(siStart) ;
   siStart.hStdInput:=InputPipeRead;
   siStart.hStdOutput:=OutputPipeWrite;
   siStart.hStdError:= ErrorPipeWrite;
   siStart.dwFlags:=STARTF_USESTDHANDLES+STARTF_USESHOWWINDOW;
   siStart.wShowWindow:=SW_HIDE;

    If CreateProcess(
     Nil,
     PChar(strCommand),
     @saSecurity,
     @saSecurity,
     True,
     CREATE_NEW_CONSOLE Or SYNCHRONIZE,
     Nil,
     Nil,
     siStart,
     ProcessInfo
    ) Then
     Begin
      thrdConsole:=TThreadConsole.Create(False);  // start monitor thread
      thrdConsole.Priority:=tpHigher;
     End;

   //WritePipeOut(InputPipeWrite, strCommand+#13#10);
   frmMain.btnRun.Enabled:=False;
   frmMain.btnExit.Enabled:=True;
  End;

 Procedure ConsoleTerminate;
  Begin
   thrdConsole.Terminate;
   // close process handles
   CloseHandle(ProcessInfo.hProcess);
   CloseHandle(ProcessInfo.hThread);
   // close pipe handles
   CloseHandle(InputPipeRead);
   CloseHandle(InputPipeWrite);
   CloseHandle(OutputPipeRead);
   CloseHandle(OutputPipeWrite);
   CloseHandle(ErrorPipeRead);
   CloseHandle(ErrorPipeWrite);

   frmMain.btnRun.Enabled:=True;
   frmMain.btnExit.Enabled:=False;
  End;

 // monitor thread execution for console output.  This must be threaded.
 // checks the error and output pipes for information every 40 ms, pulls the
 // data in and updates the memo on the form with the output
 Procedure TThreadConsole.Execute;
  Var
   BytesRem : DWord;
  Begin
    While (Not Terminated) Do
     Begin
      // read regular output stream and put on screen.
      Caption:=ReadPipeInput(OutputPipeRead, Integer(BytesRem));
       If (Caption<>'') Then
        Synchronize(UpdateCaption);

      // now read error stream and put that on screen.
      Caption:=ReadPipeInput(ErrorPipeRead, Integer(BytesRem));
       If (Caption<>'') then
        Synchronize(UpdateCaption);

      Sleep(40);
     End;
  End;

 // synchronize procedure for monitor thread - updates memo on form.
 Procedure TThreadConsole.UpdateCaption;
  Begin
   frmMain.memLog.Lines.Add(Caption);
  End;

 Function Win2Dos(Const aStr: String): String;
  Begin
   Result:=aStr;
    If (Result<>'') Then
     CharToOem(PChar(Result), PChar(Result));
  End;

 Function Dos2Win(const aStr: String): String;
  Begin
   Result := aStr;
    If (Result<>'') Then
     OemToChar(PChar(Result), PChar(Result));
  End;

End.

Вызываю так

procedure TfrmMain.btnRunClick(Sender: TObject);
begin
 ConsoleExecute(
  '"D:\Programs\7-Zip\7z.exe"'+
  ' a "D:\Data\Projects\Bell-Port\ConsoleToMemo\backup\Test.zip"'+
  ' "D:\Data\Projects\Bell-Port\ConsoleToMemo\source\*"'
 );
end;

procedure TfrmMain.btnExitClick(Sender: TObject);
begin
 ConsoleTerminate;
end;

Поток мониторит с интервалом 40мс вывод консоли, если я правильно понял. Такое ощущение, что я в шаге от правильного решения. А вы как думаете?

[hexor_boo]

Одновременно с запуском cmd.exe или 7z.exe запускается conhost.exe

Про этот процесс:

Windows 7 улучшена таким образом что
визуальные окна консоли обрабатывает сама операционная система. В
предыдущих версиях Windows процесс консоли работал под управлением
процесса csrss.exe (Client Server Runtime Process). Он запускался от системной привилегированной учетной записи.

[hexor_boo]

При запуске "консольного" приложения запускается conhost.exe, который фактически отвечает за работу консоли. То есть то, что я вижу в окне cmd - реально результат 7z.exe > conhost.exe > экран. Соответственно 7z отправляет по какому-то особому каналу отображение процентов упаковки процессу conhost, который уже выводит его в консоль cmd. Соответственно нужно либо выявить канал, по которому 7z отправляет проценты, либо перехватить их из conhost.exe.

Верные размышления?

[Vapaamies]

Сообщение от hexor_boo

Соответственно нужно либо выявить канал, по которому 7z отправляет проценты, либо перехватить их из conhost.exe.

Ага, ага. А потом браться за разработку собственной ОС. Или антивируса. Или хотя бы вируса...

Сообщение от hexor_boo

Верные размышления?

Нет, неверные. Вот верные:

 function ProgressCallback(sender: Pointer; total: boolean; value: int64): HRESULT; stdcall;
 begin
   if total then
     Mainform.ProgressBar.Max := value else
     Mainform.ProgressBar.Position := value;
   Result := S_OK;
 end;

 procedure TMainForm.ExtractClick(Sender: TObject);
 begin
   with CreateInArchive(CLSID_CFormatZip) do
   begin
     OpenFile('c:\test.zip');
     SetProgressCallback(nil, ProgressCallback);
     ...
   end;
 end;

Там один модуль-обертка, никаких компонентов ставить не надо. Куда уж проще-то? Я бы уже 10 раз попробовал, а вы какой-то самопал с перехватами городите. Цель — решить задачу или навелосипедить костылей?