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;
