Delphi 线程间发送消息

转载自：https://www.cnblogs.com/ADAN1024225605/p/7927695.html

线程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, ' ', '%20', [rfReplaceAll]);
        httpClient.Post(controlUrl, param);
      end;
    finally
      httpClient.Free;
      param.Free;
    end;
  end;
end;