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;

  作者：Jeremy.Wu
  出處：https://www.cnblogs.com/jeremywucnblog/
  本文著作權歸作者和博客園共有，歡迎轉載，但未經作者同意必須保留此段宣告，且在文章頁面明顯位置給出原文連接，否則保留追究法律責任的權利，

標籤：Delphi

上一篇：php檔案加密解密

下一篇：百度API車牌識別——Restful方式