Перехват вывода консоли

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.

Взято из https://forum.sources.ru

{
This function runs a program (console or batch) and adds its output
to Memo1
}
 
{....}
  private
    function RunCaptured(const _dirName, _exeName, _cmdLine: string): Boolean;
 
{....}
 
function TForm1.RunCaptured(const _dirName, _exeName, _cmdLine: string): Boolean;
var
  start: TStartupInfo;
  procInfo: TProcessInformation;
  tmpName: string;
  tmp: Windows.THandle;
  tmpSec: TSecurityAttributes;
  res: TStringList;
  return: Cardinal;
begin
  Result := False;
  try
    { Set a temporary file }
    tmpName := 'Test.tmp';
    FillChar(tmpSec, SizeOf(tmpSec), #0);
    tmpSec.nLength := SizeOf(tmpSec);
    tmpSec.bInheritHandle := True;
    tmp := Windows.CreateFile(PChar(tmpName),
           Generic_Write, File_Share_Write,
           @tmpSec, Create_Always, File_Attribute_Normal, 0);
    try
      FillChar(start, SizeOf(start), #0);
      start.cb          := SizeOf(start);
      start.hStdOutput  := tmp;
      start.dwFlags     := StartF_UseStdHandles or StartF_UseShowWindow;
      start.wShowWindow := SW_Minimize;
      { Start the program }
      if CreateProcess(nil, PChar(_exeName + ' ' + _cmdLine), nil, nil, True,
                       0, nil, PChar(_dirName), start, procInfo) then
      begin
        SetPriorityClass(procInfo.hProcess, Idle_Priority_Class);
        WaitForSingleObject(procInfo.hProcess, Infinite);
        GetExitCodeProcess(procInfo.hProcess, return);
        Result := (return = 0);
        CloseHandle(procInfo.hThread);
        CloseHandle(procInfo.hProcess);
        Windows.CloseHandle(tmp);
        { Add the output }
        res := TStringList.Create;
        try
          res.LoadFromFile(tmpName);
          Memo1.Lines.AddStrings(res);
        finally
          res.Free;
        end;
        Windows.DeleteFile(PChar(tmpName));
      end
      else
      begin
        Application.MessageBox(PChar(SysErrorMessage(GetLastError())),
          'RunCaptured Error', MB_OK);
      end;
    except
      Windows.CloseHandle(tmp);
      Windows.DeleteFile(PChar(tmpName));
      raise;
    end;
  finally
  end;
end;
 
 
// Example:
 
procedure TForm1.Button1Click(Sender: TObject);
begin
  RunCaptured('C:\', 'cmd.exe', '/c dir');
end;

Взято с сайта https://www.swissdelphicenter.ch/en/tipsindex.php

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;

Автор: Song

Взято из https://forum.sources.ru

Hужно использовать пайпы (CreatePipe), и работать с ними как с обычным файлом.

const
  H_IN_READ = 1;
  H_IN_WRITE = 2;
  H_OUT_READ = 3;
  H_OUT_WRITE = 4;
  H_ERR_READ = 5;
  H_ERR_WRITE = 6;
 
type
  TPipeHandles = array [1..6] of THandle;
var
  hPipes: TPipeHandles;
  ProcessInfo: TProcessInformation;
 
(************CREATE HIDDEN CONSOLE PROCESS************)
function CreateHiddenConsoleProcess(szChildName: string;
         ProcPriority: DWORD; ThreadPriority: integer): Boolean;
label
  error;
var
  fCreated: Boolean;
  si: TStartupInfo;
  sa: TSecurityAttributes;
begin
  // Initialize handles
  hPipes[ H_IN_READ ] := INVALID_HANDLE_VALUE;
  hPipes[ H_IN_WRITE ] := INVALID_HANDLE_VALUE;
  hPipes[ H_OUT_READ ] := INVALID_HANDLE_VALUE;
  hPipes[ H_OUT_WRITE ] := INVALID_HANDLE_VALUE;
  hPipes[ H_ERR_READ ] := INVALID_HANDLE_VALUE;
  hPipes[ H_ERR_WRITE ] := INVALID_HANDLE_VALUE;
  ProcessInfo.hProcess := INVALID_HANDLE_VALUE;
  ProcessInfo.hThread := INVALID_HANDLE_VALUE;
  // Create pipes
  // initialize security attributes for handle inheritance (for WinNT)
  sa.nLength := sizeof(sa);
  sa.bInheritHandle := TRUE;
  sa.lpSecurityDescriptor := nil;
  // create STDIN pipe
  if not CreatePipe( hPipes[ H_IN_READ ], hPipes[ H_IN_WRITE ], @sa, 0 ) then
    goto error;
  // create STDOUT pipe
  if not CreatePipe( hPipes[ H_OUT_READ ], hPipes[ H_OUT_WRITE ], @sa, 0 ) then
    goto error;
  // create STDERR pipe
  if not CreatePipe( hPipes[ H_ERR_READ ], hPipes[ H_ERR_WRITE ], @sa, 0 ) then
    goto error;
  // process startup information
  ZeroMemory(Pointer(@si), sizeof(si));
  si.cb := sizeof(si);
  si.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
  si.wShowWindow := SW_HIDE;
  // assign "other" sides of pipes
  si.hStdInput := hPipes[ H_IN_READ ];
  si.hStdOutput := hPipes[ H_OUT_WRITE ];
  si.hStdError := hPipes[ H_ERR_WRITE ];
  // Create a child process
  try
    fCreated := CreateProcess( nil, PChar(szChildName), nil, nil, True,
    ProcPriority, // CREATE_SUSPENDED,
    nil, nil, si, ProcessInfo );
  except
    fCreated := False;
  end;
 
  if not fCreated then
    goto error;
 
  Result := True;
  CloseHandle(hPipes[ H_OUT_WRITE ]);
  CloseHandle(hPipes[ H_ERR_WRITE ]);
  // ResumeThread( pi.hThread );
  SetThreadPriority(ProcessInfo.hThread, ThreadPriority);
  CloseHandle( ProcessInfo.hThread );
  Exit;
  //-----------------------------------------------------
  error:
    ClosePipes( hPipes );
    CloseHandle( ProcessInfo.hProcess );
    CloseHandle( ProcessInfo.hThread );
    ProcessInfo.hProcess := INVALID_HANDLE_VALUE;
    ProcessInfo.hThread := INVALID_HANDLE_VALUE;
    Result := False;
end;

DelphiWorld 6.0

Это пример запуска консольных программ с передачей ей консольного ввода (как если бы он был введен с клавиатуры после запуска программы) и чтением консольного вывода. Таким способом можно запускать например стандартный виндовый ftp.exe (в невидимом окне) и тем самым отказаться от использования специализированных, зачастую глючных компонент.

function ExecuteFile(FileName, StdInput: string;
  TimeOut: integer;
  var StdOutput: string): boolean;
 
label
  Error;
 
type
  TPipeHandles = (IN_WRITE, IN_READ,
    OUT_WRITE, OUT_READ,
    ERR_WRITE, ERR_READ);
 
type
  TPipeArray = array[TPipeHandles] of THandle;
 
var
  i: integer;
  ph: TPipeHandles;
  sa: TSecurityAttributes;
  Pipes: TPipeArray;
  StartInf: TStartupInfo;
  ProcInf: TProcessInformation;
  Buf: array[0..1024] of byte;
  TimeStart: TDateTime;
 
  function ReadOutput: string;
  var
    i: integer;
    s: string;
    BytesRead: longint;
 
  begin
    Result := '';
    repeat
 
      Buf[0] := 26;
      WriteFile(Pipes[OUT_WRITE], Buf, 1, BytesRead, nil);
      if ReadFile(Pipes[OUT_READ], Buf, 1024, BytesRead, nil) then
      begin
        if BytesRead > 0 then
        begin
          buf[BytesRead] := 0;
          s := StrPas(@Buf[0]);
          i := Pos(#26, s);
          if i > 0 then
            s := copy(s, 1, i - 1);
          Result := Result + s;
        end;
      end;
 
      if BytesRead1024 then
        break;
    until false;
  end;
 
begin
  Result := false;
  for ph := Low(TPipeHandles) to High(TPipeHandles) do
    Pipes[ph] := INVALID_HANDLE_VALUE;
 
  // Создаем пайпы
  sa.nLength := sizeof(sa);
  sa.bInheritHandle := TRUE;
  sa.lpSecurityDescriptor := nil;
 
  if not CreatePipe(Pipes[IN_READ], Pipes[IN_WRITE], @sa, 0) then
    goto Error;
  if not CreatePipe(Pipes[OUT_READ], Pipes[OUT_WRITE], @sa, 0) then
    goto Error;
  if not CreatePipe(Pipes[ERR_READ], Pipes[ERR_WRITE], @sa, 0) then
    goto Error;
 
  // Пишем StdIn
  StrPCopy(@Buf[0], stdInput + ^Z);
  WriteFile(Pipes[IN_WRITE], Buf, Length(stdInput), i, nil);
 
  // Хендл записи в StdIn надо закрыть - иначе выполняемая программа
  // может не прочитать или прочитать не весь StdIn.
 
  CloseHandle(Pipes[IN_WRITE]);
 
  Pipes[IN_WRITE] := INVALID_HANDLE_VALUE;
 
  FillChar(StartInf, sizeof(TStartupInfo), 0);
  StartInf.cb := sizeof(TStartupInfo);
  StartInf.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
 
  StartInf.wShowWindow := SW_SHOW; // SW_HIDE если надо запустить невидимо
 
  StartInf.hStdInput := Pipes[IN_READ];
  StartInf.hStdOutput := Pipes[OUT_WRITE];
  StartInf.hStdError := Pipes[ERR_WRITE];
 
  if not CreateProcess(nil, PChar(FileName), nil,
    nil, True, NORMAL_PRIORITY_CLASS,
    nil, nil, StartInf, ProcInf) then
    goto Error;
 
  TimeStart := Now;
 
  repeat
    Application.ProcessMessages;
    i := WaitForSingleObject(ProcInf.hProcess, 100);
    if i = WAIT_OBJECT_0 then
      break;
    if (Now - TimeStart) * SecsPerDay > TimeOut then
      break;
  until false;
 
  if iWAIT_OBJECT_0 then
    goto Error;
  StdOutput := ReadOutput;
 
  for ph := Low(TPipeHandles) to High(TPipeHandles) do
    if Pipes[ph]INVALID_HANDLE_VALUE then
      CloseHandle(Pipes[ph]);
 
  CloseHandle(ProcInf.hProcess);
  CloseHandle(ProcInf.hThread);
  Result := true;
  Exit;
 
  Error:
 
  if ProcInf.hProcessINVALID_HANDLE_VALUE then
 
  begin
    CloseHandle(ProcInf.hThread);
    i := WaitForSingleObject(ProcInf.hProcess, 1000);
    CloseHandle(ProcInf.hProcess);
    if iWAIT_OBJECT_0 then
 
    begin
      ProcInf.hProcess := OpenProcess(PROCESS_TERMINATE,
        FALSE,
        ProcInf.dwProcessId);
 
      if ProcInf.hProcess 0 then
      begin
        TerminateProcess(ProcInf.hProcess, 0);
        CloseHandle(ProcInf.hProcess);
      end;
    end;
  end;
 
  for ph := Low(TPipeHandles) to High(TPipeHandles) do
    if Pipes[ph]INVALID_HANDLE_VALUE then
      CloseHandle(Pipes[ph]);
 
end;

Автор: Алексей Бойко

Взято из https://forum.sources.ru