unit FStompClient;interfaceuses  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;interfaceuses  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  endend