为了简化MQ调用，写了个StompClient的包装类，可以供需要的参考：
unit FStompClient; interface uses SysUtils, Windows, Messages, Classes, Graphics, Controls, Forms, Dialogs, StompClient,StompTypes; type TMQLogEvent = procedure (log: String) of object; TMQMessageEvent = procedure (msgTime: TDateTime; msgBody: String) of object; type TMQStompClient = class(TInterfacedObject, IStompClientListener) private FOnMQLogEvent: TMQLogEvent; FOnMQMsgEvent: TMQMessageEvent; FTR: string; stomp: IStompClient; th: TStompClientListener; public constructor Create; destructor Destroy; override; procedure AbortTransaction(tr: String); procedure BeginTransaction(tr: String); procedure CommitTransaction(tr: String); function ConnectToMQ(Host: String; Port: Integer = 61613; ClientID: String = 'Garfield'; User: String = ''; Password: String = ''): Boolean; procedure DisconnectMQ; procedure DurableSubscribe(subName, clientID: String); overload; procedure OnMessage(StompClient: IStompClient; StompFrame: IStompFrame; var StompListening: Boolean); procedure OnStopListen(StompClient: IStompClient); procedure SendPub(subName, body: String; Persistent: Boolean = True); procedure Subscribe(subName: String); overload; procedure Unsubscribe(subName: String); published property OnMQLogEvent: TMQLogEvent read FOnMQLogEvent write FOnMQLogEvent; property OnMQMsgEvent: TMQMessageEvent read FOnMQMsgEvent write FOnMQMsgEvent; end; implementation { TMQStompClient } { ******************************** TMQStompClient ******************************** } constructor TMQStompClient.Create; begin stomp := TStompClient.Create; end; destructor TMQStompClient.Destroy; begin if assigned(th) then begin th.StopListening; //By garfield //FreeAndNil(th); end; stomp := nil; end; procedure TMQStompClient.AbortTransaction(tr: String); begin stomp.AbortTransaction(tr); FTR:=''; end; procedure TMQStompClient.BeginTransaction(tr: String); begin FTR:=tr; stomp.BeginTransaction(tr); end; procedure TMQStompClient.CommitTransaction(tr: String); begin stomp.CommitTransaction(tr); FTR:=''; end; function TMQStompClient.ConnectToMQ(Host: String; Port: Integer = 61613; ClientID: String = 'Garfield'; User: String = ''; Password: String = ''): Boolean; begin stomp.SetUserName(User); stomp.SetPassword(Password); try stomp.Connect(Host, Port, ClientID, TStompAcceptProtocol.STOMP_Version_1_0); th := TStompClientListener.Create(stomp, Self); if Assigned(FOnMQLogEvent) then FOnMQLogEvent('连接消息服务器成功!'); Result:=True; except on E: Exception do begin Result:=False; if Assigned(FOnMQLogEvent) then FOnMQLogEvent('连接消息服务器失败!错误信息：'+E.ClassName + sLineBreak + E.Message); end; end; end; procedure TMQStompClient.DisconnectMQ; begin th.StopListening; //By garfield //FreeAndNil(th); stomp.Disconnect; if Assigned(FOnMQLogEvent) then FOnMQLogEvent('与消息服务器成功断开!'); end; procedure TMQStompClient.DurableSubscribe(subName, clientID: String); begin stomp.Subscribe(subName, amAuto, StompUtils.NewHeaders.Add(TStompHeaders.NewDurableSubscriptionHeader(clientID))); if Assigned(FOnMQLogEvent) then FOnMQLogEvent('订阅持久化主题成功:'+subName+' clientID:'+clientID); end; procedure TMQStompClient.OnMessage(StompClient: IStompClient; StompFrame: IStompFrame; var StompListening: Boolean); begin TThread.Synchronize(nil, procedure begin if StompFrame.GetBody.Length<>0 then begin if Assigned(FOnMQMsgEvent) then FOnMQMsgEvent(Now,StompFrame.GetBody); end; end); end; procedure TMQStompClient.OnStopListen(StompClient: IStompClient); begin if Assigned(FOnMQLogEvent) then FOnMQLogEvent('监听停止'); end; procedure TMQStompClient.SendPub(subName, body: String; Persistent: Boolean = True); var h: IStompHeaders; begin h := StompUtils.NewHeaders; if Persistent then h.Add(TStompHeaders.NewPersistentHeader(true)); if FTR <> '' then stomp.Send(subName, body, FTR, h) else stomp.Send(subName, body, h); end; procedure TMQStompClient.Subscribe(subName: String); begin stomp.Subscribe(subName); if Assigned(FOnMQLogEvent) then FOnMQLogEvent('订阅主题成功:'+subName); end; procedure TMQStompClient.Unsubscribe(subName: String); begin stomp.Unsubscribe(subName); end; end.
调用起来就比较简单了：
unit FfrmMain; interface uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs,FStompClient, Vcl.StdCtrls, Vcl.ExtCtrls, RzPanel; type TfrmMain = class(TForm) memLog: TMemo; RzPanel1: TRzPanel; btnConnect: TButton; btnDisconnect: TButton; btnSub: TButton; chkDurable: TCheckBox; edtSub: TLabeledEdit; edtHost: TLabeledEdit; edtPort: TLabeledEdit; edtClientID: TLabeledEdit; btnSend: TButton; edtContent: TLabeledEdit; procedure FormCreate(Sender: TObject); procedure btnConnectClick(Sender: TObject); procedure btnSubClick(Sender: TObject); procedure btnSendClick(Sender: TObject); private { Private declarations } aClient:TMQStompClient; public { Public declarations } procedure OnLog(log: String); procedure OnMsg(msgTime: TDateTime; msgBody: String); end; var frmMain: TfrmMain; implementation {$R *.dfm} procedure TfrmMain.btnConnectClick(Sender: TObject); begin aClient.ConnectToMQ(edtHost.Text,StrToInt(edtPort.Text)); end; procedure TfrmMain.btnSendClick(Sender: TObject); begin aClient.SendPub(edtSub.Text,edtContent.Text,chkDurable.Checked); end; procedure TfrmMain.btnSubClick(Sender: TObject); begin if chkDurable.Checked then aClient.DurableSubscribe(edtSub.Text,edtClientID.Text) else aClient.Subscribe(edtSub.Text); end; procedure TfrmMain.FormCreate(Sender: TObject); begin aClient:=TMQStompClient.Create; aClient.OnMQLogEvent:=OnLog; aClient.OnMQMsgEvent:=OnMsg; end; procedure TfrmMain.OnLog(log: String); begin memLog.Lines.Add(log); end; procedure TfrmMain.OnMsg(msgTime: TDateTime; msgBody: String); begin memLog.Lines.Add('收到消息：'+FormatDateTime('yyyy-mm-dd hh:mm:ss',msgTime)+' '+msgBody); end; end.
窗口定义：
object frmMain: TfrmMain Left = 0 Top = 0 Caption = 'StompClientTest' ClientHeight = 324 ClientWidth = 384 Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = 'Tahoma' Font.Style = [] OldCreateOrder = False Position = poScreenCenter OnCreate = FormCreate PixelsPerInch = 96 TextHeight = 13 object memLog: TMemo Left = 0 Top = 0 Width = 384 Height = 160 Align = alClient ScrollBars = ssBoth TabOrder = 0 end object RzPanel1: TRzPanel Left = 0 Top = 160 Width = 384 Height = 164 Align = alBottom TabOrder = 1 object btnConnect: TButton Left = 261 Top = 31 Width = 75 Height = 25 Caption = #36830#25509 TabOrder = 0 OnClick = btnConnectClick end object btnDisconnect: TButton Left = 261 Top = 124 Width = 75 Height = 25 Caption = #26029#24320 TabOrder = 1 end object btnSub: TButton Left = 261 Top = 62 Width = 75 Height = 25 Caption = #35746#38405 TabOrder = 2 OnClick = btnSubClick end object chkDurable: TCheckBox Left = 272 Top = 6 Width = 64 Height = 17 Caption = #25345#20037#21270 TabOrder = 3 end object edtSub: TLabeledEdit Left = 55 Top = 86 Width = 160 Height = 21 EditLabel.Width = 24 EditLabel.Height = 13 EditLabel.Caption = #20027#39064 LabelPosition = lpLeft TabOrder = 4 Text = '/topic/hello' end object edtHost: TLabeledEdit Left = 55 Top = 12 Width = 160 Height = 21 EditLabel.Width = 22 EditLabel.Height = 13 EditLabel.Caption = 'Host' LabelPosition = lpLeft TabOrder = 5 Text = 'localhost' end object edtPort: TLabeledEdit Left = 55 Top = 36 Width = 160 Height = 21 EditLabel.Width = 20 EditLabel.Height = 13 EditLabel.Caption = 'Port' LabelPosition = lpLeft TabOrder = 6 Text = '61613' end object edtClientID: TLabeledEdit Left = 55 Top = 59 Width = 160 Height = 21 EditLabel.Width = 38 EditLabel.Height = 13 EditLabel.Caption = 'ClientID' LabelPosition = lpLeft TabOrder = 7 Text = 'garfield' end object btnSend: TButton Left = 261 Top = 93 Width = 75 Height = 25 Caption = #21457#36865 TabOrder = 8 OnClick = btnSendClick end object edtContent: TLabeledEdit Left = 55 Top = 113 Width = 160 Height = 21 EditLabel.Width = 24 EditLabel.Height = 13 EditLabel.Caption = #20869#23481 LabelPosition = lpLeft TabOrder = 9 Text = #20320#22909#65292#27426#36814#20351#29992 end end end
