Недавно добавленные исходники

•  DeLiKaTeS Tetris (Тетрис)  3 669

•  TDictionary Custom Sort  5 800

•  Fast Watermark Sources  5 603

•  3D Designer  8 215

•  Sik Screen Capture  5 913

•  Patch Maker  6 388

•  Айболит (remote control)  6 378

•  ListBox Drag & Drop  5 237

•  Доска для игры Реверси  94 551

•  Графические эффекты  6 570

•  Рисование по маске  5 643

•  Перетаскивание изображений  4 759

•  Canvas Drawing  5 135

•  Рисование Луны  4 863

•  Поворот изображения  4 410

•  Рисование стержней  3 116

•  Paint on Shape  2 360

•  Генератор кроссвордов  3 228

•  Головоломка Paletto  2 551

•  Теорема Монжа об окружностях  3 328

•  Пазл Numbrix  2 200

•  Заборы и коммивояжеры  2 849

•  Игра HIP  1 820

•  Игра Go (Го)  1 740

•  Симулятор лифта  2 072

•  Программа укладки плитки  1 798

•  Генератор лабиринта  2 240

•  Проверка числового ввода  1 924

•  HEX View  2 225

•  Физический маятник  1 911

 
скрыть

  Форум  

Delphi FAQ - Часто задаваемые вопросы

| Базы данных | Графика и Игры | Интернет и Сети | Компоненты и Классы | Мультимедиа |
| ОС и Железо | Программа и Интерфейс | Рабочий стол | Синтаксис | Технологии | Файловая система |



Delphi Sources

Как захватить весь вывод в консоли




unit consoleoutput;

interface

uses
  Controls, Windows, SysUtils, Forms;

function GetDosOutput(const CommandLine: string): string;

implementation

function GetDosOutput(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
  Application.ProcessMessages;
  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, PChar(WorkDir), SI, PI);

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

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

end.








Copyright © 2004-2025 "Delphi Sources" by BrokenByte Software. Delphi World FAQ

Группа ВКонтакте