维基副本镜像

这是 pascal.chat 维基的镜像。编辑、历史记录和登录都在那里。

Executing External Programs/zh CN

Deutsch · English · Español · Français · Italiano · Nederlands · Polski · Português · Slovenčina · Русский · 中文(中国) · 日本語

执行外部程序

概述:对比

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

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

(Process.)RunCommand

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

以下是简单示例:

pascal
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 文件。因此,以下代码不会输出任何结果:

pascal
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):

pascal
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:

pascal
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

(跨平台)

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

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

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

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

微软 Windows 系统:CreateProcess、ShellExecute 和 WinExec

https://upload.wikimedia.org/wikipedia/commons/d/d8/Nuvola_apps_ktip.png Note: 虽然 FPC/Lazarus 已支持 CreateProcess 、ShellExecute 和 WinExec ,但仅限 Win32/64环境。跨平台程序请考虑采用 RunCommand 或 TProcess 。

https://upload.wikimedia.org/wikipedia/commons/d/d8/Nuvola_apps_ktip.png Note: WinExec 是 16 位调用,在 Windows API 中已废弃多年。最新版的 FPC 中会对其生成警告。

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

pascal
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 方法:

pascal
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 有一些好处:

重要注意事项:

最简单的示例

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

简单示例

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

pascal
// 本例程展示了如何启动外部程序
    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.

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

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

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

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

pascal
// 本示例待有缺陷,
    // 演示了如何启动外部程序,并读取其输出
    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,那就应该以下面的示例为基础编写生产代码。

pascal
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 来实现:

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

TProcess 输入输出的用法

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

TProcess 用法提示

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

示例:

pascal
{...}
    AProcess := TProcess.Create(nil)
    
    {$IFDEF WIN32}
      AProcess.Executable := 'calc.exe'; 
    {$ENDIF}
    
    {$IFDEF LINUX}
      AProcess.Executable := FindDefaultExecutablePath('kcalc');
    {$ENDIF}
    
    AProcess.Execute;
    {...}

前台显示 macOS 应用程序包

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

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

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

pascal
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 参数,后面加入的所有参数都会传给应用程序:

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

参见:macOS open 命令

让程序独立运行

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

pascal
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 源代码,因此可作为用 TProcess 运行其它程序并通过管道与之通讯的真实案例。

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

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

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

或

pascal
ShellExecute('dir > output.txt');

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

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

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

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

如何实现 TProcess 输出重定向

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

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

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

pascal
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 运行“复杂”命令,比如:

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

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

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

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

如果有 sudo 可用,则把以下例子改改即可实现,此例改自 andyman 在论坛上发布的一个帖子(1(http://lazarus.freepascal.org/index.php/topic,14479.0.html))。此例会在 /root 目录中运行 ls 命令,当然可以自行修改代码。

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

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

pascal
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。注意:仅供演示,不适合大数据量输出。

pascal
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 可以接受引号包裹的参数,例如:

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

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

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

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

pascal
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 确实支持对带有引号的参数进行一些简单的转义。用双引号包裹含有空格的 整个 参数。比如:

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

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

LCLIntf 替代方案

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

用默认应用程序打开文档

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

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

用默认浏览器打开网页

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

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

请参阅:

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

pascal
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 单元中依然存在,已标记为废弃状态。

参阅

贡献者和更改


From the Free Pascal wiki, page "Executing External Programs/zh CN", as the Internet Archive kept it on 2025-02-07, last changed on 2024-09-30. Copyright stays with the author who wrote it, according to the old wiki's Licensing page. If you have concerns about this material, message the admin.

版本3,最后由WikiArchive于修改。