调用外部程序并重定向输入输出（Linux, Free Pascal）

原创已于 2025-09-05 13:04:51 修改 · 511 阅读
0 ·
CC 4.0 BY-SA版权
文章标签：
#linux #FreePascal
于 2022-10-08 00:06:44 首次发布
代码专栏收录该内容
7 篇文章
订阅专栏
本文介绍了一个Free Pascal单元，用于在Linux环境下调用外部程序，并提供了多种标准输入输出重定向的方法，包括使用文件描述符和字符串进行重定向。
调用外部程序并重定向输入输出（Linux, Free Pascal）：
// Process 单元的 RunCommand 无法传入空参数 ''，所以使用自定义的 Run 函数

{ ----------------------------------------------------------------------
功能：执行程序，并重定向标准输入、标准输出、标准错误（会在 PATH 中搜索程序）
参数：
  Cmd    ：要执行的程序及其参数列表。
  FIn    ：用来代替子进程的标准输入的文件，小于 0 则创建管道，并通过 FIn  返回。
  FOut   ：用来代替子进程的标准输出的文件，小于 0 则创建管道，并通过 FOut 返回。
  FErr   ：用来代替子进程的标准错误的文件，小于 0 则创建管道，并通过 FErr 返回。
           如果不想重定向，可以传入 StdInputHandle、StdOutputHandle、StdErrorHandle
  Wait   ：是否等待子进程运行完毕。
           如果 Wait = True ，则成功时返回子进程退出码，失败时返回 -1。
           如果 Wait = False，则成功时返回子进程的 pid，失败时返回 -1。
  Env    ：传递给子进程的新环境变量列表（不包含父进程原有的环境变量）。
  CopyEnv：是否则将父进程的环境变量合并到 Env 中
---------------------------------------------------------------------- }
function Run(
  Cmd      : TStringArray;
  var FIn  : CInt;
  var FOut : CInt;
  var FErr : CInt;
  Wait     : Boolean      = True;
  Env      : TStringArray = nil;
  CopyEnv  : Boolean      = True
): CInt;

  procedure SafeClose(Fd: CInt); inline;
  begin
    // 0、1、2 是标准输入输出文件
    if (Fd > 2) then
      FpClose(Fd);
  end;

var
  SubIn   : CInt;     // 用来代替子进程的标准输入的文件（FIn  可能用于管道返回值）
  SubOut  : CInt;     // 用来代替子进程的标准输出的文件（FOut 可能用于管道返回值）
  SubErr  : CInt;     // 用来代替子进程的标准错误的文件（FErr 可能用于管道返回值）
  HasIn   : Boolean;  // 记录是否创建了相应的管道
  HasOut  : Boolean;  // 记录是否创建了相应的管道
  HasErr  : Boolean;  // 记录是否创建了相应的管道
  Pid     : CInt;     // 子进程 ID
  Status  : CInt;     // 子进程退出状态码
  Len     : Integer;  // 环境变量列表的元素个数
  UpLen   : Integer;  // 父环境变量列表的元素个数
  I       : Integer;  // 循环变量
  Err     : CInt;     // 用于存储 ErrNo 的值
  FExec   : Cint;     // 用于检查子进程是否成功执行的通信管道
  SubExec : Cint;     // 用于检查子进程是否成功执行的通信管道
const
  Fd_CloExec = 1;
begin
  SubIn  := -1;
  SubOut := -1;
  SubErr := -1;

  HasIn  := False;
  HasOut := False;
  HasErr := False;

  FExec   := -1;
  SubExec := -1;

  Pid := -1;  // 后面要根据 Pid 是否小于 0 来进行收尾工作

  try
    // 如果传入了'标准输入'的'文件描述符'，则使用该'文件描述符'
    if FIn >= 0 then
      SubIn := FIn
    else
    // 否则创建管道，AssignPipe 的第 1 个参数是管道的出口，第 2 个参数是管道的入口
    if AssignPipe(SubIn, FIn) = 0 then
      HasIn := True
    else
      Exit(-1);

    if FOut >= 0 then
      SubOut := FOut
    else
    if AssignPipe(FOut, SubOut) = 0 then
      HasOut := True
    else
      Exit(-1);

    if FErr >= 0 then
      SubErr := FErr
    else
    if AssignPipe(FErr, SubErr) = 0 then
      HasErr := True
    else
      Exit(-1);

    // 创建用于检查子进程是否成功执行的通信管道
    if AssignPipe(FExec, SubExec) <> 0 then
      Exit(-1);
    // 让写端在 Exec 成功时自动关闭
    FpFCntl(SubExec, F_SetFd, Fd_CloExec);

    // 创建子进程，子进程会复制父进程所创建的管道
    Pid := FpFork();

    // 如果子进程创建失败，则返回 -1
    if Pid < 0 then
      Exit(-1);

    // 子进程要执行的代码
    if Pid = 0 then
    begin
      // 关闭父进程所需的文件（FIn、FOut、FErr、FExec）
      // 保留子进程所需的文件（SubIn、SubOut、SubErr、SubExec）
      // 不关闭父子共用的文件
      // FIn 不可能是 StdIn，如果是，则必定和 SubIn 相同，而不会被关闭。
      // FOut 和 FErr 同理，也不可能是 StdOut 和 StdErr。
      // 如果 FpClose 的参数无效，则只会返回错误代码，而不会抛出异常
      if FIn  <> SubIn  then FpClose(FIn );
      if FOut <> SubOut then FpClose(FOut);
      if FErr <> SubErr then FpClose(FErr);
      FpClose(FExec);

      // 这里是 Linux 中关于'文件描述符'以及'dup'和'dup2'函数的说明：
      // 文件描述符是一个整数值，每个文件描述符都关联一个打开的文件，
      // 每个进程都有一个文件描述符表来存储这种关联关系。
      // 可以使用 dup 和 dup2 来复制文件描述符。
      //   int dup(int oldfd);
      //   int dup2(int oldfd, int newfd);
      // dup  会创建一个新的描述符，这个新描述符指向 oldfd 所关联的文件。
      // dup2 会将 newfd 指向 oldfd 所关联的文件，如果之前 newfd 已打开，则会先将其关闭。
      // 如果 newfd 等于 oldfd，则 dup2 返回 newfd, 而不关闭它。

      // 如果 SubIn 不是标准输入，则将 SubIn 的文件信息复制给标准输入，
      // 这样读写标准输入就相当于读写 SubIn 了
      if (SubIn >= 0) and (SubIn <> StdInputHandle) then
      begin
        // 执行 FpDup2 后，相当于两个文件描述符同时打开了同一个文件
        if FpDup2(SubIn, StdInputHandle) = -1 then
          ErrHalt('FpDup2(SubIn, StdInputHandle)', ErrNo, 127);
        // 关闭 SubIn，以便其它代码可以重复使用该描述符
        FpClose(SubIn);
      end;

      if (SubOut >= 0) and (SubOut <> StdOutputHandle) then
      begin
        if FpDup2(SubOut, StdOutputHandle) = -1 then
          ErrHalt('FpDup2(SubOut, StdOutputHandle)', ErrNo, 127);
        FpClose(SubOut);
      end;

      if (SubErr >= 0) and (SubErr <> StdErrorHandle) then
      begin
        if FpDup2(SubErr, StdErrorHandle) = -1 then
          ErrHalt('FpDup2(SubErr, StdErrorHandle)', ErrNo, 127);
        FpClose(SubErr);
      end;

      Len := Length(Env);

      // 获取父环境变量的个数（Envp 是 Free Pascal 提供的全局变量）
      UpLen := 0;
      if CopyEnv and (Envp <> nil) then
        while Envp[UpLen] <> nil do
          Inc(UpLen);

      // 环境变量列表必须以 #0 结尾，所以预留一个 #0 位置。
      // 不会影响到调用者的 Env 参数的长度，除非使用 var 修饰符传入。
      SetLength(Env, Len + UpLen + 1);

      if UpLen > 0 then
        for I := 0 to UpLen - 1 do
          Env[Len + I] := Envp[I];

      // 写入最后的 #0（空字符串会自动转换为 nil）
      Env[High(Env)] := '';

      // 子进程要执行的程序
      // FpExec 函数族命名规律：
      // l (list)        使用命令行参数列表，在 Free Pascal 中是数组
      // v (vector)      使用命令行参数数组，在 Free Pascal 中是 PPChar
      // p (path)        从环境变量 PATH 中搜索程序
      // e (environment) 传入自定义环境变量，环境变量通过 PPChar 类型传入
      FpExeclpe(PChar(Cmd[0]), Cmd[1..High(Cmd)], PPChar(Env));

      // 如果子进程执行成功，则会自动关闭 ExecBuf。
      // 如果子进程执行失败，则通过管道向父进程传递 ErrNo
      Err := ErrNo;
      FpWrite(SubExec, Err, SizeOf(Err));
      FpClose(SubExec);

      // 如果 FpExeclp 函数出错，比如 Cmd 不存在，则代码会执行到这里，
      // 这里需要结束子进程，不能使用 Exit 或 Result 返回，
      // 否则会回到调用者代码中继续执行父进程的代码。
      // 这里的退出码已经没有意义了，父进程通过 FExec 得到了 ErrNo。
      Halt(127);
    end
    else
    // 父进程要执行的代码
    if Pid > 0 then
    begin
      // 关闭子进程所需的文件（SubIn、SubOut、SubErr、SubExec）
      // 保留父进程所需的文件（FIn、FOut、FErr、FExec）
      // 不关闭父子共用的文件
      // SubIn 不可能是 StdIn，如果是，则必定和 FIn 相同，而不会被关闭。
      // SubOut 和 SubErr 同理，也不可能是 StdOut 和 StdErr。
      // 如果 FpClose 的参数无效，则只会返回错误代码，而不会抛出异常
      if FIn  <> SubIn  then FpClose(SubIn );
      if FOut <> SubOut then FpClose(SubOut);
      if FErr <> SubErr then FpClose(SubErr);
      FpClose(SubExec);

      // 读取通信管道，直到子进程关闭管道为止
      // 在 Debug 编译模式下会失败，在 Default 或 Release 模式下会成功
      if FpRead(FExec, Err, SizeOf(Err)) = 0 then
        Err := 0;
      FpClose(FExec);

      // 子进程执行失败，返回 -1
      if Err <> 0 then
      begin
        ErrMsg('Failed to exec process: %s', [Cmd[0]], Err);
        Pid := -1;  // 让 finally 代码可以关闭文件
        Exit(-1);
      end;

      // 是否等待子进程结束

      // 正常情况下，如果不等待子进程结束，则当父进程结束后，子进程应该会继续运行，
      // 但是如果在 Lazarus IDE 中启动程序，则当父进程退出时，会杀死子进程，
      // 如果把程序编译完成后执行，而不是在 Lazarus IDE 中执行，则不会出现这个问题。
      if Wait then
      begin
        // FpWaitPid 参数说明

        // 参数 Pid 指定要等待的进程：
        // Pid < -1：等待进程组号为 Pid 绝对值的任何子进程。
        // Pid = -1：等待任何子进程，相当于 Wait() 函数。
        // Pid = 0 ：等待与当前进程同组的任何子进程。
        // Pid > 0 ：等待进程号为 Pid 的子进程。

        // 参数 Status 用于获取子进程的状态信息，Linux 提供了一些宏来解析这个状态信息：
        // WIFEXITED(Status)   如果子进程正常结束，则返回 True；否则返回 False。
        // WEXITSTATUS(Status) 如果 WIFEXITED(Status) 为 True，则可用该宏取得子进程的退出码。
        // WIFSIGNALED(Status) 如果子进程因为一个未捕获的信号而终止，则返回 True；否则返回 False。
        // WTERMSIG(Status)    如果 WIFSIGNALED(Status) 为 True，则可用该宏获得导致子进程终止的信号码。
        // WIFSTOPPED(Status)  如果当前子进程被暂停，则返回 True；否则返回 False。
        // WSTOPSIG(Status)    如果 WIFSTOPPED(Status) 为 True，则可用该宏获得导致子进程暂停的信号码。

        // 最后一个参数 Options 控制 FpWaitPid() 的行为。如果不想控制，则设为 0。
        // WNOHANG    如果子进程没有结束，则 FpWaitPid() 函数不等待，立即返回 0；
        //            如果结束，则返回子进程的进程号。
        // WUNTRACED  如果子进程处于暂停状态，则马上返回。

        // 如果 FpWaitPid() 执行成功，则返回子进程的进程号，
        // 如果出错，则返回 -1，并将出错原因写入 ErrNo 中。
        Status := 0;
        if FpWaitPid(Pid, Status, 0) < 0 then
        begin
          // 字符串拼接操作会修改 ErrNo 的值，所以要提前保存
          Err := ErrNo;
          ErrMsg('FpWaitPid(%d, %d, 0): ', [Pid, Status], Err);
          Exit(-1);
        end;

        // 如果子进程成功退出，则返回退出码，否则返回 -1
        if WIFEXITED(Status) then
          Result := WEXITSTATUS(Status)
        else
          // 被信号杀死
          Result := -1;
      end
      else
        // 如果不等待，则直接返回子进程的 Pid
        Result := Pid;
    end;

  finally

    // 如果子进程或管道创建失败，则关闭所有管道相关文件
    if Pid < 0 then
    begin
      if HasIn then
      begin
        SafeClose(FIn);
        SafeClose(SubIn);
        FIn := -1;
      end;

      if HasOut then
      begin
        SafeClose(FOut);
        SafeClose(SubOut);
        FOut := -1;
      end;

      if HasErr then
      begin
        SafeClose(FErr);
        SafeClose(SubErr);
        FErr := -1;
      end;

      SafeClose(FExec);
      SafeClose(SubExec);
    end;
  end;
end;

{ ----------------------------------------------------------------------
功能：执行程序，使用字符串读写标准输入、标准输出、标准错误
参数：
  Cmd    ：要执行的程序及其参数列表
  SIn    ：用来代替子进程的标准输入的字符串，HasIn 为 False 则不重定向标准输入。
  SOut   ：用来代替子进程的标准输出的字符串，非空则不重定向标准输出。
  SErr   ：用来代替子进程的标准错误的字符串，非空则不重定向标准错误。
  HasIn  ：是否重定向标准输入。
           因为 SIn 为空表示输入空内容，所以需要单独的参数控制是否重定向标准输入。
  Wait   ：是否等待子进程运行完毕。
           如果 Wait = True ，则成功时返回子进程退出码，失败时返回 -1。
           如果 Wait = False，则成功时返回子进程的 pid，失败时返回 -1。
  Env    ：传递给子进程的新环境变量列表（不包含父进程原有的环境变量）。
  CopyEnv：是否则将父进程的环境变量合并到 Env 中
---------------------------------------------------------------------- }
function Run(
  Cmd       : TStringArray;
  const SIn : String;
  var SOut  : String;
  var SErr  : String;
  HasIn     : Boolean      = False;
  Wait      : Boolean      = True;
  Env       : TStringArray = nil;
  CopyEnv   : Boolean      = True
): CInt;

  procedure SafeClose(Fd: CInt); inline;
  begin
    // 0、1、2 是标准输入输出文件
    if (Fd > 2) then
      FpClose(Fd);
  end;

var
  FIn    : CInt;
  FOut   : CInt;
  FErr   : CInt;
  Status : CInt;
  Err    : CInt;
begin
  // -1 表示即将创建管道
  if HasIn     then FIn  := -1 else FIn  := StdInputHandle;
  if SOut = '' then FOut := -1 else FOut := StdOutputHandle;
  if SErr = '' then FErr := -1 else FErr := StdErrorHandle;

  // 如果要输入数据，则不能等待程序执行完毕，否则会被阻塞
  // 此时 Result 是子进程的 PID
  Result := Run(Cmd, FIn, FOut, FErr, False, Env, CopyEnv);

  // 如果 Result < 0，则表示子进程创建失败，此时 FIn、FOut、FErr 都会被设置为 -1，
  // 所以通过 FIn、FOut、FErr 就能判断是否有必要读写数据，不必通过 Result < 0 判断。
  if HasIn and (FIn >= 0) then
  begin
    // 输入数据
    WriteFileDescriptor(FIn, SIn, Err);
    if Err <> 0 then
      ErrMsg('Failed to write StdIn to child process', Err);
    // 输入完数据后，需要关闭输入端，否则子进程会被阻塞
    SafeClose(FIn);
  end;

  if (SOut = '') and (FOut >= 0) then
  begin
    // 读取数据，直到子程序关闭管道输入端
    SOut := ReadFileDescriptor(FOut, Err);
    if Err <> 0 then
      ErrMsg('Failed to read StdOut from child process', Err);
    // 读取完毕后，关闭输出端，以便释放文件描述符
    SafeClose(FOut);
  end;

  if (SErr = '') and (FErr >= 0) then
  begin
    // 读取数据，直到子程序关闭管道输入端
    SErr := ReadFileDescriptor(FErr, Err);
    if Err <> 0 then
      ErrMsg('Failed to read StdErr from child process', Err);
    // 读取完毕后，关闭输出端，以便释放文件描述符
    SafeClose(FErr);
  end;

  // 是否等待子程序执行完毕（子程序在关闭管道后不一定就会退出）
  if Wait then
  begin
    Status := 0;
    if FpWaitPid(Result, Status, 0) < 0 then
    begin
      // 字符串拼接操作会修改 ErrNo 的值，所以要提前保存
      Err := ErrNo;
      ErrMsg('FpWaitPid(%d, %d, 0): ', [Result, Status], Err);
      Exit(-1);
    end;

    if WIFEXITED(Status) then
      Result := WEXITSTATUS(Status)
    else
      Result := -1;
  end;
end;


// 功能：执行程序，不重定向 标准输入、标准输出、标准错误
function Run(
  Cmd     : TStringArray;
  Wait    : Boolean      = True;
  Env     : TStringArray = nil;
  CopyEnv : Boolean      = True
): CInt;
var
  FIn, FOut, FErr : CInt;
begin
  FIn  := StdInputHandle;
  FOut := StdOutputHandle;
  FErr := StdErrorHandle;
  Result := Run(Cmd, FIn, FOut, FErr, Wait, Env, CopyEnv);
end;


// 功能：执行程序，使用字符串写标准输入
function RunIn(
  Cmd       : TStringArray;
  const SIn : String;
  Wait      : Boolean      = True;
  Env       : TStringArray = nil;
  CopyEnv   : Boolean      = True
): CInt;
var
  SOut, SErr : String;
begin
  SOut := '-';
  SErr := '-';
  Result := Run(Cmd, SIn, SOut, SErr, True, Wait, Env, CopyEnv);
end;


// 功能：执行程序，使用字符串读写标准输入、标准输出
function RunInOut(
  Cmd       : TStringArray;
  const SIn : String;
  out SOut  : String;
  Wait      : Boolean      = True;
  Env       : TStringArray = nil;
  CopyEnv   : Boolean      = True
): CInt;
var
  SErr: String;
begin
  SOut := '';
  SErr := '-';
  Result := Run(Cmd, SIn, SOut, SErr, True, Wait, Env, CopyEnv);
end;


// 功能：执行程序，使用字符串读写标准输入、标准错误
function RunInErr(
  Cmd       : TStringArray;
  const SIn : String;
  out SErr  : String;
  Wait      : Boolean      = True;
  Env       : TStringArray = nil;
  CopyEnv   : Boolean      = True
): CInt;
var
  SOut: String;
begin
  SOut := '-';
  SErr := '';
  Result := Run(Cmd, SIn, SOut, SErr, True, Wait, Env, CopyEnv);
end;


// 功能：执行程序，使用字符串读标准输出
function RunOut(
  Cmd      : TStringArray;
  out SOut : String;
  Wait     : Boolean      = True;
  Env      : TStringArray = nil;
  CopyEnv  : Boolean      = True
): CInt;
var
  SIn, SErr: String;
begin
  SIn  := '';
  SOut := '';
  SErr := '-';
  Result := Run(Cmd, SIn, SOut, SErr, False, Wait, Env, CopyEnv);
end;


// 功能：执行程序，使用字符串读标准错误
function RunErr(
  Cmd      : TStringArray;
  out SErr : String;
  Wait     : Boolean      = True;
  Env      : TStringArray = nil;
  CopyEnv  : Boolean      = True
): CInt;
var
  SIn, SOut: String;
begin
  SIn  := '';
  SOut := '-';
  SErr := '';
  Result := Run(Cmd, SIn, SOut, SErr, False, Wait, Env, CopyEnv);
end;


// 功能：执行程序，使用字符串读标准输出、标准错误
function RunOutErr(
  Cmd      : TStringArray;
  out SOut : String;
  out SErr : String;
  Wait     : Boolean      = True;
  Env      : TStringArray = nil;
  CopyEnv  : Boolean      = True
): CInt;
var
  SIn : String;
begin
  SIn  := '';
  SOut := '';
  SErr := '';
  Result := Run(Cmd, SIn, SOut, SErr, False, Wait, Env, CopyEnv);
end;


// 功能：执行程序，丢弃标注输出
function RunNoOut(
  Cmd     : TStringArray;
  Wait    : Boolean      = True;
  Env     : TStringArray = nil;
  CopyEnv : Boolean      = True
): CInt;
var
  SIn, SOut, SErr : String;
begin
  SIn  := '';
  SOut := '';
  SErr := '-';
  Result := Run(Cmd, SIn, SOut, SErr, False, Wait, Env, CopyEnv);
end;


// 功能：执行程序，丢弃标准错误
function RunNoErr(
  Cmd     : TStringArray;
  Wait    : Boolean      = True;
  Env     : TStringArray = nil;
  CopyEnv : Boolean      = True
): CInt;
var
  SIn, SOut, SErr : String;
begin
  SIn  := '';
  SOut := '-';
  SErr := '';
  Result := Run(Cmd, SIn, SOut, SErr, False, Wait, Env, CopyEnv);
end;


// 功能：执行程序，丢弃标准输出、标准错误
function RunNoOutErr(
  Cmd     : TStringArray;
  Wait    : Boolean      = True;
  Env     : TStringArray = nil;
  CopyEnv : Boolean      = True
): CInt;
var
  SIn, SOut, SErr : String;
begin
  SIn  := '';
  SOut := '';
  SErr := '';
  Result := Run(Cmd, SIn, SOut, SErr, False, Wait, Env, CopyEnv);
end;