Delphi实现外部程序双向交互：PeekNamedPipe挂起问题排查

核心问题分析 #

你的代码在PeekNamedPipe处挂起，根源是管道方向完全搞反，同时存在循环逻辑错误：

1. 管道方向错误

   • CreatePipe(ReadHandle, WriteHandle, ...)的规则是：第一个参数为管道读端，第二个为写端。
   • 正确逻辑：父进程要读取子进程的输出，应该从OutputPipeRead（子进程写入OutputPipeWrite）读取，但你的代码错误地对InputPipeRead（子进程的输入源）执行PeekNamedPipe——子进程只会从这个管道读取数据，不会写入，导致父进程无限等待无意义的输入，引发挂起。

2. 循环逻辑混乱

   • 内层repeat until (dRead < CReadBuffer)的条件完全错误：当管道无数据时dRead=0，满足0 < 2400，会导致内层循环无限执行；加上sleep(1000)和Application.ProcessMessages，看似未卡死但逻辑完全失效。
   • ACount的多层break条件冲突，导致程序无法正常退出循环。

3. 句柄管理疏漏

   • 父进程私有句柄（如OutputPipeRead、InputPipeWrite）未设置为不继承，可能导致子进程意外持有这些句柄，影响管道正常关闭。
   • 代码仅关闭3个管道句柄，剩余3个未关闭，造成系统资源泄漏。

修正后的代码 #

var
  InputPipeRead,
  OutputPipeRead,
  ErrorPipeRead,
  InputPipeWrite,
  OutputPipeWrite,
  ErrorPipeWrite: THandle;

procedure DoStart3;
const
  CReadBuffer = 2400;
var
  saSecurity: TSecurityAttributes;
  suiStartup: TStartupInfo;
  piProcess: TProcessInformation;
  pBuffer: array[0..CReadBuffer] of AnsiChar;
  dRead, dRunning, dWritten: DWord;
  Command: String;
  BytesLeft, BytesAvail: Integer;
  bPeekSuccess: Boolean;
begin
  saSecurity.nLength := SizeOf(TSecurityAttributes);
  saSecurity.bInheritHandle := True;
  saSecurity.lpSecurityDescriptor := nil;

  // 创建三个管道：输入（父写子读）、输出（子写父读）、错误输出（子写父读）
  if not CreatePipe(InputPipeRead, InputPipeWrite, @saSecurity, 0) then Exit;
  if not CreatePipe(OutputPipeRead, OutputPipeWrite, @saSecurity, 0) then Exit;
  if not CreatePipe(ErrorPipeRead, ErrorPipeWrite, @saSecurity, 0) then Exit;

  try
    // 设置父进程私有句柄不被继承，避免子进程误持有
    SetHandleInformation(OutputPipeRead, HANDLE_FLAG_INHERIT, 0);
    SetHandleInformation(ErrorPipeRead, HANDLE_FLAG_INHERIT, 0);
    SetHandleInformation(InputPipeWrite, HANDLE_FLAG_INHERIT, 0);

    FillChar(suiStartup, SizeOf(TStartupInfo), #0);
    suiStartup.cb := SizeOf(TStartupInfo);
    suiStartup.hStdInput := InputPipeRead;
    suiStartup.hStdOutput := OutputPipeWrite;
    suiStartup.hStdError := ErrorPipeWrite;
    suiStartup.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
    suiStartup.wShowWindow := SW_HIDE;

    Command := 'C:\RMS Express\pat.exe interactive';
    UniqueString(Command);

    if CreateProcess(nil, PChar(Command), @saSecurity, @saSecurity, True,
        NORMAL_PRIORITY_CLASS, nil, nil, suiStartup, piProcess) then
    begin
      try
        Log('CreateProcess 启动成功');
        repeat
          // 等待子进程，超时100ms避免阻塞UI
          dRunning := WaitForSingleObject(piProcess.hProcess, 100);
          Application.ProcessMessages;

          // 检查子进程输出管道
          dRead := 0;
          bPeekSuccess := PeekNamedPipe(OutputPipeRead, @pBuffer, CReadBuffer, @dRead, @BytesAvail, @BytesLeft);
          if not bPeekSuccess then
          begin
            Log('PeekNamedPipe 失败: ' + SysErrorMessage(GetLastError));
            Break;
          end;

          if dRead > 0 then
          begin
            // 读取子进程输出
            if ReadFile(OutputPipeRead, pBuffer[0], dRead, dRead, nil) then
            begin
              pBuffer[dRead] := #0;
              OemToCharA(pBuffer, pBuffer);
              Log('子进程输出: ' + string(pBuffer));
            end;
          end;

          // 示例：给子进程发送命令（按需启用）
          // const SendCmd: AnsiString = 'your_command_here'#13#10;
          // if WriteFile(InputPipeWrite, PAnsiChar(SendCmd), Length(SendCmd), dWritten, nil) then
          //   Log('已发送命令: ' + SendCmd);

          // 避免循环过于频繁
          Sleep(100);
        until dRunning <> WAIT_TIMEOUT;

        Log('子进程已退出');
      finally
        CloseHandle(piProcess.hProcess);
        CloseHandle(piProcess.hThread);
      end;
    end
    else
      Log('CreateProcess 失败: ' + SysErrorMessage(GetLastError));
  finally
    // 确保所有管道句柄都被关闭
    CloseHandle(InputPipeRead);
    CloseHandle(InputPipeWrite);
    CloseHandle(OutputPipeRead);
    CloseHandle(OutputPipeWrite);
    CloseHandle(ErrorPipeRead);
    CloseHandle(ErrorPipeWrite);
  end;
end;

关键修正点说明 #

• 管道方向修正：改为从OutputPipeRead读取子进程输出，符合双向通信逻辑，解决PeekNamedPipe挂起问题。
• 句柄继承控制：用SetHandleInformation标记父进程私有句柄不被继承，避免子进程误持有导致管道异常。
• 循环逻辑简化：去掉混乱的ACount判断，改为以子进程状态为循环终止条件，逻辑更清晰。
• 资源泄漏修复：用try...finally确保所有句柄和进程资源被正确释放。
• 调试信息完善：添加错误信息日志，方便定位问题。

内容的提问来源于stack exchange，提问作者Bart Kindt