Question

我需要执行一个＆＃39; DOS＆＃39;程序（控制台应用程序）并动态检索其输出（能够随时结束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＆＃39; DOS”之后冻结。节目结束。我会在发现冻结后立即发布冻结条件。

Answer 1

一个明显的问题是你的烟斗。您有一个管道，并且您安排子进程stdout写入一端，子进程stdin从另一端读取。那不好。为什么要让进程从自己的输出中读取输入？同时父进程从管道中读取。你有两个进程试图读取这个管道。我无法想象这会结束。

你需要两个管道。一个孩子的标准。父母写信给孩子，孩子从中读取。孩子的stdout的另一个管道。父母读到，孩子写信给它。

或者，如果您不希望子进程具有任何stdin，则创建单个管道，将write end连接到子进程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', 'stackoverflow.com -t', 100, DoOutput);
end;

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

执行DOS程序并动态获取输出

1 个答案: