Delphi - 调用外部程序并阻塞到外部程序中

Delphi 调用外部程序并阻塞到外部程序中

背景说明：

前段时间开发一个数据转换的系统，业务逻辑中说明数据需要压缩成.tar.gz格式。

我在Windows系统下采用，先生成批处理文件，然后调用WinExec执行批处理文件，休眠等待一段时间，完成数据的自动压缩。

后来发现，待压缩文件的大小不确定，单纯的执行WinExec时Sleep固定时间，可能导致压缩失败、文件不全或损坏。

优化方案：

取代WinExe用CreateProcess用来启动进程, 执行批处理文件, 同时系统会自动填写TProcessInformation这个结构。

此时程序会自动阻塞到该批处理中，等待批处理句柄的进程结束或超时。这样就能解决压缩损坏问题。

给个实例Demo:

D7代码如下：

 unit uMain;

 interface

 uses
   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
   Dialogs, RzButton, StdCtrls;

 type
   TFrmMain = class(TForm)
     mmMsg: TMemo;
     btnExecute: TRzBitBtn;
     btnClear: TRzBitBtn;
     procedure MsgDsp(v_Str: string);
     procedure btnExecuteClick(Sender: TObject);
     procedure btnClearClick(Sender: TObject);
   private
     { Private declarations }
   public
     { Public declarations }
   end;

 var
   FrmMain: TFrmMain;

 implementation

 {$R *.dfm}

 procedure TFrmMain.MsgDsp(v_Str: string);
 begin
   mmMsg.Lines.Add('[ admin ] - [' + v_Str + '] - [' + FormatDateTime('YYYY-MM-DD hh:mm:ss zzz', Now()) + ']');
 end;

 procedure TFrmMain.btnExecuteClick(Sender: TObject);
 var
   sInfo: TStartupInfo;
   pInfo: TProcessInformation;
   cmdLine: string;
   exitCode: Cardinal;
 begin
   MsgDsp('初始化参数');
   cmdLine := 'C:\Program Files\7-Zip\7zFM.exe';
   FillChar(sInfo, sizeof(sInfo), #);
   sInfo.cb := SizeOf(sInfo);
   sInfo.dwFlags := STARTF_USESHOWWINDOW;
   sInfo.wShowWindow := SW_NORMAL;
   MsgDsp('参数初始化完成，启动WinExec调试');
   //CreateProcess用来启动进程, 进程启动后, 会填写TProcessInformation这个结构，
   //此时程序阻塞到该句柄中，等待句柄的进程结束或超时
   if not CreateProcess(nil, pchar(cmdLine), nil, nil, false, CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS, nil, nil, sInfo, pInfo) then
   begin
     MsgDsp('WinExec调试失败！');
     MessageBox(Application.handle, '指定程序启动失败!', '错误', MB_OK or MB_ICONSTOP);
   end
   else
   begin
     //等待指定句柄的进程结束或超时
     WaitForSingleObject(pInfo.hProcess, INFINITE);
     GetExitCodeProcess(pInfo.hProcess, exitCode);
     MsgDsp('WinExec调试成功！');
   end;
 end;

 procedure TFrmMain.btnClearClick(Sender: TObject);
 begin
    mmMsg.Clear;
 end;

 end.

运行效果如下：

封装成函数如下：

 //Jeremy.Wu
 //2019.09.19
 //https://www.cnblogs.com/jeremywucnblog/
 function TFrmMain.GetCreateProcess(vCmdLine: string): Boolean;
 var
   sInfo: TStartupInfo;
   pInfo: TProcessInformation;
   exitCode: Cardinal;
 begin
   Result := False;
   FillChar(sInfo, sizeof(sInfo), #);
   sInfo.cb := SizeOf(sInfo);
   sInfo.dwFlags := STARTF_USESHOWWINDOW;
   sInfo.wShowWindow := SW_NORMAL;
   //CreateProcess用来启动进程, 进程启动后, 会填写TProcessInformation这个结构，
   //此时程序阻塞到该句柄中，等待句柄的进程结束或超时
   if not CreateProcess(nil, pchar(vCmdLine), nil, nil, false, CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS, nil, nil, sInfo, pInfo) then
   begin
     Result := False;
   end
   else
   begin
     //等待指定句柄的进程结束或超时
     WaitForSingleObject(pInfo.hProcess, INFINITE);
     GetExitCodeProcess(pInfo.hProcess, exitCode);
     Result := True;
   end;
 end;

作者：Jeremy.Wu
  出处：https://www.cnblogs.com/jeremywucnblog/

  本文版权归作者和博客园共有，欢迎转载，但未经作者同意必须保留此段声明，且在文章页面明显位置给出原文连接，否则保留追究法律责任的权利。