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

我需要执行一个“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”程序完成后冻结。一旦我发现冻结出现的情况，我将立即发布这些情况。

一个明显的问题是你的管道。您只有一个管道，并且可以安排子进程stdout写入一端，而子进程stdin从另一端读取。那不好。为什么您希望进程从自己的输出读取其输入？同时，父进程从管道中读取数据。有两个进程试图读取此管道。我无法想象这会有好的结局

你需要两根管子。一个给孩子的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', 'stackoverflow.com -t', 100, DoOutput);
end;

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

---

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

你需要两根管子。一个给孩子的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', 'stackoverflow.com -t', 100, DoOutput);
end;

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

---

你的代码看起来基本上是正确的。我就是这么做的。你的错误检查有点不可靠。WaitForSingleObject可能会失败，在这种情况下，您可能不应该再阅读了。您没有检查ReadFile的返回值，这似乎是不明智的。请注意，这管子全错了。程序的标准输出通过管道输入。你永远不会想要的。通常有两个管道。管道1是从进程到子进程输入的通道。管道2是从孩子的输出返回到你的过程的通道。我不愿意在没有MCV和最后一条评论的情况下尝试回答。您没有执行DOS程序。这些是针对控制台子系统（也称为控制台应用程序）的windows可执行文件。您的调试告诉您什么？代码冻结在哪里？添加一些诊断。OutputDebugString等。您的代码看起来基本正常。我就是这么做的。你的错误检查有点不可靠。WaitForSingleObject可能会失败，在这种情况下，您可能不应该再阅读了。您没有检查ReadFile的返回值，这似乎是不明智的。请注意，这管子全错了。程序的标准输出通过管道输入。你永远不会想要的。通常有两个管道。管道1是从进程到子进程输入的通道。管道2是从孩子的输出返回到你的过程的通道。我不愿意在没有MCV和最后一条评论的情况下尝试回答。您没有执行DOS程序。这些是针对控制台子系统（也称为控制台应用程序）的windows可执行文件。您的调试告诉您什么？代码冻结在哪里？添加一些诊断。OutputDebugStri

---

ng等。对于那些对显示/隐藏DOS窗口感兴趣的人来说，这是一个小小的改变：如果隐藏，则ProCreationFlags:=创建\u否\u窗口+正常\u优先级\u类，否则ProCreationFlags:=创建新的\u进程\u组+正常\u优先级\u类；这是唯一一个对我有效的解决方案，当正在执行的命令不像bat文件中的pause命令那样结束时，它可以防止应用程序冻结。对于那些对显示/隐藏DOS窗口感兴趣的人来说，这是一个小小的改变：如果隐藏，那么ProcCreationFlags:=创建\u否\u窗口+正常\u优先级\u类其他ProcCreationFlags:=创建新流程组+普通优先级类；这是唯一一个对我有效的解决方案，当执行的命令不像bat文件中的pause命令那样结束时，它可以防止应用程序冻结。