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

[hexor_boo]

Всем доброго времени суток!

Да, я знаю, что тема перехвата вывода консоли не нова. И в интернете полно вариантов, как это можно сделать. Однако. Из того что я нашёл все варианты "ждут", пока консоль завершится и выводят результат уже после этого.

Мне нужно запустить консольный архиватор 7z.exe - он в консоли отображает прогресс упаковки (сколько файлов упаковано и процент сжатия, если не ошибаюсь).

Результатом консоли после закрытия будет что-то вроде "Упаковано K файлов. Объём архива L байт."

А мне, в том-то и дело - нужно чтобы пользователь видел прогресс. И информацию с самого начала работы архиватора.

Последний код, который я тестировал (с выводом после завершения процесса консоли) - вот:

procedure RunDosInMemo(CmdLine: string; AMemo: TMemo);
const
  ReadBuffer = 2400;
var
  Security: TSecurityAttributes;
  ReadPipe, WritePipe: THandle;
  start: TStartUpInfo;
  ProcessInfo: TProcessInformation;
  Buffer: Pchar;
  BytesRead: DWord;
  Apprunning: DWord;
begin
  Screen.Cursor := CrHourGlass;
  frmMain.btnRun.Enabled := False;
  with Security do
  begin
    nlength := SizeOf(TSecurityAttributes);
    binherithandle := true;
    lpsecuritydescriptor := nil;
  end;
  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.hStdInput := ReadPipe;
    start.dwFlags := STARTF_USESTDHANDLES +
      STARTF_USESHOWWINDOW;
    start.wShowWindow := SW_SHOW;
 
    if CreateProcess(nil,
      PChar(CmdLine),
      @Security,
      @Security,
      true,
      NORMAL_PRIORITY_CLASS,
      nil,
      nil,
      start,
      ProcessInfo) then
    begin
      repeat
        Apprunning := WaitForSingleObject
          (ProcessInfo.hProcess, 100);
        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);
    end;
    FreeMem(Buffer);
    CloseHandle(ProcessInfo.hProcess);
    CloseHandle(ProcessInfo.hThread);
    CloseHandle(ReadPipe);
    CloseHandle(WritePipe);
  end;
  Screen.Cursor := CrDefault;
  frmMain.btnRun.Enabled := True;
end;

[FaTaL]

Может лучше использовать TSevenZipVCL ?

[northener]

Когда-то вот так делал вывод в Мемо, то что должна была выводить в консоль утилита gbak от Interbase/Firebird. Работает как надо.

function TDBProp.GetConsoleOutput(const CommandLine:string): string;
var
  SA: TSecurityAttributes;
  SI: TStartupInfo;
  PI: TProcessInformation;
  StdOutPipeRead, StdOutPipeWrite: THandle;
  WasOK: Boolean;
  Buffer: array[0..255] of Char;
  BytesRead: Cardinal;
  WorkDir, Line: String;
begin
  with SA do
  begin
    nLength := SizeOf(SA);
    bInheritHandle := True;
    lpSecurityDescriptor := nil;
  end;
  // создаём пайп для перенаправления стандартного вывода
  CreatePipe(StdOutPipeRead,  // дескриптор чтения
             StdOutPipeWrite, // дескриптор записи
             @SA,              // аттрибуты безопасности
             0                // количество байт принятых для пайпа - 0 по умолчанию
             );
  try
    // Создаём дочерний процесс, используя StdOutPipeWrite в качестве стандартного вывода,
    // а так же проверяем, чтобы он не показывался на экране.
    with SI do
    begin
      FillChar(SI, SizeOf(SI), 0);
      cb := SizeOf(SI);
      dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
      wShowWindow := SW_HIDE;
      hStdInput := GetStdHandle(STD_INPUT_HANDLE); // стандартный ввод не перенаправляем
      hStdOutput := StdOutPipeWrite;
      hStdError := StdOutPipeWrite;
    end;

    // Запускаем утилиту из командной строки
    WorkDir := ExtractFilePath(CommandLine);
    WasOK := CreateProcess(nil, PChar(CommandLine), nil, nil, True, 0, nil, nil {PChar(WorkDir)}, SI, PI);

    // Теперь, когда дескриптор получен, для безопасности закрываем запись.
    // Нам не нужно, чтобы произошло случайное чтение или запись.
    CloseHandle(StdOutPipeWrite);
    // если процесс может быть создан, то дескриптор, это его вывод
    if not WasOK then
      raise Exception.Create('Could not execute command line!')
    else
      try
        Screen.Cursor:=crHourGlass;
        // получаем весь вывод до тех пор, пока консольное-приложение не будет завершено
        Line := '';
        repeat
          // читаем блок символов (могут содержать возвраты каретки и переводы строки)
          WasOK := ReadFile(StdOutPipeRead, Buffer, 255, BytesRead, nil);

          // есть ли что-нибудь ещё для чтения?
          if BytesRead > 0 then
          begin
            // завершаем буфер PChar-ом
            Buffer[BytesRead] := #0;
            // добавляем буфер в общий вывод
            LogMemo.Text:=LogMemo.Text+Buffer;
            SendMessage(LogMemo.Handle, WM_VSCROLL, SB_BOTTOM, 0);
            LogMemo.Repaint;
            //Line := Line + Buffer;
          end;
        until not WasOK or (BytesRead = 0);
        // ждём, пока завершится консольное приложение
        WaitForSingleObject(PI.hProcess, INFINITE);
      finally
        // Закрываем все оставшиеся дескрипторы
        CloseHandle(PI.hThread);
        CloseHandle(PI.hProcess);
        Screen.Cursor:=crDefault;
      end;
  finally
      result:=Line;
      CloseHandle(StdOutPipeRead);
  end;
end;

Там есть артефакты от различных проб и ощибок. Но они все закомментированы.

[hexor_boo]

2 northener, не работает - выводит в memo текст только после завершения консольного приложения. Как и опробованный мною до этого вариант. Проверяю элементарно - добавляю в папку заведомо большой файл (~700Мб) - программа виснет с курсором "песочные часы" и ничего не выводит в memo.

2 FaTaL, благодарю! На крайний случай взял на заметку. Однако не могу исключить такого варианта, что мне понадобится вывод какой-либо другой консольной софтины (с такой же трудоёмкостью - изменяет что-то в окне консоли).

[northener]

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

2 northener, не работает - выводит в memo текст только после завершения консольного приложения.

Этот мой код в моей задаче работает. Что именно не работает у вас я не знаю. Поскольку вы не привели ваш код для вашей задачи на основе моего примера.

[hexor_boo]

Попробовал поставить JEDI Code Library. С методом JCLSysUtils.Execute та же фигня - он срабатывает только при завершении консольного приложения.

[Vapaamies]

С одним из обновлений в Windows 10 появился полноценный программный терминал (TTY), предназначенный как раз для подобных нужд. Реализуется функцией CreatePseudoConsole. Теория расписана на Хабре. Как следует из определения, работать будет только на Windows 10 версии 1809 и старше. Сам не пользовал.

[hexor_boo]

2 northener,

Код функции:

function TfrmMain.GetConsoleOutput(const CommandLine:string): string;
var
  SA: TSecurityAttributes;
  SI: TStartupInfo;
  PI: TProcessInformation;
  StdOutPipeRead, StdOutPipeWrite: THandle;
  WasOK: Boolean;
  Buffer: array[0..255] of Char;
  BytesRead: Cardinal;
  WorkDir, Line: String;
begin
  with SA do
  begin
    nLength := SizeOf(SA);
    bInheritHandle := True;
    lpSecurityDescriptor := nil;
  end;
  // создаём пайп для перенаправления стандартного вывода
  CreatePipe(StdOutPipeRead,  // дескриптор чтения
             StdOutPipeWrite, // дескриптор записи
             @SA,              // аттрибуты безопасности
             0                // количество байт принятых для пайпа - 0 по умолчанию
             );
  try
    // Создаём дочерний процесс, используя StdOutPipeWrite в качестве стандартного вывода,
    // а так же проверяем, чтобы он не показывался на экране.
    with SI do
    begin
      FillChar(SI, SizeOf(SI), 0);
      cb := SizeOf(SI);
      dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
      wShowWindow := SW_HIDE;
      hStdInput := GetStdHandle(STD_INPUT_HANDLE); // стандартный ввод не перенаправляем
      hStdOutput := StdOutPipeWrite;
      hStdError := StdOutPipeWrite;
    end;

    // Запускаем утилиту из командной строки
    WorkDir := ExtractFilePath(CommandLine);
    WasOK := CreateProcess(nil, PChar(CommandLine), nil, nil, True, 0, nil, nil {PChar(WorkDir)}, SI, PI);

    // Теперь, когда дескриптор получен, для безопасности закрываем запись.
    // Нам не нужно, чтобы произошло случайное чтение или запись.
    CloseHandle(StdOutPipeWrite);
    // если процесс может быть создан, то дескриптор, это его вывод
    if not WasOK then
      raise Exception.Create('Could not execute command line!')
    else
      try
        Screen.Cursor:=crHourGlass;
        // получаем весь вывод до тех пор, пока консольное-приложение не будет завершено
        Line := '';
        repeat
          // читаем блок символов (могут содержать возвраты каретки и переводы строки)
          WasOK := ReadFile(StdOutPipeRead, Buffer, 255, BytesRead, nil);

          // есть ли что-нибудь ещё для чтения?
          if BytesRead > 0 then
          begin
            // завершаем буфер PChar-ом
            Buffer[BytesRead] := #0;
            // добавляем буфер в общий вывод
            memLog.Text:=memLog.Text+Buffer;
            SendMessage(memLog.Handle, WM_VSCROLL, SB_BOTTOM, 0);
            memLog.Repaint;
            //Line := Line + Buffer;
          end;
        until not WasOK or (BytesRead = 0);
        // ждём, пока завершится консольное приложение
        WaitForSingleObject(PI.hProcess, INFINITE);
      finally
        // Закрываем все оставшиеся дескрипторы
        CloseHandle(PI.hThread);
        CloseHandle(PI.hProcess);
        Screen.Cursor:=crDefault;
      end;
  finally
      result:=Line;
      CloseHandle(StdOutPipeRead);
  end;
end;

Вызываю так:

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

1) Если размер потенциального архива - маленький - отрабатывает и отображает всё, что выводит консольная программа 7z.exe
2) А вот если в папку закинуть 700Мб файл - висит с изображением курсора в виде песочных часов

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

memLog.Text:=memLog.Text+Buffer;

на

memLog.Text:=Buffer;

не помогает.

Если это имеет значение - код проверяю в Delphi 7

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

С одним из обновлений в Windows 10 появился полноценный программный терминал (TTY), предназначенный как раз для подобных нужд. Реализуется функцией CreatePseudoConsole. Теория расписана на Хабре. Как следует из определения, работать будет только на Windows 10 версии 1809 и старше. Сам не пользовал.

Я под Windows 7 x32 Delphi 7

Есть ли вероятность того, что для реализации нужно патчить значения в памяти?

[hexor_boo]

Отдалённо похожее на то, что надо, только пока не понял как сделать годное из этого

Если у кого-то есть желание потестить - это нужно делать именно с консольной программой 7z.exe - она работает по-особенному.

[Vapaamies]

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

2) А вот если в папку закинуть 700Мб файл - висит с изображением курсора в виде песочных часов

Если дело конкретно в консольном 7-Zip — у него есть ключ -bb, заставляющий выводить имена файлов друг за другом, как принято у других архиваторов. Но если упаковывается файл большого объема, прогресс будет выводиться в одной строчке с заменой, да. Его можно вообще запретить ключом -bsp0.

Для замены значения в строке консоли обычно выводят код #13 без #10. В теории этот момент можно было бы ловить, но, похоже, 7-Zip определяет, выводится ли прогресс в экранную консоль или в файл, и в файл ничего не выводит (предполагаю). То есть, перехват вывода равносилен отключению прогресса. В этом случае никак не поможешь, наверное.

А что, если перейти на использование библиотеки? Раз предполагается наличие установленного 7-Zip по заданному пути или доступным через PATH, по нему будет лежать и 7z.dll, который всё реализует. Через PATH он сам найдется, иначе заданный путь можно в функцию передать, то есть класть DLL рядом с программой не придется.