1

最近，我终于设法TMemo使用 Microsoft 的示例将控制台应用程序输出重定向到另一个应用程序的文本字段：https ://docs.microsoft.com/en-us/windows/win32/procthread/creating-a-child-process-with -重定向输入和输出

所有经典示例都运行一个控制台可执行文件，等待它结束，然后读取它的 STDOUT。我想启动一个通常不打算结束的长时间运行的可执行文件，并在新字符可用时立即获取其 STDOUT 流。

我设法修改了这个例子，使读写部分成为一个循环并在一个线程（TProcessExecuterThread.Execute）中运行。现在我怀疑我是否应该使用该线程。

此外，主机在 CR-LF 之前不会收到整个字符串，即使我从管道中获取一个又一个字符（TProcessExecuterThread.ReadFromPipe）。

最后，我担心结束主机会怎样。然后客人应该收到一个终止信号，并在超时后 - 应该被杀死。在哪里（而不是“如何”）组织这个更好？

这是用于测试的控制台访客应用程序：

{$APPTYPE CONSOLE}
program GuestApp;

uses System.SysUtils;

var i: Integer;

begin
  Writeln('Ongoing console output:');
  for i := 0 to 65535 do begin //while True do begin
    if i mod 2 = 0 then Write('*');
    Writeln(Format('Output line %d', [i]));
    Sleep(500);
  end;

end.

这是主机应用程序（对不起，它不短）：

unit Executer;

interface

uses Winapi.Windows, System.Classes, System.Generics.Collections;

type
  TProcessExecuterThread = class(TThread)
  private
    FStdInQueue: TQueue<string>;
    FhChildStdOutRd: THandle;
    FhChildStdInWr: THandle;
    FOnStdOutLog: TGetStrProc;
    procedure ReadFromPipe();
    procedure WriteToPipe();
    procedure StdOutLog(msg: string);
  protected
    procedure Execute(); override;
    property hChildStdOutRd: THandle read FhChildStdOutRd write FhChildStdOutRd;
    property hChildStdInWr: THandle read FhChildStdInWr write FhChildStdInWr;
    property OnstdOutLog: TGetStrProc read FOnStdOutLog write FOnStdOutLog;
  end;

  TProcessExecuter = class
  private const
    BUFSIZE = 4096;
  private
    FhChildStdInRd: THandle;
    FhChildStdInWr: THandle;
    FhChildStdOutRd: THandle;
    FhChildStdOutWr: THandle;
    FOnLog: TGetStrProc;
    FOnStdOutLog: TGetStrProc;
    FExThread: TProcessExecuterThread;
    procedure CreateChildProcess(ACmdLine: string);
    procedure ErrorExit(AFuncName: string);
    procedure Log(msg: string);
    procedure StdOutLog(const msg: string);
    function KillProcess(dwProcID, Wait: DWORD): Integer;
  public
    constructor Create();
    function RunRedirectedProcess(ACmdLine: string): Integer;
    property OnLog: TGetStrProc read FOnLog write FOnLog;
    property OnstdOutLog: TGetStrProc read FOnStdOutLog write FOnStdOutLog;
  end;

implementation

uses System.SysUtils;

procedure TProcessExecuter.Log(msg: string);
begin
  if Assigned(FOnLog) then FOnLog(msg);
end;

procedure TProcessExecuter.StdOutLog(const msg: string);
begin
  if Assigned(FOnStdOutLog) then FOnStdOutLog(msg);
end;

// Format a readable error message, display a message box,
// and exit from the application.
procedure TProcessExecuter.ErrorExit(AFuncName: string);
var msg: string;
    dw: DWORD;
begin
  dw := GetLastError();
  msg := Format('%s failed with error %d: %s', [AFuncName, dw, SysErrorMessage(dw)]);
  Log(msg);
  // ExitProcess(1);
end;

constructor TProcessExecuter.Create();
begin
  FhChildStdInRd := 0;
  FhChildStdInWr := 0;
  FhChildStdOutRd := 0;
  FhChildStdOutWr := 0;
  FExThread := TProcessExecuterThread.Create();
  FExThread.OnstdOutLog := StdOutLog;
end;

// Create a child process that uses the previously created pipes for STDIN and STDOUT.
procedure TProcessExecuter.CreateChildProcess(ACmdLine: string);
var
  piProcInfo: TProcessInformation;
  siStartInfo: TStartupInfo;
  bSuccess: Boolean;
begin
  try
    bSuccess := False;
    FillChar(piProcInfo, SizeOf(TProcessInformation), 0);
    FillChar(siStartInfo, SizeOf(TStartupInfo), 0);
    siStartInfo.cb := SizeOf(TStartupInfo);
    siStartInfo.hStdError := FhChildStdOutWr;
    siStartInfo.hStdOutput := FhChildStdOutWr;
    siStartInfo.hStdInput := FhChildStdInRd;
    siStartInfo.dwFlags := siStartInfo.dwFlags or STARTF_USESTDHANDLES;
    bSuccess := CreateProcess(nil, PWideChar(ACmdLine), nil, nil, True, 0, nil, nil, siStartInfo, piProcInfo);
    if not bSuccess then begin
      ErrorExit('CreateProcess');
      Exit;
    end
    else begin
      CloseHandle(piProcInfo.hProcess);
      CloseHandle(piProcInfo.hThread);
      CloseHandle(FhChildStdOutWr);
      CloseHandle(FhChildStdInRd);
    end;
    FExThread.hChildStdOutRd := FhChildStdOutRd;
    FExThread.hChildStdInWr := FhChildStdInWr;
  except
    on ex: Exception do Log(ex.Message);
  end;
end;

function TProcessExecuter.RunRedirectedProcess(ACmdLine: string): Integer;
var saAttr: SECURITY_ATTRIBUTES;
    i: Integer;
begin
  try
    Log('->Start of parent execution.');
    saAttr.nLength := SizeOf(SECURITY_ATTRIBUTES);
    saAttr.bInheritHandle := True;
    saAttr.lpSecurityDescriptor := 0;
    if not CreatePipe(FhChildStdOutRd, FhChildStdOutWr, @saAttr, 0) then begin
      ErrorExit('StdoutRd CreatePipe');
      Exit;
    end;
    if not SetHandleInformation(FhChildStdOutRd, HANDLE_FLAG_INHERIT, 0) then begin
      ErrorExit('Stdout SetHandleInformation');
      Exit;
    end;
    if not CreatePipe(FhChildStdInRd, FhChildStdInWr, @saAttr, 0) then begin
      ErrorExit('Stdin CreatePipe');
      Exit;
    end;
    if not SetHandleInformation(FhChildStdInWr, HANDLE_FLAG_INHERIT, 0) then begin
      ErrorExit('Stdin SetHandleInformation');
      Exit;
    end;
    CreateChildProcess(ACmdLine);
    //Read/write loop was here
    Log('->End of parent execution.');
    if not CloseHandle(FhChildStdInWr) then begin
      ErrorExit('StdInWr CloseHandle');
      Exit;
    end;
    Result := 0;
  except
    on ex: Exception do Log(ex.Message);
  end;
end;

procedure TProcessExecuterThread.WriteToPipe();
var dwRead, dwWritten: DWORD;
    chBuf: Pointer;
    bSuccess: Boolean;
    line: string;
    bs: Integer;
begin
  bSuccess := False;
  while FStdInQueue.Count > 0 do begin
    line := FStdInQueue.Dequeue();
    bs := (Length(line) + 1) * SizeOf(WideChar);
    GetMem(chBuf, bs);
    try
      StrPCopy(PWideChar(chBuf), line);
      if not WriteFile(FhChildStdInWr, chBuf^, dwRead, dwWritten, nil) then break;
    finally
      FreeMem(chBuf, bs);
    end;
  end;
end;

procedure TProcessExecuterThread.ReadFromPipe();
const BUFSIZE = 1; //4096
var dwRead: DWORD;
    //chBuf: array [0 .. BUFSIZE] of CHAR;
    chBuf: array [0 .. BUFSIZE] of AnsiChar; // Currently only ANSI is possible
    ch: AnsiChar;
    bSuccess: Boolean;
begin
  bSuccess := False;
  while True do begin
    //bSuccess := ReadFile(FhChildStdOutRd, chBuf, BUFSIZE, dwRead, nil);
    bSuccess := ReadFile(FhChildStdOutRd, ch, 1, dwRead, nil);
    if (not bSuccess) or (dwRead = 0) then
      break;
    //StdOutLog(chBuf);
    StdOutLog(ch);
  end;
end;

procedure TProcessExecuterThread.StdOutLog(msg: string);
begin
  if Assigned(FOnStdOutLog) then
    Synchronize(
      procedure()
      begin
        FOnStdOutLog(msg);
      end
    );
end;

procedure TProcessExecuterThread.Execute;
begin
  inherited;
  FStdInQueue := TQueue<string>.Create();
  try
    while not Terminated do begin
      WriteToPipe();
      ReadFromPipe();
    end;
  finally
    FreeAndNil(FStdInQueue);
  end;
end;

end.
4

0 回答 0