StompClient的包装类

为了简化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 = ; 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 = ;
    ClientID: String = 'Garfield'; User: String = ''; Password: String = ''):
    Boolean;
begin
  stomp.SetUserName(User);
  stomp.SetPassword(Password);
  try
    stomp.Connect(Host, Port, ClientID, TStompAcceptProtocol.STOMP_Version__);
    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<> 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 =
  Top =
  Caption = 'StompClientTest'
  ClientHeight =
  ClientWidth =
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  Position = poScreenCenter
  OnCreate = FormCreate
  PixelsPerInch =
  TextHeight =
  object memLog: TMemo
    Left =
    Top =
    Width =
    Height =
    Align = alClient
    ScrollBars = ssBoth
    TabOrder =
  end
  object RzPanel1: TRzPanel
    Left =
    Top =
    Width =
    Height =
    Align = alBottom
    TabOrder =
    object btnConnect: TButton
      Left =
      Top =
      Width =
      Height =
      Caption = ##
      TabOrder =
      OnClick = btnConnectClick
    end
    object btnDisconnect: TButton
      Left =
      Top =
      Width =
      Height =
      Caption = ##
      TabOrder =
    end
    object btnSub: TButton
      Left =
      Top =
      Width =
      Height =
      Caption = ##
      TabOrder =
      OnClick = btnSubClick
    end
    object chkDurable: TCheckBox
      Left =
      Top =
      Width =
      Height =
      Caption = ###
      TabOrder =
    end
    object edtSub: TLabeledEdit
      Left =
      Top =
      Width =
      Height =
      EditLabel.Width =
      EditLabel.Height =
      EditLabel.Caption = ##
      LabelPosition = lpLeft
      TabOrder =
      Text = '/topic/hello'
    end
    object edtHost: TLabeledEdit
      Left =
      Top =
      Width =
      Height =
      EditLabel.Width =
      EditLabel.Height =
      EditLabel.Caption = 'Host'
      LabelPosition = lpLeft
      TabOrder =
      Text = 'localhost'
    end
    object edtPort: TLabeledEdit
      Left =
      Top =
      Width =
      Height =
      EditLabel.Width =
      EditLabel.Height =
      EditLabel.Caption = 'Port'
      LabelPosition = lpLeft
      TabOrder =
      Text = ''
    end
    object edtClientID: TLabeledEdit
      Left =
      Top =
      Width =
      Height =
      EditLabel.Width =
      EditLabel.Height =
      EditLabel.Caption = 'ClientID'
      LabelPosition = lpLeft
      TabOrder =
      Text = 'garfield'
    end
    object btnSend: TButton
      Left =
      Top =
      Width =
      Height =
      Caption = ##
      TabOrder =
      OnClick = btnSendClick
    end
    object edtContent: TLabeledEdit
      Left =
      Top =
      Width =
      Height =
      EditLabel.Width =
      EditLabel.Height =
      EditLabel.Caption = ##
      LabelPosition = lpLeft
      TabOrder =
      Text = #######
    end
  end
end