调用外部程序并重定向输入输出(Linux, Free Pascal):
unit uRun;
{$mode objFPC}{$H+}
interface
uses
BaseUnix, Unix, Errors;
type
TStringArray = array of String;
// 功能:执行程序,并重定向 标准输入、标准输出、标准错误(会在 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;
// 功能:执行程序,不重定向 标准输入、标准输出、标准错误
function Run(
Cmd : TStringArray;
Wait : Boolean = True;
Env : TStringArray = nil;
CopyEnv : Boolean = True
): CInt;
// 功能:执行程序,使用字符串读写 标准输入、标准输出、标准错误
// 参数:
// Cmd :要执行的程序及其参数列表
// SIn :要代替子进程 标准输入 的字符串,NoIn 为 True 则不重定向 标准输入。
// SOut :要代替子进程 标准输出 的字符串,非空则不重定向 标准输出。
// SErr :要代替子进程 标准错误 的字符串,非空则不重定向 标准错误。
// Wait :是否等待子进程运行完毕。
// 如果 Wait = True ,则成功时返回子进程退出码,失败时返回 -1。
// 如果 Wait = False,则成功时返回子进程的 pid,失败时返回 -1。
// Env :传递给子进程的新环境变量列表(不包含父进程原有的环境变量)。
// CopyEnv:是否则将父进程的环境变量合并到 Env 中
function Run(
Cmd : TStringArray;
SIn : String;
var SOut : String;
var SErr : String;
NoIn : Boolean = False;
Wait : Boolean = True;
Env : TStringArray = nil;
CopyEnv : Boolean = True
): CInt;
// 使用字符串重定向 标准输入
function RunIn(
Cmd : TStringArray;
SIn : String;
Wait : Boolean = True;
Env : TStringArray = nil;
CopyEnv : Boolean = True
): CInt;
// 使用字符串重定向 标准输出
function RunOut(
Cmd : TStringArray;
var SOut : String;
Wait : Boolean = True;
Env : TStringArray = nil;
CopyEnv : Boolean = True
): CInt;
// 使用字符串重定向 标准错误
function RunErr(
Cmd : TStringArray;
var SErr : String;
Wait : Boolean = True;
Env : TStringArray = nil;
CopyEnv : Boolean = True
): CInt;
// 使用字符串重定向 标准输入 和 标准输出
function RunInOut(
Cmd : TStringArray;
SIn : String;
var SOut : String;
Wait : Boolean = True;
Env : TStringArray = nil;
CopyEnv : Boolean = True
): CInt;
// 使用字符串重定向 标准输入 和 标准错误
function RunInErr(
Cmd : TStringArray;
SIn : String;
var SErr : String;
Wait : Boolean = True;
Env : TStringArray = nil;
CopyEnv : Boolean = True
): CInt;
// 使用字符串重定向 标准输出 和 标准错误
function RunOutErr(
Cmd : TStringArray;
var SOut : String;
var SErr : String;
Wait : Boolean = True;
Env : TStringArray = nil;
CopyEnv : Boolean = True
): CInt;
// 执行程序,将 标准输出 重定向到 /dev/null
function RunNoOut(
Cmd : TStringArray;
Wait : Boolean = True;
Env : TStringArray = nil;
CopyEnv : Boolean = True
): CInt;
// 执行程序,将 标准错误 重定向到 /dev/null
function RunNoErr(
Cmd : TStringArray;
Wait : Boolean = True;
Env : TStringArray = nil;
CopyEnv : Boolean = True
): CInt;
// 执行程序,将 标准输出 和 标准错误 重定向到 /dev/null
function RunNoOutErr(
Cmd : TStringArray;
Wait : Boolean = True;
Env : TStringArray = nil;
CopyEnv : Boolean = True
): CInt;
implementation
procedure ErrMsg(Msg: String; Err: Integer); forward;
procedure ErrHalt(Msg: String; Err: Integer; ExitCode: LongInt); forward;
function ReadFile(Fd: CInt; Quiet: Boolean = False): String; forward;
function WriteFile(Fd: CInt; Data: String; Quiet: Boolean = False): Boolean; forward;
function Run(
Cmd : TStringArray;
var FIn : CInt;
var FOut : CInt;
var FErr : CInt;
Wait : Boolean = True;
Env : TStringArray = nil;
CopyEnv : Boolean = True
): CInt;
var
SubIn : CInt; // 要代替子进程 标准输入 的文件(FIn 可能用于管道返回值)
SubOut : CInt; // 要代替子进程 标准输出 的文件(FOut 可能用于管道返回值)
SubErr : CInt; // 要代替子进程 标准错误 的文件(FErr 可能用于管道返回值)
PIn : Boolean; // 记录是否创建了相应的管道
POut : Boolean; // 记录是否创建了相应的管道
PErr : Boolean; // 记录是否创建了相应的管道
Pid : CInt; // 子进程 ID
Status : CInt; // 子进程退出状态码
Len : Integer; // 环境变量列表的元素个数
I : Integer; // 临时变量
S : String; // 临时变量
Err : CInt; // 用于存储 Errno 的值
begin
SubIn := -1;
SubOut := -1;
SubErr := -1;
PIn := False;
POut := False;
PErr := False;
Pid := -1; // 后面要根据 Pid 是否小于 0 来进行收尾工作
try
// 如果传入了 标准输入 的 文件描述符,则使用
if FIn >= 0 then
SubIn := FIn
else
// 否则创建管道,AssignPipe 的第 1 个参数是管道的出口,第 2 个参数是管道的入口
if AssignPipe(SubIn, FIn) = 0 then
PIn := True
else
Exit(-1);
if FOut >= 0 then
SubOut := FOut
else
if AssignPipe(FOut, SubOut) = 0 then
POut := True
else
Exit(-1);
if FErr >= 0 then
SubErr := FErr
else
if AssignPipe(FErr, SubErr) = 0 then
PErr := True
else
Exit(-1);
// 创建子进程,子进程会复制父进程所创建的管道
Pid := FpFork();
// 如果子进程创建失败,则返回 -1
if Pid < 0 then
Exit(-1);
// 子进程要执行的代码
if Pid = 0 then
begin
// 关闭父进程所需的管道端口,只保留子进程所需的管道端口
// 如果 FpClose 的参数无效,则只会返回错误代码,而不会抛出异常
if FIn <> SubIn then FpClose(FIn );
if FOut <> SubOut then FpClose(FOut);
if FErr <> SubErr then FpClose(FErr);
// 这里是 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);
I := 0;
if CopyEnv then
while Envp[I] <> nil do
I += 1;
// 环境变量列表必须以 #0 结尾,所以预留一个 #0 位置。
// 不会影响到调用者的 Env 参数的长度,除非使用 var 修饰符传入。
SetLength(Env, Len + I + 1);
if CopyEnv then
begin
// 将 Envp 最后的 #0 也写入 Env 中
for I := 0 to I do
Env[Len + I] := Envp[I];
end
else
// 写入最后的 #0
PPChar(Env[High(Env)]) := nil;
// 子进程要执行的程序
// 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));
// 如果 FpExeclp 函数出错,比如 Cmd 不存在,则代码会执行到这里,
// 这里需要结束子进程,不能使用 Exit 或 Result 返回,
// 否则会回到调用者代码中继续执行父进程的代码。
Halt(127);
end
else
// 父进程要执行的代码
if Pid > 0 then
begin
// 关闭子进程所需的管道端口,只保留父进程所需的管道端口
// 如果 FpClose 的参数无效,则只会返回错误代码,而不会抛出异常
if FIn <> SubIn then FpClose(SubIn );
if FOut <> SubOut then FpClose(SubOut);
if FErr <> SubErr then FpClose(SubErr);
// 是否等待子进程结束
// 正常情况下,如果不等待子进程结束,则当父进程结束后,子进程应该会继续运行,
// 但是如果在 Lazarus 中启动程序,则当父进程退出时,会杀死子进程,
// 如果把程序编译完成后,在 Shell 中执行,或双击执行,则不会出现这个问题。
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
// WriteStr 或多个字符串相加会修改 Errno 的值,所以要提前保存
Err := Errno;
WriteStr(S, 'FpWaitPid(', Pid, ', ', Status, ', 0)');
ErrMsg(S, 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 PIn then
begin
FpClose(FIn);
FpClose(SubIn);
FIn := -1;
end;
if POut then
begin
FpClose(FOut);
FpClose(SubOut);
FOut := -1;
end;
if PErr then
begin
FpClose(FErr);
FpClose(SubErr);
FErr := -1;
end;
end;
end;
end;
function Run(
Cmd : TStringArray;
Wait : Boolean = True;
Env : TStringArray = nil;
CopyEnv : Boolean = True
): CInt;
var
FIn : CInt;
FOut : CInt;
FErr : CInt;
begin
FIn := StdInputHandle;
FOut := StdOutputHandle;
FErr := StdErrorHandle;
Result := Run(Cmd, FIn, FOut, FErr, Wait, Env, CopyEnv);
end;
function Run(
Cmd : TStringArray;
SIn : String;
var SOut : String;
var SErr : String;
NoIn : Boolean = False;
Wait : Boolean = True;
Env : TStringArray = nil;
CopyEnv : Boolean = True
): CInt;
var
FIn : CInt;
FOut : CInt;
FErr : CInt;
Status : CInt;
Err : CInt;
S : String;
begin
// -1 表示创建管道(允许输入空字符串,#0 表示使用标准输入)
if not NoIn 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,
// 所以这里不必判断 Result < 0 的情况
if (not NoIn) and (FIn >= 0) then
begin
// 输入数据
WriteFile(FIn, SIn);
// 输入完数据后,需要关闭输入端,否则子进程会被阻塞
if not (FIn in [StdInputHandle, StdOutputHandle, StdErrorHandle]) then
FpClose(FIn);
end;
if (SOut = '') and (FOut >= 0) then
begin
// 读取数据,直到子程序关闭管道输入端
SOut := ReadFile(FOut);
// 读取完毕后,关闭输出端,以便释放文件描述符
if not (FOut in [StdInputHandle, StdOutputHandle, StdErrorHandle]) then
FpClose(FOut);
end;
if (SErr = '') and (FErr >= 0) then
begin
// 读取数据,直到子程序关闭管道输入端
SErr := ReadFile(FErr);
// 读取完毕后,关闭输出端,以便释放文件描述符
if not (FErr in [StdInputHandle, StdOutputHandle, StdErrorHandle]) then
FpClose(FErr);
end;
// 是否等待子程序执行完毕(子程序在关闭管道后不一定就会退出)
if Wait then
begin
Status := 0;
if FpWaitPid(Result, Status, 0) < 0 then
begin
// WriteStr 或多个字符串相加会修改 Errno 的值,所以要提前保存
Err := Errno;
WriteStr(S, 'FpWaitPid(', Result, ', ', Status, ', 0)');
ErrMsg(S, Err);
Exit(-1);
end;
if WIFEXITED(Status) then
Result := WEXITSTATUS(Status)
else
Result := -1;
end;
end;
function RunIn(
Cmd : TStringArray;
SIn : String;
Wait : Boolean = True;
Env : TStringArray = nil;
CopyEnv : Boolean = True
): CInt;
var
SOut : String;
SErr : String;
begin
SOut := '-';
SErr := '-';
Result := Run(Cmd, SIn, SOut, SErr, False, Wait, Env, CopyEnv);
end;
function RunOut(
Cmd : TStringArray;
var SOut : String;
Wait : Boolean = True;
Env : TStringArray = nil;
CopyEnv : Boolean = True
): CInt;
var
SIn : String;
SErr: String;
begin
SIn := '';
SOut := '';
SErr := '-';
Result := Run(Cmd, SIn, SOut, SErr, True, Wait, Env, CopyEnv);
end;
function RunErr(
Cmd : TStringArray;
var SErr : String;
Wait : Boolean = True;
Env : TStringArray = nil;
CopyEnv : Boolean = True
): CInt;
var
SIn : String;
SOut: String;
begin
SIn := '';
SOut := '-';
SErr := '';
Result := Run(Cmd, SIn, SOut, SErr, True, Wait, Env, CopyEnv);
end;
function RunInOut(
Cmd : TStringArray;
SIn : String;
var SOut : String;
Wait : Boolean = True;
Env : TStringArray = nil;
CopyEnv : Boolean = True
): CInt;
var
SErr: String;
begin
SOut := '';
SErr := '-';
Result := Run(Cmd, SIn, SOut, SErr, False, Wait, Env, CopyEnv);
end;
function RunInErr(
Cmd : TStringArray;
SIn : String;
var SErr : String;
Wait : Boolean = True;
Env : TStringArray = nil;
CopyEnv : Boolean = True
): CInt;
var
SOut: String;
begin
SOut := '-';
SErr := '';
Result := Run(Cmd, SIn, SOut, SErr, False, Wait, Env, CopyEnv);
end;
function RunOutErr(
Cmd : TStringArray;
var SOut : String;
var 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, True, Wait, Env, CopyEnv);
end;
function RunNoOut(
Cmd : TStringArray;
Wait : Boolean = True;
Env : TStringArray = nil;
CopyEnv : Boolean = True
): CInt;
var
SIn : String;
SOut: String;
SErr: String;
begin
SIn := '';
SOut := '';
SErr := '-';
Result := Run(Cmd, SIn, SOut, SErr, True, Wait, Env, CopyEnv);
end;
function RunNoErr(
Cmd : TStringArray;
Wait : Boolean = True;
Env : TStringArray = nil;
CopyEnv : Boolean = True
): CInt;
var
SIn : String;
SOut: String;
SErr: String;
begin
SIn := '';
SOut := '-';
SErr := '';
Result := Run(Cmd, SIn, SOut, SErr, True, Wait, Env, CopyEnv);
end;
function RunNoOutErr(
Cmd : TStringArray;
Wait : Boolean = True;
Env : TStringArray = nil;
CopyEnv : Boolean = True
): CInt;
var
SIn : String;
SOut: String;
SErr: String;
begin
SIn := '';
SOut := '';
SErr := '';
Result := Run(Cmd, SIn, SOut, SErr, True, Wait, Env, CopyEnv);
end;
// 输出错误消息,显示 Errno 的字符串解释
procedure ErrMsg(Msg: String; Err: CInt);
begin
WriteLn(StdErr, 'Error: ' + Msg + ': ' + StrError(Err));
end;
// 输出错误消息,显示 Errno 的字符串解释,并终止程序
procedure ErrHalt(Msg: String; Err: CInt; ExitCode: LongInt);
begin
WriteLn(StdErr, 'Error: ' + Msg + ': ' + StrError(Err));
Halt(ExitCode);
end;
// 读取文件内容到字符串中(Fd 为文件描述符)
// 由于使用了缓存,必须在关闭文件后,才能读取所写入的文件内容
function ReadFile(Fd: CInt; Quiet: Boolean = False): String;
var
Len: TSsize; // 已读出的数据总长度
Ret: TSsize; // 当前读出的数据长度
Err: CInt;
const
BUFSIZE = 1024;
begin
Result := '';
Len := 0;
Ret := 0;
repeat
// 放在前面,避免增加负的返回值
Len += Ret;
// 自动扩容
if Len + BUFSIZE > Length(Result) then
begin
// 不大于 16MB,翻倍预留,大于 16M 预留 16M,避免反复申请内存
if Len <= 16 * 1024 * 1024 then
SetLength(Result, Len * 2 + BUFSIZE) // 保证最小不小于 BUFSIZE
else
SetLength(Result, Len + 16 * 1024 * 1024 + BUFSIZE);
end;
// FpRead 在读到 EOF 时会返回 0
Ret := FpRead(Fd, PChar(Result)[Len], BUFSIZE);
until Ret <= 0;
if (Ret < 0) and (not Quiet) then
begin
// 多个字符串相加会修改 Errno 的值,所以提前保存
Err := Errno;
ErrMsg('FpRead()', Err);
end;
SetLength(Result, Len);
end;
// 将字符串写入文件(Fd 为文件描述符)
function WriteFile(Fd: CInt; Data: String; Quiet: Boolean = False): Boolean;
var
Len: TSsize; // 已写入的数据总长度
Ret: TSsize; // 当前写入的数据长度
Err: CInt;
begin
Len := 0;
Ret := 1;
while (Ret > 0) and (Len < Length(Data)) do
begin
Ret := FpWrite(Fd, PChar(Data)[Len], Length(Data) - Len);
Len += Ret;
end;
if (Ret < 0) and (not Quiet) then
begin
Err := Errno;
ErrMsg('FpWrite()', Err);
end;
Result := Len = Length(Data);
end;
end.