Как вывести результат работы консоли в Memo

Delphi , ОС и Железо , DOS и Консоль

Автор: Song
WEB-сайт: http://www.torry.net

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;
  Form1.Button1.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_HIDE;

    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;
  Form1.Button1.Enabled := True;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Memo1.Clear;
  RunDosInMemo('ping -t 192.168.28.200', Memo1);
end;

Протцедура RunDosInMemo предназначена для запуска командной программы (в этом случае встроенной в Windows программы ping) и отображения ее вывода в компоненте TMemo.

Следующий способ работы:

1. Процедура создает трубу для чтения из процесса и другую для записи в нее.
2. Она выделяет память для буфера, чтобы хранить вывод программы.
3. Она инициализирует структуру TStartUpInfo с информацией о программе, которую нужно запустить, включая ее командную строку аргументов и стандартные handles ввода/вывода.
4. Процедура создает новый процесс с помощью функции CreateProcess, передавая в нее командную строку аргументы и информацию о старте.
5. Пока процесс запущен, она повторно читает из трубы и добавляет вывод к тексту компонента TMemo.

Событийный обработчик кнопки Button1Click очищает компонент TMemo и затем вызывает RunDosInMemo с аргументом командной строки 'ping -t 192.168.28.200'.

Чтобы модифицировать это код для отображения вывода в компоненте TMemo, можно использовать следующий подход:

Вместо прямого присваивания буфера вывода тексту компонента TMemo, можно добавить его к линиям компонента TMemo с помощью метода Lines.Add. Это позволит сохранить любую форматирование или разрывы строк в оригинальном выводе.

Вот обновленная версия процедуры RunDosInMemo:

procedure RunDosInMemo(CmdLine: string; AMemo: TMemo);
   ...
begin
  repeat
    Apprunning := WaitForSingleObject(ProcessInfo.hProcess, 100);
    ReadFile(ReadPipe, Buffer[0], ReadBuffer, BytesRead, nil);
    Buffer[BytesRead] := #0;
    OemToAnsi(Buffer, Buffer);
    AMemo.Lines.Add(string(Buffer)); // Добавить вывод к линиям компонента
    Application.ProcessMessages;
  until (Apprunning <> WAIT_TIMEOUT);
end;

Используя Lines.Add, можно сохранить любое форматирование или разрывы строк в оригинальном выводе и отобразить его корректно в компоненте TMemo.

В статье описывается процедура для вывода результатов работы консоли в текстовом поле Memo при помощи создания pipe и использования функции CreateProcess для запуска процесса с указанным командным строковым параметром.

Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS

:: Главная :: DOS и Консоль ::