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

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

背景说明：

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

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

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

优化方案：

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

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

 

给个实例Demo:

D7代码如下：

 1 unit uMain;
 2 
 3 interface
 4 
 5 uses
 6   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 7   Dialogs, RzButton, StdCtrls;
 8 
 9 type
10   TFrmMain = class(TForm)
11     mmMsg: TMemo;
12     btnExecute: TRzBitBtn;
13     btnClear: TRzBitBtn;
14     procedure MsgDsp(v_Str: string);
15     procedure btnExecuteClick(Sender: TObject);
16     procedure btnClearClick(Sender: TObject);
17   private
18     { Private declarations }
19   public
20     { Public declarations }
21   end;
22 
23 var
24   FrmMain: TFrmMain;
25 
26 implementation
27 
28 {$R *.dfm}
29 
30 procedure TFrmMain.MsgDsp(v_Str: string);
31 begin
32   mmMsg.Lines.Add('[ admin ] - [' + v_Str + '] - [' + FormatDateTime('YYYY-MM-DD hh:mm:ss zzz', Now()) + ']');
33 end;
34 
35 procedure TFrmMain.btnExecuteClick(Sender: TObject);
36 var
37   sInfo: TStartupInfo;
38   pInfo: TProcessInformation;
39   cmdLine: string;
40   exitCode: Cardinal;
41 begin
42   MsgDsp('初始化参数');
43   cmdLine := 'C:\Program Files\7-Zip\7zFM.exe';
44   FillChar(sInfo, sizeof(sInfo), #0);
45   sInfo.cb := SizeOf(sInfo);
46   sInfo.dwFlags := STARTF_USESHOWWINDOW;
47   sInfo.wShowWindow := SW_NORMAL;
48   MsgDsp('参数初始化完成，启动WinExec调试');
49   //CreateProcess用来启动进程, 进程启动后, 会填写TProcessInformation这个结构，
50   //此时程序阻塞到该句柄中，等待句柄的进程结束或超时
51   if not CreateProcess(nil, pchar(cmdLine), nil, nil, false, CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS, nil, nil, sInfo, pInfo) then
52   begin
53     MsgDsp('WinExec调试失败！');
54     MessageBox(Application.handle, '指定程序启动失败!', '错误', MB_OK or MB_ICONSTOP);
55   end
56   else
57   begin
58     //等待指定句柄的进程结束或超时
59     WaitForSingleObject(pInfo.hProcess, INFINITE);
60     GetExitCodeProcess(pInfo.hProcess, exitCode);
61     MsgDsp('WinExec调试成功！');
62   end;
63 end;
64 
65 procedure TFrmMain.btnClearClick(Sender: TObject);
66 begin
67    mmMsg.Clear;
68 end;
69 
70 end.

运行效果如下：

 

封装成函数如下：

 1 //Jeremy.Wu
 2 //2019.09.19
 3 //https://www.cnblogs.com/jeremywucnblog/
 4 function TFrmMain.GetCreateProcess(vCmdLine: string): Boolean;
 5 var
 6   sInfo: TStartupInfo;
 7   pInfo: TProcessInformation;
 8   exitCode: Cardinal;
 9 begin
10   Result := False;
11   FillChar(sInfo, sizeof(sInfo), #0);
12   sInfo.cb := SizeOf(sInfo);
13   sInfo.dwFlags := STARTF_USESHOWWINDOW;
14   sInfo.wShowWindow := SW_NORMAL;
15   //CreateProcess用来启动进程, 进程启动后, 会填写TProcessInformation这个结构，
16   //此时程序阻塞到该句柄中，等待句柄的进程结束或超时
17   if not CreateProcess(nil, pchar(vCmdLine), nil, nil, false, CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS, nil, nil, sInfo, pInfo) then
18   begin
19     Result := False;
20   end
21   else
22   begin
23     //等待指定句柄的进程结束或超时
24     WaitForSingleObject(pInfo.hProcess, INFINITE);
25     GetExitCodeProcess(pInfo.hProcess, exitCode);
26     Result := True;
27   end;
28 end;