转载自:
线程 B 向线程 A 发送消息, SendMessage(线程 A 句柄, msg, wParam 参数, lParam 参数);
线程 A 重写 WndProc(var Message: TMessage);
{ 线程 B 发送消息 }
- unit ThreadUnit;
- interface
- uses
- Classes, ActiveX, businessService, Dialogs, Constant, Windows, Messages, SysUtils;
- type
- TUpgradeAppThread = class(TThread)
- protected
- procedure execute; override;
- private
- appFileDir: string;
- manualCheck: Boolean;
- public
- MainFromHandle: HWND; // 主线程句柄
- constructor Create(appFileDir: string; manualCheck: Boolean);
- end;
- const {0x0400 - 0x7FFF}
- WM_UPDATE_UI1 = WM_USER + $1001;
- WM_UPDATE_UI2 = WM_USER + $1002;
- var
- upgradeAppThread: TUpgradeAppThread;
- implementation
- constructor TUpgradeAppThread.Create(appFileDir: string; manualCheck: Boolean);
- begin
- inherited Create(False);
- Self.appFileDir := appFileDir;
- Self.manualCheck := manualCheck;
- end;
- procedure TUpgradeAppThread.Execute;
- var
- res: string;
- sData: TCopyDataStruct;
- begin
- FreeOnTerminate := True;
- try
- res := upgradeApplication(appFileDir, False);
- if res = '0' then
- begin
- // 未检测到完整版客户更新才进行 dll 更新检测
- res := upgradeDllOnline(appFileDir);
- end;
- if res = '0' then
- begin
- if Self.manualCheck then
- begin
- ShowMessage('博思客户端是最新版本, 无需更新!');
- end;
- end
- else if res = BSERROR_NO_SERVCONF then
- begin
- if Self.manualCheck then
- begin
- ShowMessage('更新服务器地址为空!');
- end;
- end
- else if res = '2' then
- SendMessage(MainFromHandle, WM_UPDATE_UI2, 0, 0) // 向主线程发送 dll 更新消息
- else
- begin
- try
- sData.lpData := PChar(res);
- SendMessage(MainFromHandle, WM_UPDATE_UI1, 0, Cardinal(@sData)); // 向主线程发客户端更新消息
- finally
- // FreeMem(sData.lpData);
- end;
- end;
- finally
- end;
- end;
- end.
{ 线程 A 接收消息 }
- protected
- procedure WndProc(var Message: TMessage); override;
- // 创建线程 B
- upgradeAppThread := TUpgradeAppThread.Create(appFileDir, manualCheck); // 将检查更新放在线程中执行
- upgradeAppThread.MainFromHandle := Self.Handle;
- procedure TfrmMain.WndProc(var Message: TMessage); // 接收线程消息
- var
- param: TStringList;
- httpClient: TIdHTTP;
- controlUrl, res: string;
- appPath: string;
- cdds: TcopyDataStruct;
- begin
- res := '';
- case Message.Msg of
WM_UPDATE_UI1: { 客户端更新消息 }
- begin
- res := '博思客户端助手需要更新到最新版本, 需要关闭客户端才能更新, 是否立即更新?';
- cdds := PcopyDataStruct(Message.LParam)^;
- appPath := StrPas(PChar(cdds.lpData));
- controlUrl := 'http://' + serverIp + ':' + IntToStr(StrToInt(serverPort) + 2) + '/upgradeMainApp?fp=' + appPath;
- end;
WM_UPDATE_UI2: { dll 更新消息 }
- begin
- res := '检测到客户端组件更新, 博思客户端助手需要重启才能更新, 是否立即更新?';
- controlUrl := 'http://' + serverIp + ':' + IntToStr(StrToInt(serverPort) + 2) + '/controlMainApp?ct=2';
- end;
- else
- inherited;
- end;
- if res <> '' then
- begin
- try
- if MessageBox(Self.Handle, PChar(res), '询问', MB_ICONQUESTION + MB_YESNO + MB_TOPMOST + MB_DEFBUTTON2) = IDYES then
- begin
- param := TStringList.Create;
- httpClient := TIdHTTP.Create;
- controlUrl := StringReplace(controlUrl, '',' ', [rfReplaceAll]);
- httpClient.Post(controlUrl, param);
- end;
- finally
- httpClient.Free;
- param.Free;
- end;
- end;
- end;
来源: http://www.bubuko.com/infodetail-3289485.html