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;