Executing External Programs/zh CN

From Free Pascal wiki
Jump to navigationJump to search

Deutsch (de) English (en) español (es) français (fr) italiano (it) 日本語 (ja) Nederlands (nl) polski (pl) português (pt) русский (ru) slovenčina (sk) 中文(中国大陆) (zh_CN)

执行外部程序

概述:对比

以下是 RTL、FCL 和 LCL 库中执行外部命令/进程/程序的各种方法。

方法 平台 可单行完成 功能
ExecuteProcess RTL 跨平台 非常有限,以同步方式执行
ShellExecute WinAPI 仅限微软的 Windows 系统 很多。能够提权启动需管理员权限的程序。
fpsystem、fpexecve Unix 仅限 Unix 系统
TProcess FCL 跨平台 完整
RunCommand FCL 跨平台 需要FPC 2.6.2+ 支持常用的 TProcess 用法
OpenDocument LCL 跨平台 只能打开文档。将会用该文档类型关联的应用程序打开。

(Process.)RunCommand

FPC 2.6.2 为 process 单元的 TProcess 加入了一些有用的函数,来自 fpcup 项目的封装。 这些函数适用于初、中级应用,能将输出捕获到单个字符串中,并完全支持大数据量输出

以下是简单示例:

program project1;

{$mode objfpc}{$H+}

uses 
  Process;

var 
  s : ansistring;

begin

if RunCommand('/bin/bash',['-c','echo $PATH'],s) then
   writeln(s); 

end.

但请注意,并不是所有 shell“内置”命令(如 alias)都能支持,因为默认情况下,在非交互式 shell 中不会用到别名。除非设置了 BASH_ENV 环境变量,不然非交互式 shell 也不会读取 .bashrc 文件。因此,以下代码不会输出任何结果:

program project2;

{$mode objfpc}{$H+}

uses 
  Process;

var 
  s : ansistring;

begin

if RunCommand('/bin/bash',['-c','alias'],s) then
  writeln(s); 

end.

RunCommand 有一个重载版本,可返回程序的退出码。RunCommandInDir 则可在指定目录中运行命令(设置 p.CurrentDirectory):

function RunCommandIndir(const curdir:string;const exename:string;const commands:array of string;var outputstring:string; var exitstatus:integer): integer;
function RunCommandIndir(const curdir:string;const exename:string;const commands:array of string;var outputstring:string): boolean;
function RunCommand(const exename:string;const commands:array of string;var outputstring:string): boolean;

在 FPC 3.2.0 以上版本中,Runcommand 有了新的版本,允许覆盖 TProcessOptions 和 TShowWindowOptions。


RunCommand 的扩展版本

FPC 3.2.0 以上版本中,RunCommand 实现了泛型化,并重新归入了 TProcess,以便能更迅速地构建自己的 RunCommand。以下是带有超时机制的 RunCommand:

program TestTProcessTimeout;

uses classes, sysutils, process, dateutils;

type
 { TProcessTimeout }
 TProcessTimeout = class(TProcess)
                   protected
                     timeoutperiod: TTime;
                     timedout : boolean;
                     started : TDateTime;
                     procedure LocalnIdleSleep(Sender,Context : TObject;status:TRunCommandEventCode;const message:string);
                   public
                     class function RunCommandwithTimeout(const exename:TProcessString;const commands:array of TProcessString;const dir:string;out outputstring:string;out errorstring:string;out exitstate:integer; ProcessOptions : TProcessOptions = [];SWOptions:TShowWindowOptions=swoNone;timeout:integer=15):boolean;static;
                   end;

procedure TProcessTimeout.LocalnIdleSleep(Sender,Context : TObject;status:TRunCommandEventCode;const message:string);
begin
  if status=RunCommandIdle then
  begin
     writeln(Executable+'('+ Parameters.CommaText+')' +' time: '+TimeToStr(now-started));
     if (now-started)>timeoutperiod then
     begin
       writeln('process timed out ');
       timedout:=true;
       Terminate(255);
       exit;
     end;
     sleep(RunCommandSleepTime);
  end;
end;

class function TProcessTimeout.RunCommandwithTimeout(
                             const exename     : TProcessString;
                             const commands    : array of TProcessString;
                             const dir         : string;
                             out outputstring  : string;
                             out errorstring   : string;
                             out exitstate     : integer;
                             ProcessOptions    : TProcessOptions = [];
                             SWOptions         : TShowWindowOptions=swoNone;
                             timeout           : integer=15
                            ):boolean;
Var
    p : TProcessTimeout;
    i : integer;
begin
  p:=TProcessTimeout.create(nil);
  p.OnRunCommandEvent:=@p.LocalnIdleSleep;
  p.CurrentDirectory:=dir;

  //timeout 单位为分钟,每秒检测一次
  p.timeoutperiod:=timeout/MinsPerDay;

  (*
  //若要求 Timeout 单位为秒
  p.timeoutperiod:=timeout/SecsPerDay;
  *)

  // 每秒检测一次是否该结束
  p.runcommandsleeptime := 1000;

  if ProcessOptions<>[] then
    P.Options:=ProcessOptions - [poRunSuspended,poWaitOnExit];
  p.options:=p.options+[poRunIdle]; // 需要运行 RUNIDLE 事件。参见 User Changes 3.2.0

  P.ShowWindow:=SwOptions;
  p.Executable:=exename;
  if high(commands)>=0 then
   for i:=low(commands) to high(commands) do
     p.Parameters.add(commands[i]);
  p.timedout:=false;
  p.started:=now;
  try
    // runcommand() 的主循环。最初基于本 wiki 内的“大数据量输出”场景,只是 5 年内不断有所扩展。 
    RunCommandwithTimeout:=p.RunCommandLoop(outputstring,errorstring,exitstate)=0;
    if p.timedout then
      RunCommandwithTimeout:=false;
  finally
    p.free;
  end;
  if exitstate<>0 then RunCommandwithTimeout:=false;
end;


// 用法示例

var
  output,errors : string;
  exitcode  :integer;
begin
  //Windows 和 Unix 还有其他程序可用
  {$if defined(WINDOWS)}
  if TProcessTimeout.RunCommandwithTimeout('cmd',['/c','dir','C:\*.exe','/s'],'c:\',output,errors,exitcode,[],swoNone,1) then // dir c:\*.exe /s
  {$else$}
  if TProcessTimeout.RunCommandwithTimeout('find',['/','-name','"*.sh"'],'/',output,errors,exitcode,[],swoNone,1) then // find / -name "*.sh"
  {$endif}
  begin
    writeln('program finished');
    writeln('--------------------output-------------------');
    writeln(output);
    writeln('--------------------errors-------------------');
    writeln(errors);
    if not(exitcode=0) then
    begin
      writeln('-program finished with errors (exitcode: '+exitcode.tostring+')-');
    end;
    readln();
  end
  else
  begin
    writeln('program not finished');
    writeln('--------------------output-------------------');
    writeln(output);
    writeln('--------------------errors-------------------');
    writeln(errors);
    writeln('-------------------EXITCODE------------------');
    writeln(exitcode);
    readln();
  end;
end.

SysUtils.ExecuteProcess

(跨平台)

尽管存在很多限制,但启动一个程序(模态、没有管道或任何控制)最简单的方式就是用:

SysUtils.ExecuteProcess(UTF8ToSys('/full/path/to/binary'), '', []);

发起调用的进程将以同步方式运行:暂时“挂起”直至外部程序运行完毕 - 但如果要求用户在程序继续运行之前执行某些操作,同步方式可能很有用。更多的执行方式请参阅推荐的跨平台 RunCommand 或其他 TProcess 函数;如果只需要考虑 Windows 系统,则可以使用 ShellExecute

调用进程同步运行:它'挂起(hangs)',直到内部出现完成 - 但是,在你的程序中继续前,如果你想要用户来做 一些事,这可能是有用的。对于更多用途的方法,看下一关于优先考虑跨平台的TProcess部分, 或如果你仅希望瞄准Windows,你可以使用ShellExecute

微软 Windows 系统:CreateProcess、ShellExecute 和 WinExec

Light bulb  Note: 虽然 FPC/Lazarus 已支持 CreateProcessShellExecuteWinExec,但仅限 Win32/64环境。跨平台程序请考虑采用 RunCommandTProcess
Light bulb  Note: WinExec 是 16 位调用,在 Windows API 中已废弃多年。最新版的 FPC 中会对其生成警告。

ShellExecute 是标准的微软 Windows 函数(ShellApi.h),documentation on MSDN 中有完善的文档。(如果函数无法可靠运行,请注意查看关于初始化 COM 的评论).

uses ..., ShellApi;

// 简单的单行代码调用(忽略返回错误):
if ShellExecute(0,nil, PChar('"C:\my dir\prog.exe"'),PChar('"C:\somepath\some_doc.ext"'),nil,1) =0 then;

// 执行批命令:
if ShellExecute(0,nil, PChar('cmd'),PChar('/c mybatch.bat'),nil,1) =0 then;

// 在给定目录打开命令行窗口:
if ShellExecute(0,nil, PChar('cmd'),PChar('/k cd \path'),nil,1) =0 then;

// 用“start”命令在默认浏览器中打开 URL(通过短暂显示并隐藏的 cmd 窗口):
if ShellExecute(0,nil, PChar('cmd'),PChar('/c start www.lazarus.freepascal.org/'),nil,0) =0 then;

// 助手函数:
procedure RunShellExecute(const prog,params:string);
begin
  //  ( Handle, nil/'open'/'edit'/'find'/'explore'/'print',   // 'open' 不是必需的
  //      path+prog, params, working folder,
  //        0=hide / 1=SW_SHOWNORMAL / 3=max / 7=min)   //要使用 SW_ constants 请 uses Windows 单元
  if ShellExecute(0,'open',PChar(prog),PChar(params),PChar(extractfilepath(prog)),1) >32 then; //success
  // 返回 0..32 表示出错
end;

还有个 WideChar 版本的 ShellExecuteExW,而 ShellExecuteExA 则是 AnsiChar 版。

fMask 选项还可以是 SEE_MASK_DOENVSUBST、SEE_MASK_FLAG_NO_UI、SEE_MASK_NOCLOSEPROCESS 等。

若是在 Delphi 中,要对 Word 文档或 URL 之类的 文档 调用 ShellExecute ,请查阅 lclintf 中的 open*(OpenUrl 等)函数(参见本页下方的替代方案)。

针对提权/管理员权限使用 ShellExecuteEx

若要用管理员/提权的权限执行外部程序,可使用各版本 ShellExecuteEx 函数的 runas 方法:

uses ShellApi, ...;

function RunAsAdmin(const Handle: Hwnd; const Path, Params: string): Boolean;
var
  sei: TShellExecuteInfoA;
begin
  FillChar(sei, SizeOf(sei), 0);
  sei.cbSize := SizeOf(sei);
  sei.Wnd := Handle;
  sei.fMask := SEE_MASK_FLAG_DDEWAIT or SEE_MASK_FLAG_NO_UI;
  sei.lpVerb := 'runas';
  sei.lpFile := PAnsiChar(Path);
  sei.lpParameters := PAnsiChar(Params);
  sei.nShow := SW_SHOWNORMAL;
  Result := ShellExecuteExA(@sei);
end;

procedure TFormMain.RunAddOrRemoveApplication;
begin
  // 用提权后的 rundll 打开控制面板,访问“程序和功能”面板
  RunAsAdmin(FormMain.Handle, 'rundll32.exe shell32.dll,Control_RunDLL appwiz.cpl', '');
end;

Unix 的 fpsystem、fpexecve 和 shell

这些函数是依赖于特定平台的。

Linux.Shell/Unix.Shell 相当于 fpsystem 的 1.0.x 版本,但其错误处理方式定义得不太严格,经过长时间废弃后最终被移除了。Shell 几乎在任何场合下都可替换为 fpsystem,后者的错误处理方式更像 POSIX。

TProcess

TProcess 可用于启动外部程序。采用 TProcess 有一些好处:

  • 平台无关
  • 支持读取 stdout 和写入 stdin。
  • 程序可以等待命令完成,也可以在命令运行的同时继续运行。

重要注意事项:

  • TProcess 不是终端/shell!不能直接执行脚本,不能用“|”、“>”、“<”、“&”之类的运算符重定向输出。通过调用 TProcess 的 pascal 代码,可以得到相同的效果,下面有一些示例。
  • 在 Linux/Unix 中,很可能必须指定可执行文件的完整路径。比如用 '/bin/cp' 替代 'cp'。如果程序位于标准的 PATH 内,那可以使用 LCL 的FileUtil 单元中的 FindDefaultExecutablePath 函数。
  • 在 Windows 中,如果命令位于 PATH 中,则无需给定完整路径。
  • TProcess 参考手册

最简单的示例

Runcommand 函数中已给出了很多例程。在开始复制和粘贴以下示例之前,请先予以查看。

简单示例

本例仅仅是展示运行外部程序的方法,不能用于生产性代码,请参阅大数据量输出或更好的 Runcommand

// 本例程展示了如何启动外部程序
program launchprogram;
 
// 包含必要的单元文件,里面有需要用到的函数和过程
uses 
  Classes, SysUtils, Process;
 
// 定义 "TProcess" 类型的变量 "AProcess"
var 
  AProcess: TProcess;
 
// 开始运行
begin
  // 创建 TProcess 对象并赋给变量 AProcess
  AProcess := TProcess.Create(nil);
 
  // 将需要执行的外部程序告知 AProcess 
  // 这里要调用 Free Pascal 编译器(i386版)
  AProcess.Executable:= 'ppc386';

  // 给 ppc386 带上参数 -h,实际执行的是 'ppc386 -h' 命令:
  AProcess.Parameters.Add('-h');
 
  // 定义运行选项
  // 让主程序暂停运行,直至外部程序停止执行。
  //                                     vvvvvvvvvvvvvv
  AProcess.Options := AProcess.Options + [poWaitOnExit];
 
  // 让 AProcess 运行外部程序
  AProcess.Execute;
 
  // ppc386 停止执行后才会运行至此
  AProcess.Free;
end.

这样就可以从自己的程序中运行外部程序了。

改良后的示例(但仍不够正确)

上述例子运行良好,但外部程序的输出结果该如何读取呢?

那就稍微添加一些代码来实现吧: 为了便于学习,本例程已尽量做了简化。请不要在产品代码中使用本例,而应采用#大数据量输出的读取中的代码

// 本示例待有缺陷,
// 演示了如何启动外部程序,并读取其输出
program launchprogram;
 
// 包含必要的单元文件,内有需要用到的函数和过程
uses 
  Classes, SysUtils, Process;
 
// 定义 "TProcess" 类型的变量 "AProcess"
// 还增加了一个 TStringList,用于存放从外部程序输出中读取的数据。
var 
  AProcess: TProcess;
  AStringList: TStringList;

// 开始运行
begin
  // 创建 TProcess 对象并赋给变量 AProcess
  AProcess := TProcess.Create(nil);
 
  // 将需要执行的外部程序告知 AProcess
  AProcess.Executable := '/usr/bin/ppc386'; 
  AProcess.Parameters.Add('-h'); 

  // 定义执行时的选项
  // 确保主程序暂停运行,直至外部程序停止执行。
  // 还要读取输出
  AProcess.Options := AProcess.Options + [poWaitOnExit, poUsePipes];
 
  // AProcess 知道要执行的命令行了
  AProcess.Execute;
  
  // AProcess 执行完毕后,继续运行
 
  // 读取刚执行完毕的外部程序的输出,并存入 TStringList。
  AStringList := TStringList.Create;
  AStringList.LoadFromStream(AProcess.Output);
   
  // 将输出结果存入文件,并清空 TStringList。
  AStringList.SaveToFile('output.txt');
  AStringList.Free;
 
  // 现在 AProcess 的输出处理完毕,可以释放了
  AProcess.Free;   
end.

大数据量输出的读取

上一示例中,主程序在外部程序退出之前一直处于等待状态,然后再读取其写到输出中去的数据。

假定外部程序会往输出写入很多数据。这就会填满输出管道,然后被调用的程序就会进入等待状态,直至管道中的数据被读走。

但在被调用程序结束之前,调用方程序不会去读取其输出。于是死锁发生了。

因此以下示例不采用 poWaitOnExit 方式,而是在执行外部程序的同时读取其输出。输出数据存于内存流中,以供后续读取并输出至 TStringList 中。

若要读取外部进程的输出数据,又无法使用 RunCommand,那就应该以下面的示例为基础编写生产代码。

program LargeOutputDemo;

{$mode objfpc}{$H+}

uses
  Classes, SysUtils, Process; // TProcess 位于 Process 单元内

const
  BUF_SIZE = 2048; // 分块读取输出数据的缓冲区大小

var
  AProcess     : TProcess;
  OutputStream : TStream;
  BytesRead    : longint;
  Buffer       : array[1..BUF_SIZE] of byte;

begin
  // 设置 TProcess,
  // 这里采用递归搜索目录作为例子,因为这通常会生成大量数据
  AProcess := TProcess.Create(nil);

  // Windows 和 *nix 的命令往往不同,因此用了 $IFDEFs
  {$IFDEF Windows}
    // Windows 中的 dir 是个内置命令,所以不能直接使用
    // 因此需要采用 cmd.exe 加参数的方式。
    AProcess.Executable := 'c:\windows\system32\cmd.exe';
    AProcess.Parameters.Add('/c');
    AProcess.Parameters.Add('dir /s c:\windows');
  {$ENDIF Windows}

  {$IFDEF Unix}
    AProcess.Executable := '/bin/ls';

    {$IFDEF Darwin}
      AProcess.Parameters.Add('-recursive');
      AProcess.Parameters.Add('-all');
    {$ENDIF Darwin}

    {$IFDEF Linux}
      AProcess.Parameters.Add('--recursive');
      AProcess.Parameters.Add('--all');
    {$ENDIF Linux}

    {$IFDEF FreeBSD}
      AProcess.Parameters.Add('-R');
      AProcess.Parameters.Add('-a');
    {$ENDIF FreeBSD}
 
    AProcess.Parameters.Add('-l');
  {$ENDIF Unix}

  // 用到了 poUsePipes 选项以便捕获输出结果。
  // 不能使用 poWaitOnExit 选项,因为会阻塞当前程序,也就无法读取进程输出的结果
  AProcess.Options := [poUsePipes];

  // 启动进程(运行 dir 或 ls 命令)
  AProcess.Execute;

  // 创建流对象,用于存放进程生成的输出数据。
  // 也可以采用文件流,直接将结果存入磁盘。
  OutputStream := TMemoryStream.Create;

  // 循环读取 AProcess 输出的全部数据,直至无数据可读
  repeat
    // 读取由进程新生成的数据,最多读取已申请缓冲区的上限。
    // 注意每次 read(...) 都会阻塞式调用,只有最后一次除外(返回0)。
    BytesRead := AProcess.Output.Read(Buffer, BUF_SIZE);

    // 将读到的字节加入流,以供后续使用
    OutputStream.Write(Buffer, BytesRead)

  until BytesRead = 0;  // 无数据可读时停止循环

  // 进程结束,可被释放
  AProcess.Free;

  // 全部读到的数据已可用,比如可存入磁盘
  with TFileStream.Create('output.txt', fmCreate) do
  begin
    OutputStream.Position := 0; // 需确保从头开始复制所有数据
    CopyFrom(OutputStream, OutputStream.Size);
    Free
  end;

  // 或者可显示到屏幕上
  with TStringList.Create do
  begin
    OutputStream.Position := 0; // 需确保从头开始复制所有数据
    LoadFromStream(OutputStream);
    writeln(Text);
    writeln('--- Number of lines = ', Count, '----');
    Free
  end;

  // Clean up
  OutputStream.Free;
end.

注意上述代码也可以利用 RunCommand 来实现:

var s: string;
...
RunCommand('c:\windows\system32\cmd.exe', ['/c', 'dir /s c:\windows'], s);

TProcess 输入输出的用法

请参阅 Lazarus-CCR SVN 中的 processdemo 示例。

TProcess 用法提示

在创建跨平台程序时,可用“{$IFDEF}”和“{$ENDIF}”指令根据各操作系统设置不同的可执行文件名称。

示例:

{...}
AProcess := TProcess.Create(nil)

{$IFDEF WIN32}
  AProcess.Executable := 'calc.exe'; 
{$ENDIF}

{$IFDEF LINUX}
  AProcess.Executable := FindDefaultExecutablePath('kcalc');
{$ENDIF}

AProcess.Execute;
{...}

前台显示 macOS 应用程序包

TProcess 可启动应用程序包中的可执行文件。例如:

 AProcess.Executable:='/Applications/iCal.app/Contents/MacOS/iCal';

上述代码将会启动 Calendar,但其窗口位于当前应用程序之后。若要让应用程序显示于前台,可用带 -n 参数的 open

 AProcess.Executable:='/usr/bin/open';
 AProcess.Parameters.Add('-n');
 AProcess.Parameters.Add('-a'); // 可选参数:指定应用程序,仅搜索 Application 目录
 AProcess.Parameters.Add('-W'); // 可选参数:open 保持等待,直至打开(或已打开状态)的外部程序退出
 AProcess.Parameters.Add('Pages.app'); // 可选的包含 .app

如果应用程序需要参数,可以给 open 传入 --args 参数,后面加入的所有参数都会传给应用程序:

 AProcess.Parameters.Add('--args');
 AProcess.Parameters.Add('argument1');
 AProcess.Parameters.Add('argument2');

参见:macOS open 命令

让程序独立运行

通常,由其他应用程序启动的是一个子进程,主应用终止时子应用也将被终止。若要启动一个保持运行的独立应用,可以采用以下方式:

var
  Process: TProcess;
  I: Integer;
begin
  Process := TProcess.Create(nil);
  try
    Process.InheritHandles := False;
    Process.Options := [];
    Process.ShowWindow := swoShow;

    // 复制包含 DISPLAY 在内的默认环境变量,以便 GUI 应用能够正常运行
    for I := 1 to GetEnvironmentVariableCount do
      Process.Environment.Add(GetEnvironmentString(I));

    Process.Executable := '/usr/bin/gedit';  
    Process.Execute;
  finally
    Process.Free;
  end;
end;

与 aspell 进程通讯的示例代码

pasdoc 的源代码中有两个单元,演示了通过管道与正在运行的 aspell 进程进行通讯,以执行拼写检查功能:

  • PasDoc_ProcessLineTalk.pas 单元实现了 TProcessLineTalk 类,衍生自 TProcess,便于以行为单位与任何进程进行对话。
  • PasDoc_Aspell.pas 单元实现了 TAspellProcess 类,执行拼写检查功能,通过底层的 TProcessLineTalk 实例执行 aspell,并与运行中的 aspell 进 程通讯完成拼写检查.

这两个单元都相对独立于其他 pasdoc 源代码,因此可作为用 TProcess 运行其它程序并通过管道与之通讯的真实案例。

替换“| < >”之类的 shell 操作符

有时需要运行更为复杂的命令,将数据通过管道传给另一个命令或文件。类似于:

 ShellExecute('firstcommand.exe | secondcommand.exe');

 ShellExecute('dir > output.txt');

这是 TProcess 无法完成的,比如:

// 无法生效
 Process.CommandLine := 'firstcommand.exe | secondcommand.exe'; 
 Process.Execute;

为什么用操作符重定向输出无效

TProcess 不是 shell 环境,而是进程。进程只有一个,不是两个。不过还是有办法实现重定向输出的。请参阅下一节

如何实现 TProcess 输出重定向

可为每一条命令使用一个 TProcess 实例,将输出重定向至另一命令。

以下示例说明了如何将一个进程的输出重定向至另一个进程。要将进程的输出重定向到文件/流,请参阅示例 大数据量输出的读取

如果指定了 poStderrToOutPut 选项,则不仅可以重定向“常规” 输出(也称 stdout),还可以重定向错误输出 (stderr),参见第二个进程的选项。

program Project1;
  
uses
  Classes, sysutils, process;
  
var
  FirstProcess,
  SecondProcess: TProcess;
  Buffer: array[0..127] of char;
  ReadCount: Integer;
  ReadSize: Integer;
begin
  FirstProcess  := TProcess.Create(nil);
  SecondProcess := TProcess.Create(nil);
 
  FirstProcess.Options     := [poUsePipes]; 
  FirstProcess.Executable  := 'pwd'; 
  
  SecondProcess.Options    := [poUsePipes,poStderrToOutPut];
  SecondProcess.Executable := 'grep'; 
  SecondProcess.Parameters.Add(DirectorySeparator+ ' -'); 
  // 等效于 "pwd | grep / -"
  
  FirstProcess.Execute;
  SecondProcess.Execute;
  
  while FirstProcess.Running or (FirstProcess.Output.NumBytesAvailable > 0) do
  begin
    if FirstProcess.Output.NumBytesAvailable > 0 then
    begin
      // 确保读取的数据不会超过申请的缓冲区大小
      ReadSize := FirstProcess.Output.NumBytesAvailable;
      if ReadSize > SizeOf(Buffer) then
        ReadSize := SizeOf(Buffer);
      // 将输出读入缓冲区
      ReadCount := FirstProcess.Output.Read(Buffer[0], ReadSize);
      // 将缓冲区内容写入第二个进程
      SecondProcess.Input.Write(Buffer[0], ReadCount);
  
      // 如果 SecondProcess 输出数据太多,
      // 应当在此读出数据,以防死锁
      // 参见上面的例子 "大数据量输出的读取"
    end;
  end;
  // 关闭 SecondProcess 的输出
  // 数据处理结束
  SecondProcess.CloseInput;
 
  // 等待完成
  // 小心所执行的命令可能在输入关闭时不会退出
  // 以下代码可能陷入死循环
  while SecondProcess.Running do
    Sleep(1);
  // 好了!
  // 余下的代码只是为了让本例稍显有用

  // 复用一下缓冲区 Buffer,
  // 将 SecondProcess 的输出内容输出到本程序的 stdout 去

  WriteLn('Grep output Start:');
  ReadSize := SecondProcess.Output.NumBytesAvailable;
  if ReadSize > SizeOf(Buffer) then
    ReadSize := SizeOf(Buffer);
  if ReadSize > 0 then
  begin
    ReadCount := SecondProcess.Output.Read(Buffer, ReadSize);
    WriteLn(Copy(Buffer,0, ReadCount));
  end
  else
    WriteLn('grep did not find what we searched for. ', SecondProcess.ExitStatus);
  WriteLn('Grep output Finish:');
  
  // 释放进程对象
  FirstProcess.Free;
  SecondProcess.Free;
end.

就此结束。现在可以将输出重定向到另一个程序了。

注意

上述例子貌似有些夸张了,因为可以通过 TProcess 再用 shell 运行“复杂”命令,比如:

 Process.Commandline := 'sh -c "pwd | grep / -"';

但上述例子更具跨平台性,无需修改即可在 Windows、Linux 等平台运行。“sh”可能不一定存在,一般仅在 *nix 平台可用。另外,上述例子的灵活性更高,因为可以单独读写每个进程的输、输出和 stderr,可能对项目开发非常有用。

重定向输入和输出,并在 root 权限下运行

在 Unix(FreeBSD、macOS)和 Linux 平台中,有一个常见问题就是需在 root(或更通用些是另一个用户)账户下执行某些程序。比如执行 ping 命令。

如果有 sudo 可用,则把以下例子改改即可实现,此例改自 andyman 在论坛上发布的一个帖子([1])。此例会在 /root 目录中运行 ls 命令,当然可以自行修改代码。

更好的方案是使用 PolicyKit 包,所有新版 Linux 上都会提供。详情请参阅论坛帖子

以下代码的大部分与上述例子类似,不过还演示了如何将单独调用的进程的 stdout 和 stderr 重定向至当前代码的 stdout 和 stderr。

program rootls;

{ 演示使用 TProcess 时将 stdout/stderr 重定向至当前 stdout/stderr,
在 FreeBSD/Linux/macOS 中调用 sudo, 并在 stdin 提供输入}
{$mode objfpc}{$H+}

uses
  Classes,
  Math, {提供 min 函数}
  Process;

  procedure RunsLsRoot;
  var
    Proc: TProcess;
    CharBuffer: array [0..511] of char;
    ReadCount: integer;
    ExitCode: integer;
    SudoPassword: string;
  begin
    WriteLn('Please enter the sudo password:');
    Readln(SudoPassword);
    ExitCode := -1; //初始值为失败,观察后续是否生效
    Proc := TProcess.Create(nil); //新建进程
    try
      Proc.Options := [poUsePipes, poStderrToOutPut]; //用管道重定向程序的 stdin、stdout、stderr
      Proc.CommandLine := 'sudo -S ls /root'; //用 sudo 以 root 权限运行 ls /root
      // -S 使得 sudo 从 stdin 读取 root 账户的口令
      Proc.Execute; //启动进程。sudo 会要求输入口令

      // 向 sudo 程序的 stdin 写入口令
      SudoPassword := SudoPassword + LineEnding;
      Proc.Input.Write(SudoPassword[1], Length(SudoPassword));
      SudoPassword := '%*'; //用短字符串填充,希望会稍稍搅乱一些内存数据,更安全的做法是用 PChars
      SudoPassword := ''; // 能让程序更难破解?!?

      // 主循环从 sudo 的 stdout 和 stderr 读取输出数据
      while Proc.Running or (Proc.Output.NumBytesAvailable > 0) or
        (Proc.Stderr.NumBytesAvailable > 0) do
      begin
        // 读取 stdout 并写入当前 stdout
        while Proc.Output.NumBytesAvailable > 0 do
        begin
          ReadCount := Min(512, Proc.Output.NumBytesAvailable); //读入缓冲区,不超过最大值
          Proc.Output.Read(CharBuffer, ReadCount);
          Write(StdOut, Copy(CharBuffer, 0, ReadCount));
        end;
        // read stderr and write to our stderr
        while Proc.Stderr.NumBytesAvailable > 0 do
        begin
          ReadCount := Min(512, Proc.Stderr.NumBytesAvailable); //读入缓冲区,不超过最大值
          Proc.Stderr.Read(CharBuffer, ReadCount);
          Write(StdErr, Copy(CharBuffer, 0, ReadCount));
        end;
      end;
      ExitCode := Proc.ExitStatus;
    finally
      Proc.Free;
      Halt(ExitCode);
    end;
  end;

begin
  RunsLsRoot;
end.

其他想法:无疑最好是验证一下 sudo 是否真的提示输入口令。可将环境变量 SUDO_PROMPT 设为自定义值,并在读取 TProcess 的 stdout 时检查是否一致,这样即可避免不同语言环境下的提示符不同问题。设置环境变量会清除其默认值(从当前进程继承),因此用到的时候得去程序当前环境复制。

在 Linux 中用 sudo 运行 fdisk

以下例子展示了如何用 sudo 命令获取 root 权限,在 Linux 计算机上运行 fdisk。注意:仅供演示,不适合大数据量输出。

program getpartitioninfo;
{ {最初由 Lazarus 论坛 wjackon153 贡献,有问题、评论请联系他。
由 BigChimp 将 Lazarus 代码修改为 FPC 程序, 便于理解和简化}

Uses
  Classes, SysUtils, FileUtil, Process;

var
  hprocess: TProcess;
  sPass: String;
  OutputLines: TStringList;

begin  
  sPass := 'yoursudopasswordhere'; // 需要改为自己的 sudo 口令
  OutputLines:=TStringList.Create; // 最好用 try...finally 块 
  // 确保 OutputLines 能被释放,hProcess 同理
     
  // 以下代码将在后台打开 fdisk 并获取分区信息
  // 因为 fdisk 需要提权
  // 需要用 -S 选项将口令作为参数传给 sudo
  // 因此程序将进入等待状态,直至密码发送至 sudo 程序
  hProcess := TProcess.Create(nil);
  // 在 Linux/Unix/FreeBSD/macOS 中,需要指定可执行程序的完整路径
  hProcess.Executable := '/bin/sh';
  // 现在加入所有命令行参数
  hprocess.Parameters.Add('-c');
  // 现在将口令通过管道传给 sudo 命令,让它执行 fdisk -l 
  hprocess.Parameters.add('echo ' + sPass  + ' | sudo -S fdisk -l');
  // 同步方式执行(等待进程退出)并使用管道,以便由管道读取输出数据
  hProcess.Options := hProcess.Options + [poWaitOnExit, poUsePipes];
  // 执行进程
  hProcess.Execute;

  // 现在 hProcess 应该将外部程序执行完毕(因为用了 poWaitOnExit)
  // 可以处理进程的输出数据了(stdout 和 strerr 等)
  OutputLines.Add('stdout:');
  OutputLines.LoadFromStream(hprocess.Output);
  OutputLines.Add('stderr:');
  OutputLines.LoadFromStream(hProcess.Stderr);
  // 在屏幕上显示输出数据
  writeln(OutputLines.Text);

  // 释放资源,避免内存泄漏
  hProcess.Free;
  OutputLines.Free;
  
  // 以下给出了一些示例,可传递非法字符,就像在终端中一样
  // 即使其他地方说是无法实现,我也保证以下方法有效 :)

  //hprocess.Parameters.Add('ping -c 1 www.google.com');
  //hprocess.Parameters.Add('ifconfig wlan0 | grep ' +  QuotedStr('inet addr:') + ' | cut -d: -f2');

  // QuotedStr() 不是必需的,但可以让代码更清晰
  // 用双引号效果也一样
  //hprocess.Parameters.Add('glxinfo | grep direct');   

  // 以下方法还可以用于从软件包仓库中安装应用

  //hprocess.Parameters.add('echo ' + sPass  + ' | sudo -S apt-get install -y pkg-name'); 

 end.

包含空格的参数(替换 Shell 命令中的引号)

Linux shell 可以接受引号包裹的参数,例如:

gdb --batch --eval-command="info symbol 0x0000DDDD" myprogram

这里 GDB 可以接受 3 个参数(除第一个参数外),第一个参数是可执行文件的完整路径:

  1. --batch
  2. --eval-command=info symbol 0x0000DDDD
  3. myprogram 的完整路径

若要避免复杂的引号处理,最佳方案是在复杂场景下改用 TProcess.Parameters.Add,而不是直接给 CommandLine 赋值,例如::

 AProcess.Executable:='/usr/bin/gdb';
 AProcess.Parameters.Add('--batch');
 AProcess.Parameters.Add('--eval-command=info symbol 0x0000DDDD'); // 注意这里没有用到引号
 AProcess.Parameters.Add('/home/me/myprogram');

还请记得只传递完整路径。

不过 TProcess.Commandline 确实支持对带有引号的参数进行一些简单的转义。用双引号包裹含有空格的整个参数。比如:

AProcess.CommandLine := '/usr/bin/gdb --batch "--eval-command=info symbol 0x0000DDDD" /home/me/myprogram';

.CommandLine 属性已废弃,涉及更复杂的引号处理的缺陷报告,将不予接受或处理。

LCLIntf 替代方案

有时不用显式调用外部程序,即可获取所需功能。不用既打开应用程序又把文档告诉它,只需让操作系统直接打开文档即可,操作系统会去选择与文档类型关联的默认应用。以下是一些示例。

用默认应用程序打开文档

某些时候需要用默认关联应用程序打开文档,而不是非要执行某个程序。不同的操作系统有不同的做法。Lazarus 提供了一个平台无关的过程 OpenDocument,可以完成这个操作。调用程序会继续运行,无需等待文档处理进程的关闭。

uses LCLIntf;
...
OpenDocument('manual.pdf');  
...

用默认浏览器打开网页

只需传入所需的 URL,在有些环境下好像可以省略前面的 http://。此外,传入文件名可能效果等同于 OpenDocument()。

uses LCLIntf;
...
OpenURL('www.lazarus.freepascal.org/');

请参阅:

或者可以以以下方式使用 TProcess

uses Process;

procedure OpenWebPage(URL: string);
// 看来传入的 URL 需用双引号包裹,比如 "www.lazarus.freepascal.org"
var
  Browser, Params: string;
begin
  FindDefaultBrowser(Browser, Params);
  with TProcess.Create(nil) do
  try
    Executable := Browser;
    Params:=Format(Params, [URL]);
    Params:=copy(Params,2,length(Params)-2); // 移除双引号,新版 TProcess.Parameters 会自动处理
    Parameters.Add(Params);
    Options := [poNoConsole];
    Execute;
  finally
    Free;
  end;
end;

WinExec

在陈旧的 Delphi 代码中,有时还会存在 Windows 3.x 时代的 CreateProcess。请用上述一种方案替换。CreateProcess 在 Windows 单元中依然存在,已标记为废弃状态。

参阅

贡献者和更改

  • 简体中文版本由 robsean 于 2019-03-07 创建。