Запустите программу DOS и получите вывод динамически

Question

Мне нужно выполнить программу "DOS" (консольное приложение) и динамически получать ее вывод (было бы также неплохо иметь возможность завершать программу DOS всякий раз, когда я захочу, потому что программа DOS может работать часами).

У меня есть эта функция, но она иногда (редко) зависает. Мне нужна новая функция или исправить нижеприведенную.

procedure ExecuteAndGetOutDyn(CONST ACommand, AParameters: String; AMemo: TMemo);
CONST
  CReadBuffer = 128*KB;  //original was 2400bytes
VAR
  SecurityAttrib: TSecurityAttributes;
  hRead: THandle;
  hWrite: THandle;
  StartupInfo: TStartupInfo;
  ProcessInfo: TProcessInformation;
  pBuffer: array[0..CReadBuffer] of AnsiChar;
  dRead: DWord;
  dRunning: DWord;
  WasOK: Boolean;
begin
  SecurityAttrib.nLength := SizeOf(TSecurityAttributes);
  SecurityAttrib.bInheritHandle := True;
  SecurityAttrib.lpSecurityDescriptor := nil;

  if CreatePipe(hRead, hWrite, @SecurityAttrib, 0) then
   begin
    FillChar(StartupInfo, SizeOf(TStartupInfo), #0);
    StartupInfo.cb         := SizeOf(TStartupInfo);
    StartupInfo.hStdInput  := hRead;
    StartupInfo.hStdOutput := hWrite;
    StartupInfo.hStdError  := hWrite;
    StartupInfo.dwFlags    := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
    StartupInfo.wShowWindow:= SW_HIDE;

    if CreateProcess(NIL, PChar(ACommand + ' ' + AParameters), @SecurityAttrib, @SecurityAttrib, True, NORMAL_PRIORITY_CLASS, NIL, NIL, StartupInfo, ProcessInfo) then
     begin
      REPEAT
        dRunning:= WaitForSingleObject(ProcessInfo.hProcess, 100);
        Application.ProcessMessages;
        REPEAT
          dRead := 0;
          WasOK := Windows.ReadFile(hRead, pBuffer[0], CReadBuffer, dRead, NIL);
          if NOT WasOK then mesajerror('Cannot read console output.');
          pBuffer[dRead] := #0;

          OemToAnsi(pBuffer, (pBuffer));
          AMemo.Lines.Add(String(pBuffer));
        UNTIL (dRead < CReadBuffer) OR NOT WasOK;
      UNTIL (dRunning <> WAIT_TIMEOUT) { OR Abort};
      CloseHandle(ProcessInfo.hProcess);
      CloseHandle(ProcessInfo.hThread);
     end;

    CloseHandle(hRead);
    CloseHandle(hWrite);
   end;
end;

---

Большая проблема заключается в том, что нет определенных условий, при которых процедура замораживается. Я просто вызываю ExecuteAndGetOutDyn и ИНОГДА он зависает после завершения программы 'DOS'. Я опубликую условия, при которых замораживание появится, как только я их обнаружу.

Answer 1

Одна очевидная проблема - твоя труба. У вас есть один канал, и вы организуете, что дочерний процесс stdout выполняет запись в один конец, а дочерний процесс - стандартный вывод, читает из другого. Это не хорошо. Почему вы хотите, чтобы процесс считывал свои данные из своего собственного вывода? И в то же время родительский процесс читает из канала. У вас есть два процесса, пытающихся прочитать этот канал. Я не могу представить, что это хорошо кончается.

Вам нужны две трубы. Один для детского stdin. Родитель пишет в него, ребенок читает из него. И другая труба для ребенка. Ребенок пишет в него, родитель читает.

Или, если вы не хотите, чтобы у дочернего процесса был какой-либо stdin, то создайте один канал, подключите конец записи к дочернему процессу stdout и позвольте родительскому процессу читать из конца чтения.

Другая проблема заключается в том, что если процесс завершился, и вы уже прочитали все его содержимое, вызов ReadFile будет блокировать на неопределенный срок. Вы должны убедиться, что канал содержит что-то, прежде чем пытаться читать с него. Я бы использовал GetFileSizeEx для этого.

Лично я был бы склонен сделать все это внутри потока, чтобы избежать вызова ProcessMessages,

Вы также должны всегда проверять возвращаемые значения API на наличие ошибок. Это не сделано для звонков WaitForSingleObject а также ReadFile,

Я предлагаю что-то вроде этого:

program DynamicStdOutCapture;

{$APPTYPE CONSOLE}

uses
  System.SysUtils,
  System.Math,
  Winapi.Windows;

function GetFileSizeEx(hFile: THandle; var FileSize: Int64): BOOL; stdcall;
  external kernel32;

procedure Execute(const Command: string; const Parameters: string;
  const Timeout: DWORD; const Output: TProc<string>);

const
  InheritHandleSecurityAttributes: TSecurityAttributes =
    (nLength: SizeOf(TSecurityAttributes); bInheritHandle: True);

var
  hReadStdout, hWriteStdout: THandle;
  si: TStartupInfo;
  pi: TProcessInformation;
  WaitRes, BytesRead: DWORD;
  FileSize: Int64;
  AnsiBuffer: array [0 .. 1024 - 1] of AnsiChar;

begin
  Win32Check(CreatePipe(hReadStdout, hWriteStdout,
    @InheritHandleSecurityAttributes, 0));
  try
    si := Default (TStartupInfo);
    si.cb := SizeOf(TStartupInfo);
    si.dwFlags := STARTF_USESTDHANDLES;
    si.hStdOutput := hWriteStdout;
    si.hStdError := hWriteStdout;
    Win32Check(CreateProcess(nil, PChar(Command + ' ' + Parameters), nil, nil,
      True, CREATE_NO_WINDOW, nil, nil, si, pi));
    try
      while True do
      begin
        WaitRes := WaitForSingleObject(pi.hProcess, Timeout);
        Win32Check(WaitRes <> WAIT_FAILED);
        while True do
        begin
          Win32Check(GetFileSizeEx(hReadStdout, FileSize));
          if FileSize = 0 then
          begin
            break;
          end;
          Win32Check(ReadFile(hReadStdout, AnsiBuffer, SizeOf(AnsiBuffer) - 1,
            BytesRead, nil));
          if BytesRead = 0 then
          begin
            break;
          end;
          AnsiBuffer[BytesRead] := #0;
          OemToAnsi(AnsiBuffer, AnsiBuffer);
          if Assigned(Output) then
          begin
            Output(string(AnsiBuffer));
          end;
        end;
        if WaitRes = WAIT_OBJECT_0 then
        begin
          break;
        end;
      end;
    finally
      CloseHandle(pi.hProcess);
      CloseHandle(pi.hThread);
    end;
  finally
    CloseHandle(hReadStdout);
    CloseHandle(hWriteStdout);
  end;
end;

procedure DoOutput(Text: string);
begin
  Write(Text);
end;

procedure Main;
begin
  Execute('ping', 'stackru.com -t', 100, DoOutput);
end;

begin
  try
    Main;
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
end.