Delphi 线程间发送消息

线程B向线程A发送消息，SendMessage(线程A句柄, msg, wParam参数, lParam参数);

线程A重写WndProc(var Message: TMessage);

 1 { 线程B发送消息 }
 2 unit ThreadUnit;
 3 
 4 interface
 5 
 6 uses
 7   Classes, ActiveX, businessService, Dialogs, Constant, Windows, Messages, SysUtils;
 8 
 9 type
10   TUpgradeAppThread = class(TThread)
11   protected
12     procedure execute; override;
13   private
14     appFileDir: string;
15     manualCheck: Boolean;
16   public
17     MainFromHandle: HWND;  //主线程句柄
18     constructor Create(appFileDir: string; manualCheck: Boolean);
19   end;
20 
21 const {0x0400 - 0x7FFF}
22   WM_UPDATE_UI1 = WM_USER + $1001;
23   WM_UPDATE_UI2 = WM_USER + $1002;
24 
25 var
26   upgradeAppThread: TUpgradeAppThread;
27 
28 implementation
29 
30 constructor TUpgradeAppThread.Create(appFileDir: string; manualCheck: Boolean);
31 begin
32   inherited Create(False);
33   Self.appFileDir := appFileDir;
34   Self.manualCheck := manualCheck;
35 end;
36 
37 procedure TUpgradeAppThread.Execute;
38 var
39   res: string;
40   sData: TCopyDataStruct;
41 begin
42   FreeOnTerminate := True;
43   try
44     res := upgradeApplication(appFileDir, False);
45     if res = '0' then
46     begin
47       //未检测到完整版客户更新才进行dll更新检测
48       res := upgradeDllOnline(appFileDir);
49     end;
50 
51     if res = '0' then
52     begin
53       if Self.manualCheck then
54       begin
55         ShowMessage('博思客户端是最新版本，无需更新！');
56       end;
57     end
58     else if res = BSERROR_NO_SERVCONF then
59     begin
60       if Self.manualCheck then
61       begin
62         ShowMessage('更新服务器地址为空！');
63       end;
64     end
65     else if res = '2' then
66       SendMessage(MainFromHandle, WM_UPDATE_UI2, 0, 0)  //向主线程发送dll更新消息
67     else
68     begin
69       try
70         sData.lpData := PChar(res);
71         SendMessage(MainFromHandle, WM_UPDATE_UI1, 0, Cardinal(@sData));   //向主线程发客户端更新消息
72       finally
73 //        FreeMem(sData.lpData);
74       end;
75     end;
76   finally
77 
78   end;
79 end;
80 
81 end.

 1 { 线程A接收消息 }
 2 protected
 3     procedure WndProc(var Message: TMessage); override;
 4 
 5 //创建线程B
 6 upgradeAppThread := TUpgradeAppThread.Create(appFileDir, manualCheck);   //将检查更新放在线程中执行
 7   upgradeAppThread.MainFromHandle := Self.Handle;
 8 
 9 
10 procedure TfrmMain.WndProc(var Message: TMessage);  //接收线程消息
11 var
12   param: TStringList;
13   httpClient: TIdHTTP;
14   controlUrl, res: string;
15   appPath: string;
16   cdds: TcopyDataStruct;
17 begin
18   res := '';
19   case Message.Msg of
20     WM_UPDATE_UI1:   { 客户端更新消息 }
21       begin
22         res := '博思客户端助手需要更新到最新版本，需要关闭客户端才能更新，是否立即更新？';
23         cdds := PcopyDataStruct(Message.LParam)^;
24         appPath := StrPas(PChar(cdds.lpData));
25         controlUrl := 'http://' + serverIp + ':' + IntToStr(StrToInt(serverPort) + 2) + '/upgradeMainApp?fp=' + appPath;
26       end;
27     WM_UPDATE_UI2:  { dll更新消息 }
28       begin
29         res := '检测到客户端组件更新，博思客户端助手需要重启才能更新，是否立即更新？';
30         controlUrl := 'http://' + serverIp + ':' + IntToStr(StrToInt(serverPort) + 2) + '/controlMainApp?ct=2';
31       end;
32   else
33     inherited;
34   end;
35   if res <> '' then
36   begin
37     try
38       if MessageBox(Self.Handle, PChar(res), '询问', MB_ICONQUESTION + MB_YESNO + MB_TOPMOST + MB_DEFBUTTON2) = IDYES then
39       begin
40         param := TStringList.Create;
41         httpClient := TIdHTTP.Create;
42         controlUrl := StringReplace(controlUrl, ' ', '%20', [rfReplaceAll]);
43         httpClient.Post(controlUrl, param);
44       end;
45     finally
46       httpClient.Free;
47       param.Free;
48     end;
49   end;
50 end;