├── .gitignore ├── README.md ├── StompClient.pas ├── boss.json ├── build.bat ├── build.py ├── docs └── do not delete ├── examples ├── Chat │ ├── ChatClient │ │ ├── ChatClient.dpr │ │ ├── ChatClient.dproj │ │ ├── ChatClient.res │ │ ├── MainFormClient.dfm │ │ └── MainFormClient.pas │ ├── ChatClientD2007 │ │ ├── ChatClient.dpr │ │ ├── ChatClient.dproj │ │ ├── MainFormClient.dfm │ │ └── MainFormClient.pas │ └── ChatClientLazarus │ │ ├── ChatClient.ico │ │ ├── ChatClient.lpi │ │ ├── ChatClient.lpr │ │ ├── ChatClient.lrs │ │ ├── ChatClient.rc │ │ ├── MainFormClient.lfm │ │ ├── MainFormClient.lrs │ │ └── MainFormClient.pas ├── HeartBeats │ ├── HeartBeatsTest.dpr │ └── HeartBeatsTest.dproj ├── Multiple │ ├── MainForm.dfm │ ├── MainForm.pas │ ├── STOMPListener.dpr │ └── STOMPListener.dproj ├── QueueAck │ ├── QueueAck.groupproj │ ├── Receiver │ │ ├── Receiver.dpr │ │ ├── Receiver.dproj │ │ ├── Receiver.res │ │ ├── ReceiverForm.dfm │ │ ├── ReceiverForm.pas │ │ └── ThreadReceiver.pas │ └── SendMessage │ │ ├── SendMessage.dpr │ │ ├── SendMessage.dproj │ │ ├── SendMessage.res │ │ ├── SendMessageForm.dfm │ │ └── SendMessageForm.pas └── SimpleMessaging │ ├── SimpleMessaging.dpr │ ├── SimpleMessaging.dproj │ └── SimpleMessaging.lpi ├── packages └── lazarus │ ├── delphistomp.lpk │ └── delphistomp.pas ├── pasdocfiles.txt ├── test ├── MainU.pas ├── teststompclient.dpr ├── teststompclient.dproj ├── teststompclient2007.bdsproj ├── teststompclient2007.dpr └── teststompclient2007.dproj ├── testLazarus ├── MainU.pas ├── teststompclient.ico ├── teststompclient.lpi ├── teststompclient.lpr └── teststompclient.rc ├── tutorial ├── 10_HelloWorld │ ├── Group.groupproj │ ├── consumer.dpr │ ├── consumer.dproj │ ├── producer.dpr │ └── producer.dproj ├── 20_WorkQueues │ ├── Group.groupproj │ ├── consumer.dpr │ ├── consumer.dproj │ ├── producer.dpr │ └── producer.dproj ├── 25_DurableWorkQueues │ ├── Group.groupproj │ ├── consumer.dpr │ ├── consumer.dproj │ ├── producer.dpr │ └── producer.dproj └── 30_PublishSubscribe │ ├── Group.groupproj │ ├── consumer.dpr │ ├── consumer.dproj │ ├── consumer.res │ ├── producer.dpr │ ├── producer.dproj │ └── producer.res └── unittest ├── TestStompClient.dpr ├── TestStompClient.dproj ├── TestStompClient.res └── TestStompClientU.pas /.gitignore: -------------------------------------------------------------------------------- 1 | *~ 2 | *.dcu 3 | *.exe 4 | *.local 5 | *.identcache 6 | /boss-lock.json 7 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Delphi/FreePascal STOMP Client 2 | STOMP client for Embarcadero Delphi and FreePascal. 3 | 4 | Currently tested on 5 | - Apache ActiveMQ 5.2 6 | - Apache ActiveMQ 5.3.x 7 | - Apache ActiveMQ 5.4.2. 8 | - RabbitMQ 3.5.1+ 9 | 10 | 11 | The project can use INDY (Delphi) or Synapse (Delphi or FreePascal). In case you want to use Synapse, you have to get a copy of Synapse library from http://synapse.ararat.cz/doku.php/download. 12 | 13 | More info on the author's blog http://www.danieleteti.it/stomp-client/ 14 | 15 | Project license: [APACHE LICENSE, VERSION 2](https://www.apache.org/licenses/LICENSE-2.0) 16 | 17 | 18 | ## Delphi STOMP Client Team 19 | Daniele Teti (Lead Developer) 20 | 21 | Daniel Gaspary (Free Pascal Mantainer) 22 | 23 | ### Contributors* 24 | Oliver Marr (encoding fixes) 25 | 26 | Marco Mottadelli (iOS fixes) 27 | 28 | Chenavier Gérald (STOMP 1.1 improvement) 29 | 30 | Marcelo Varela (Raw UTF8 messages support) 31 | 32 | ### License 33 | [https://www.apache.org/licenses/LICENSE-2.0](https://www.apache.org/licenses/LICENSE-2.0) 34 | -------------------------------------------------------------------------------- /boss.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "delphistompclient", 3 | "description": "STOMP client for Embarcadero Delphi and FreePascal.", 4 | "version": "1.0.0", 5 | "homepage": "https://github.com/danieleteti/delphistompclient", 6 | "mainsrc": "./", 7 | "projects": [], 8 | "dependencies": {} 9 | } -------------------------------------------------------------------------------- /build.bat: -------------------------------------------------------------------------------- 1 | @call python build.py -------------------------------------------------------------------------------- /build.py: -------------------------------------------------------------------------------- 1 | # coding: latin-1 2 | import subprocess 3 | import os 4 | import glob 5 | from colorama import * 6 | 7 | init() 8 | 9 | 10 | ################################################################################# 11 | def buildProject(project): 12 | print(Fore.YELLOW + "Building " + project) 13 | p = project.replace('.dproj', '.cfg') 14 | if os.path.isfile(p): 15 | if os.path.isfile(p + '.unused'): 16 | os.remove(p + '.unused') 17 | os.rename(p, p + '.unused') 18 | # print os.system("msbuild /t:Build /p:Config=Debug \"" + project + "\"") 19 | return subprocess.call("rsvars.bat & msbuild /t:Build /p:Config=Debug /p:Platform=Win32 \"" + project + "\"", shell=True) == 0 20 | 21 | 22 | def summaryTable(builds): 23 | print(ansi.clear_screen()) 24 | delphistompclient_copyright() 25 | print(Fore.WHITE + "PROJECT NAME".ljust(80) + "STATUS".ljust(10)) 26 | print(Fore.YELLOW + "=" * 90) 27 | good = bad = 0 28 | for item in builds: 29 | if item['status'] == 'ok': 30 | #WConio.textcolor(WConio.LIGHTGREEN) 31 | good += 1 32 | else: 33 | #WConio.textcolor(WConio.RED) 34 | bad += 1 35 | print(Fore.BLUE + item['project'].ljust(80) + (Fore.WHITE if item['status'] == 'ok' else Fore.RED) + item['status'].ljust(4)) 36 | 37 | #WConio.textcolor(WConio.WHITE) 38 | print(Fore.YELLOW + "=" * 90) 39 | #WConio.textcolor(WConio.GREEN) 40 | print(Fore.WHITE + "GOOD :".rjust(80) + str(good).rjust(10, '.')) 41 | #WConio.textcolor(WConio.RED) 42 | print(Fore.RED + "BAD :".rjust(80) + str(bad).rjust(10, '.')) 43 | 44 | 45 | def generate_documentation(): 46 | print("Generating documentation...") 47 | subprocess.call("del .\docs\*.html", shell=True) 48 | return subprocess.call("tools\pasdoc.exe --source pasdocfiles.txt --language en --write-uses-list --format html --output .\docs --title DelphiSTOMPClient", shell=True) == 0 49 | 50 | ################################################################################# 51 | 52 | def main(projects): 53 | delphistompclient_copyright() 54 | builds = [] 55 | for project in projects: 56 | if project.find("GlobalDemo") != -1: 57 | continue 58 | filename = '\\'.join(project.split('\\')[-3:]) 59 | if filename.find('2007') > 0: #do not build Delphi 2007 examples not Lazarus examples 60 | continue 61 | list = {'project': filename} 62 | if buildProject(project): 63 | list["status"] = "ok" 64 | else: 65 | list["status"] = "ko" 66 | builds.append(list) 67 | generate_documentation() 68 | summaryTable(builds) 69 | 70 | # Store current attribute settings 71 | #old_setting = WConio.gettextinfo()[4] & 0x00FF 72 | 73 | def delphistompclient_copyright(): 74 | print(Style.BRIGHT + Fore.WHITE + "------------------------------------------------------------------------------------------") 75 | print(Fore.RED + " ** Delphi STOMP Client Building System **") 76 | print(Fore.WHITE + " Delphi STOMP Client is CopyRight (2010-2017) of Daniele Teti d.teti@bittime.it") 77 | print(Fore.RESET + "------------------------------------------------------------------------------------------\n") 78 | 79 | ## MAIN ## 80 | projects = glob.glob("examples\**\**\*.dproj") 81 | projects += glob.glob("examples\**\*.dproj") 82 | projects += glob.glob("tutorial\**\*.dproj") 83 | projects += glob.glob("unittest\**\*.dproj") 84 | 85 | main(projects) 86 | print(Style.RESET_ALL) -------------------------------------------------------------------------------- /docs/do not delete: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/danieleteti/delphistompclient/8aad53b690494f441fee7c3eb3b96007bfdffde6/docs/do not delete -------------------------------------------------------------------------------- /examples/Chat/ChatClient/ChatClient.dpr: -------------------------------------------------------------------------------- 1 | program ChatClient; 2 | 3 | uses 4 | Forms, 5 | MainFormClient in 'MainFormClient.pas' {Form5}, 6 | StompClient in '..\..\..\StompClient.pas'; 7 | 8 | {$R *.res} 9 | 10 | begin 11 | Application.Initialize; 12 | Application.MainFormOnTaskbar := True; 13 | Application.CreateForm(TForm5, Form5); 14 | Application.Run; 15 | end. 16 | -------------------------------------------------------------------------------- /examples/Chat/ChatClient/ChatClient.dproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | {725AE3B6-F1CE-42B3-BA06-F919DCE3AB46} 4 | 18.1 5 | ChatClient.dpr 6 | Debug 7 | DCC32 8 | VCL 9 | True 10 | Win32 11 | 1 12 | Application 13 | 14 | 15 | true 16 | 17 | 18 | true 19 | Base 20 | true 21 | 22 | 23 | true 24 | Base 25 | true 26 | 27 | 28 | true 29 | Base 30 | true 31 | 32 | 33 | true 34 | Base 35 | true 36 | 37 | 38 | true 39 | Cfg_2 40 | true 41 | true 42 | 43 | 44 | ChatClient 45 | Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;Winapi;$(DCC_Namespace) 46 | CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= 47 | 1040 48 | ..\..\bin\ChatClient.exe 49 | ..\..\bin 50 | rtl;dbexpress;DbxCommonDriver;DataSnapIndy10ServerTransport;DataSnapProviderClient;DataSnapServer;DbxClientDriver;DBXInterBaseDriver;DBXMySQLDriver;vcl;dbrtl;vcldb;dbxcds;vclx;DBXSybaseASEDriver;DBXSybaseASADriver;DBXOracleDriver;DBXMSSQLDriver;DBXInformixDriver;DBXDb2Driver;dsnap;Rave76VCL;bdertl;vclactnband;dsnapcon;TeeUI;TeeDB;Tee;adortl;vclib;ibxpress;IndyCore;IndySystem;IndyProtocols;xmlrtl;inet;VclSmp;vclie;soaprtl;inetdbbde;inetdbxpress;vclribbon;PerlRegExD2009;SnapDataset;ipstudiowingrid;ZComponent;ZDbc;ZPlain;ZCore;ZParseSql;JclVcl;Jcl;JvCoreD12R;JvSystemD12R;JvStdCtrlsD12R;JvAppFrmD12R;JvBandsD12R;JvCmpD12R;JvCryptD12R;JvCtrlsD12R;JvCustomD12R;JvDBD12R;JvDlgsD12R;JvDockingD12R;JvDotNetCtrlsD12R;JvGlobusD12R;JvHMID12R;JvInterpreterD12R;JvJansD12R;JvManagedThreadsD12R;JvMMD12R;JvNetD12R;JvPageCompsD12R;JvPluginD12R;JvPrintPreviewD12R;JvRuntimeDesignD12R;JvTimeFrameworkD12R;JvValidatorsD12R;JvWizardD12R;JvXPCtrlsD12R;FIBPlus2009;FIBDBMidas2009;TMSSmoothControlsPackPkgD2009;JazzMVP;JazzOPF;JazzVTF;dacvcl120;dac120;ibdacvcl120;ibdac120;JazzOPFFirebird;JazzMVPVCL;JazzDBAdapter;CRControls120;DotNet4Delphi_2009;JazzOPFADO;JazzOPFIBX;DeHL_Package;webdsnap;VirtualTreesD12;$(DCC_UsePackage) 51 | 00400000 52 | x86 53 | 54 | 55 | true 56 | true 57 | ChatClient_Icon.ico 58 | System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) 59 | 1033 60 | $(BDS)\bin\default_app.manifest 61 | 62 | 63 | true 64 | ChatClient_Icon.ico 65 | $(BDS)\bin\default_app.manifest 66 | 67 | 68 | false 69 | RELEASE;$(DCC_Define) 70 | 0 71 | 0 72 | 73 | 74 | DEBUG;$(DCC_Define) 75 | 76 | 77 | true 78 | $(BDS)\bin\delphi_PROJECTICON.ico 79 | 1033 80 | 81 | 82 | 83 | MainSource 84 | 85 | 86 |
Form5
87 |
88 | 89 | 90 | Cfg_2 91 | Base 92 | 93 | 94 | Base 95 | 96 | 97 | Cfg_1 98 | Base 99 | 100 |
101 | 102 | 103 | Delphi.Personality.12 104 | 105 | 106 | 107 | 108 | ChatClient.dpr 109 | 110 | 111 | False 112 | True 113 | False 114 | 115 | 116 | False 117 | False 118 | 1 119 | 0 120 | 0 121 | 0 122 | False 123 | False 124 | False 125 | False 126 | False 127 | 1040 128 | 1252 129 | 130 | 131 | 132 | 133 | 1.0.0.0 134 | 135 | 136 | 137 | 138 | 139 | 1.0.0.0 140 | 141 | 142 | 143 | Embarcadero C++Builder Office 2000 Servers Package 144 | Embarcadero C++Builder Office XP Servers Package 145 | Microsoft Office 2000 Sample Automation Server Wrapper Components 146 | Microsoft Office XP Sample Automation Server Wrapper Components 147 | 148 | 149 | 150 | True 151 | False 152 | 153 | 154 | 12 155 | 156 | 157 |
158 | -------------------------------------------------------------------------------- /examples/Chat/ChatClient/ChatClient.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/danieleteti/delphistompclient/8aad53b690494f441fee7c3eb3b96007bfdffde6/examples/Chat/ChatClient/ChatClient.res -------------------------------------------------------------------------------- /examples/Chat/ChatClient/MainFormClient.dfm: -------------------------------------------------------------------------------- 1 | object Form5: TForm5 2 | Left = 0 3 | Top = 0 4 | Caption = 'Delphi Stomp Client - CHAT DEMO - www.danieleteti.it' 5 | ClientHeight = 435 6 | ClientWidth = 511 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -11 11 | Font.Name = 'Tahoma' 12 | Font.Style = [] 13 | OldCreateOrder = False 14 | DesignSize = ( 15 | 511 16 | 435) 17 | PixelsPerInch = 96 18 | TextHeight = 13 19 | object Edit1: TEdit 20 | Left = 7 21 | Top = 10 22 | Width = 137 23 | Height = 21 24 | TabOrder = 0 25 | Text = 'localhost' 26 | end 27 | object Edit2: TEdit 28 | Left = 150 29 | Top = 10 30 | Width = 121 31 | Height = 21 32 | TabOrder = 1 33 | Text = 'ChatRoomName' 34 | end 35 | object Button1: TButton 36 | Left = 404 37 | Top = 8 38 | Width = 99 39 | Height = 25 40 | Caption = 'Enter' 41 | TabOrder = 2 42 | OnClick = Button1Click 43 | end 44 | object Edit3: TEdit 45 | Left = 277 46 | Top = 10 47 | Width = 121 48 | Height = 21 49 | TabOrder = 3 50 | Text = 'daniele_teti' 51 | end 52 | object Memo1: TMemo 53 | Left = 9 54 | Top = 39 55 | Width = 494 56 | Height = 314 57 | Anchors = [akLeft, akTop, akRight, akBottom] 58 | Color = clMenuBar 59 | Font.Charset = ANSI_CHARSET 60 | Font.Color = clHotLight 61 | Font.Height = -12 62 | Font.Name = 'Courier New' 63 | Font.Style = [] 64 | ParentFont = False 65 | ReadOnly = True 66 | TabOrder = 4 67 | end 68 | object Memo2: TMemo 69 | Left = 8 70 | Top = 359 71 | Width = 389 72 | Height = 68 73 | Anchors = [akLeft, akRight, akBottom] 74 | Enabled = False 75 | Font.Charset = ANSI_CHARSET 76 | Font.Color = clWindowText 77 | Font.Height = -13 78 | Font.Name = 'Courier New' 79 | Font.Style = [fsBold] 80 | ParentFont = False 81 | TabOrder = 5 82 | OnKeyUp = Memo2KeyUp 83 | end 84 | object Button2: TButton 85 | Left = 403 86 | Top = 359 87 | Width = 100 88 | Height = 68 89 | Anchors = [akRight, akBottom] 90 | Caption = 'Send' 91 | Enabled = False 92 | TabOrder = 6 93 | OnClick = Button2Click 94 | end 95 | object tmr: TTimer 96 | Enabled = False 97 | Interval = 100 98 | OnTimer = tmrTimer 99 | Left = 432 100 | Top = 72 101 | end 102 | end 103 | -------------------------------------------------------------------------------- /examples/Chat/ChatClient/MainFormClient.pas: -------------------------------------------------------------------------------- 1 | unit MainFormClient; 2 | 3 | interface 4 | 5 | uses 6 | Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 7 | Dialogs, StdCtrls, ExtCtrls, StompClient; 8 | 9 | type 10 | TForm5 = class(TForm) 11 | Edit1: TEdit; 12 | Edit2: TEdit; 13 | Button1: TButton; 14 | Edit3: TEdit; 15 | Memo1: TMemo; 16 | Memo2: TMemo; 17 | Button2: TButton; 18 | tmr: TTimer; 19 | procedure Button1Click(Sender: TObject); 20 | procedure tmrTimer(Sender: TObject); 21 | procedure Button2Click(Sender: TObject); 22 | procedure Memo2KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); 23 | private 24 | stomp: IStompClient; 25 | roomname: string; 26 | public 27 | { Public declarations } 28 | end; 29 | 30 | var 31 | Form5: TForm5; 32 | 33 | implementation 34 | 35 | 36 | {$R *.dfm} 37 | 38 | procedure TForm5.Button1Click(Sender: TObject); 39 | begin 40 | roomname := '/topic/' + Edit2.Text; 41 | stomp := StompUtils.StompClient; 42 | // stomp.SetUserName('admin'); 43 | // stomp.SetPassword('password'); 44 | stomp.SetHost(Edit1.Text).Connect; 45 | 46 | //Setup for reading messages 47 | stomp.Subscribe(roomname, amClient); 48 | 49 | Button1.Enabled := False; 50 | Edit1.Enabled := False; 51 | Edit2.Enabled := False; 52 | Edit3.Enabled := False; 53 | Button2.Enabled := True; 54 | Memo2.Enabled := True; 55 | 56 | tmr.Enabled := true; 57 | end; 58 | 59 | procedure TForm5.Button2Click(Sender: TObject); 60 | begin 61 | stomp.Send(roomname, Memo2.Lines.Text, 62 | StompUtils.Headers 63 | .Add('sender', Edit3.Text) 64 | .Add('datetime', formatdatetime('yyyy/mm/dd hh:nn:ss', now)) 65 | .Add(StompUtils.NewPersistentHeader(true)) 66 | ); 67 | Memo2.Lines.Clear; 68 | end; 69 | 70 | procedure TForm5.Memo2KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); 71 | begin 72 | if (key = 13) and not (ssCtrl in Shift) then 73 | begin 74 | key := 0; 75 | Button2.Click; 76 | end; 77 | end; 78 | 79 | procedure TForm5.tmrTimer(Sender: TObject); 80 | var 81 | f: IStompFrame; 82 | fw: FLASHWINFO; 83 | begin 84 | f := stomp.Receive(50); //this should be done in a secondary thread 85 | if assigned(f) then 86 | begin 87 | Memo1.Lines.Add('[' + f.GetHeaders.Value('datetime') + ' ' + f.GetHeaders.Value('sender') + ']' + sLineBreak + f.GetBody); 88 | if (WindowState = wsMinimized) or (Application.ActiveFormHandle <> self.Handle) then 89 | begin 90 | fw.cbSize := SizeOf(FLASHWINFO); 91 | fw.hwnd := self.Handle; 92 | fw.dwFlags := FLASHW_ALL; 93 | fw.uCount := 5; 94 | fw.dwTimeout := 500; 95 | FlashWindowEx(fw); 96 | end; 97 | end; 98 | 99 | end; 100 | 101 | end. 102 | -------------------------------------------------------------------------------- /examples/Chat/ChatClientD2007/ChatClient.dpr: -------------------------------------------------------------------------------- 1 | program ChatClient; 2 | 3 | uses 4 | Forms, 5 | MainFormClient in 'MainFormClient.pas' {Form5}, 6 | StompClient in '..\..\..\StompClient.pas', 7 | StompTypes in '..\..\..\StompTypes.pas'; 8 | 9 | {$R *.res} 10 | 11 | begin 12 | Application.Initialize; 13 | Application.MainFormOnTaskbar := True; 14 | Application.CreateForm(TForm5, Form5); 15 | Application.Run; 16 | end. 17 | -------------------------------------------------------------------------------- /examples/Chat/ChatClientD2007/ChatClient.dproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | {71be8a82-8d1c-4b5f-b060-1e2770d47dea} 4 | ChatClient.dpr 5 | Debug 6 | AnyCPU 7 | DCC32 8 | ..\..\bin\ChatClient.exe 9 | 10 | 11 | 7.0 12 | False 13 | False 14 | 0 15 | RELEASE 16 | 17 | 18 | 7.0 19 | DEBUG 20 | C:\Programmi\CodeGear\RAD Studio\5.0\source\Indy\Indy10\Core;C:\Programmi\CodeGear\RAD Studio\5.0\source\Indy\Indy10\Protocols;C:\Programmi\CodeGear\RAD Studio\5.0\source\Indy\Indy10\System 21 | C:\Programmi\CodeGear\RAD Studio\5.0\source\Indy\Indy10\Core;C:\Programmi\CodeGear\RAD Studio\5.0\source\Indy\Indy10\Protocols;C:\Programmi\CodeGear\RAD Studio\5.0\source\Indy\Indy10\System 22 | C:\Programmi\CodeGear\RAD Studio\5.0\source\Indy\Indy10\Core;C:\Programmi\CodeGear\RAD Studio\5.0\source\Indy\Indy10\Protocols;C:\Programmi\CodeGear\RAD Studio\5.0\source\Indy\Indy10\System 23 | C:\Programmi\CodeGear\RAD Studio\5.0\source\Indy\Indy10\Core;C:\Programmi\CodeGear\RAD Studio\5.0\source\Indy\Indy10\Protocols;C:\Programmi\CodeGear\RAD Studio\5.0\source\Indy\Indy10\System 24 | ..\..\bin 25 | 26 | 27 | Delphi.Personality 28 | VCLApplication 29 | 30 | FalseTrueFalseFalseFalse1000FalseFalseFalseFalseFalse104012521.0.0.01.0.0.0 31 | 32 | 33 | 34 | 35 | 36 | 37 | Microsoft Office 2000 Sample Automation Server Wrapper Components 38 | Microsoft Office XP Sample Automation Server Wrapper Components 39 | ChatClient.dpr 40 | 41 | 42 | 43 | 44 | MainSource 45 | 46 | 47 | 48 | 49 |
Form5
50 |
51 |
52 |
-------------------------------------------------------------------------------- /examples/Chat/ChatClientD2007/MainFormClient.dfm: -------------------------------------------------------------------------------- 1 | object Form5: TForm5 2 | Left = 0 3 | Top = 0 4 | Caption = 'Delphi Stomp Client - CHAT DEMO - www.danieleteti.it' 5 | ClientHeight = 435 6 | ClientWidth = 511 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -11 11 | Font.Name = 'Tahoma' 12 | Font.Style = [] 13 | OldCreateOrder = False 14 | DesignSize = ( 15 | 511 16 | 435) 17 | PixelsPerInch = 96 18 | TextHeight = 13 19 | object Edit1: TEdit 20 | Left = 7 21 | Top = 10 22 | Width = 137 23 | Height = 21 24 | TabOrder = 0 25 | Text = 'localhost' 26 | end 27 | object Edit2: TEdit 28 | Left = 150 29 | Top = 10 30 | Width = 121 31 | Height = 21 32 | TabOrder = 1 33 | Text = 'ChatRoomName' 34 | end 35 | object Button1: TButton 36 | Left = 404 37 | Top = 8 38 | Width = 99 39 | Height = 25 40 | Caption = 'Enter' 41 | TabOrder = 2 42 | OnClick = Button1Click 43 | end 44 | object Edit3: TEdit 45 | Left = 277 46 | Top = 10 47 | Width = 121 48 | Height = 21 49 | TabOrder = 3 50 | Text = 'daniele_teti' 51 | end 52 | object Memo1: TMemo 53 | Left = 9 54 | Top = 39 55 | Width = 494 56 | Height = 314 57 | Anchors = [akLeft, akTop, akRight, akBottom] 58 | Color = clMenuBar 59 | Font.Charset = ANSI_CHARSET 60 | Font.Color = clHotLight 61 | Font.Height = -12 62 | Font.Name = 'Courier New' 63 | Font.Style = [] 64 | ParentFont = False 65 | ReadOnly = True 66 | TabOrder = 4 67 | end 68 | object Memo2: TMemo 69 | Left = 8 70 | Top = 359 71 | Width = 389 72 | Height = 68 73 | Anchors = [akLeft, akRight, akBottom] 74 | Enabled = False 75 | Font.Charset = ANSI_CHARSET 76 | Font.Color = clWindowText 77 | Font.Height = -13 78 | Font.Name = 'Courier New' 79 | Font.Style = [fsBold] 80 | ParentFont = False 81 | TabOrder = 5 82 | OnKeyUp = Memo2KeyUp 83 | end 84 | object Button2: TButton 85 | Left = 403 86 | Top = 359 87 | Width = 100 88 | Height = 68 89 | Anchors = [akRight, akBottom] 90 | Caption = 'Send' 91 | Enabled = False 92 | TabOrder = 6 93 | OnClick = Button2Click 94 | end 95 | object tmr: TTimer 96 | Enabled = False 97 | Interval = 100 98 | OnTimer = tmrTimer 99 | Left = 432 100 | Top = 72 101 | end 102 | end 103 | -------------------------------------------------------------------------------- /examples/Chat/ChatClientD2007/MainFormClient.pas: -------------------------------------------------------------------------------- 1 | unit MainFormClient; 2 | 3 | interface 4 | 5 | uses 6 | Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 7 | Dialogs, StdCtrls, ExtCtrls, stompclient; 8 | 9 | type 10 | TForm5 = class(TForm) 11 | Edit1: TEdit; 12 | Edit2: TEdit; 13 | Button1: TButton; 14 | Edit3: TEdit; 15 | Memo1: TMemo; 16 | Memo2: TMemo; 17 | Button2: TButton; 18 | tmr: TTimer; 19 | procedure Button1Click(Sender: TObject); 20 | procedure tmrTimer(Sender: TObject); 21 | procedure Button2Click(Sender: TObject); 22 | procedure Memo2KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); 23 | private 24 | stomp: TStompClient; 25 | roomname: string; 26 | public 27 | { Public declarations } 28 | end; 29 | 30 | var 31 | Form5: TForm5; 32 | 33 | implementation 34 | 35 | uses 36 | StompTypes; 37 | 38 | 39 | {$R *.dfm} 40 | 41 | procedure TForm5.Button1Click(Sender: TObject); 42 | begin 43 | roomname := '/topic/' + Edit2.Text; 44 | stomp := TStompClient.Create; 45 | stomp.EnableReceipts := false; 46 | stomp.Timeout := 10; 47 | stomp.Connect(Edit1.Text); 48 | 49 | //Setup for reading messages 50 | stomp.Subscribe(roomname, amAuto); 51 | 52 | Button1.Enabled := False; 53 | Edit1.Enabled := False; 54 | Edit2.Enabled := False; 55 | Edit3.Enabled := False; 56 | Button2.Enabled := True; 57 | Memo2.Enabled := True; 58 | tmr.Enabled := true; 59 | end; 60 | 61 | procedure TForm5.Button2Click(Sender: TObject); 62 | begin 63 | stomp.Send(roomname, Memo2.Lines.Text, 64 | StompUtils.StompHeaders 65 | .Add('sender', Edit3.Text) 66 | .Add('datetime', formatdatetime('yyyy/mm/dd hh:nn:ss', now)) 67 | .Add(shPersistent) 68 | ); 69 | Memo2.Lines.Clear; 70 | end; 71 | 72 | procedure TForm5.Memo2KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); 73 | begin 74 | if (key = 13) and not (ssCtrl in Shift) then 75 | begin 76 | key := 0; 77 | Button2.Click; 78 | end; 79 | end; 80 | 81 | procedure TForm5.tmrTimer(Sender: TObject); 82 | var 83 | f: TStompFrame; 84 | fw: FLASHWINFO; 85 | begin 86 | f := stomp.Receive; 87 | if assigned(f) then 88 | begin 89 | Memo1.Lines.Add('[' + f.Headers.Value('datetime') + ' ' + f.Headers.Value('sender') + ']' + sLineBreak + f.Body); 90 | if (WindowState = wsMinimized) or (Application.ActiveFormHandle <> self.Handle) then 91 | begin 92 | fw.cbSize := SizeOf(FLASHWINFO); 93 | fw.hwnd := self.Handle; 94 | fw.dwFlags := FLASHW_ALL; 95 | fw.uCount := 5; 96 | fw.dwTimeout := 500; 97 | FlashWindowEx(fw); 98 | end; 99 | end; 100 | end; 101 | 102 | end. 103 | -------------------------------------------------------------------------------- /examples/Chat/ChatClientLazarus/ChatClient.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/danieleteti/delphistompclient/8aad53b690494f441fee7c3eb3b96007bfdffde6/examples/Chat/ChatClientLazarus/ChatClient.ico -------------------------------------------------------------------------------- /examples/Chat/ChatClientLazarus/ChatClient.lpi: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57 | 58 | 59 | 60 | 61 | 62 | 63 | 64 | 65 | 66 | 67 | 68 | 69 | 70 | 71 | 72 | 73 | 74 | 75 | 76 | 77 | 78 | 79 | 80 | 81 | 82 | 83 | 84 | 85 | 86 | 87 | 88 | 89 | 90 | 91 | 92 | 93 | 94 | 95 | 96 | 97 | 98 | 99 | 100 | 101 | 102 | 103 | 104 | 105 | 106 | 107 | 108 | 109 | 110 | 111 | 112 | 113 | 114 | 115 | 116 | 117 | 118 | 119 | 120 | 121 | 122 | 123 | 124 | 125 | 126 | 127 | 128 | 129 | 130 | 131 | 132 | 133 | 134 | 135 | 136 | 137 | 138 | 139 | 140 | 141 | 142 | 143 | 144 | 145 | 146 | 147 | 148 | 149 | 150 | 151 | 152 | 153 | 154 | 155 | 156 | 157 | 158 | 159 | 160 | 161 | 162 | 163 | 164 | 165 | 166 | 167 | 168 | 169 | 170 | 171 | 172 | 173 | 174 | 175 | 176 | 177 | 178 | 179 | 180 | 181 | 182 | 183 | 184 | 185 | 186 | 187 | 188 | 189 | 190 | 191 | 192 | 193 | 194 | 195 | 196 | 197 | 198 | 199 | 200 | 201 | 202 | 203 | 204 | 205 | 206 | 207 | 208 | 209 | 210 | 211 | 212 | 213 | 214 | 215 | 216 | 217 | 218 | 219 | 220 | 221 | 222 | 223 | 224 | 225 | 226 | 227 | 228 | 229 | 230 | 231 | 232 | 233 | 234 | 235 | 236 | 237 | 238 | 239 | 240 | 241 | 242 | 243 | 244 | 245 | 246 | 247 | 248 | 249 | 250 | 251 | 252 | 253 | 254 | 255 | 256 | 257 | 258 | 259 | 260 | 261 | 262 | 263 | 264 | 265 | 266 | 267 | 268 | 269 | 270 | -------------------------------------------------------------------------------- /examples/Chat/ChatClientLazarus/ChatClient.lpr: -------------------------------------------------------------------------------- 1 | program ChatClient; 2 | 3 | {$MODE Delphi} 4 | 5 | uses 6 | {$IFDEF UNIX} 7 | cthreads, 8 | {$ENDIF} 9 | Forms, LResources, Interfaces, 10 | MainFormClient in 'MainFormClient.pas' {Form5}, 11 | StompClient in '../../../StompClient.pas', 12 | StompTypes in '../../../StompTypes.pas'; 13 | 14 | {$IFDEF WINDOWS}{$R ChatClient.rc}{$ENDIF} 15 | 16 | begin 17 | {$I ChatClient.lrs} 18 | Application.Initialize; 19 | //Application.MainFormOnTaskbar := True; 20 | Application.CreateForm(TForm5, Form5); 21 | Application.Run; 22 | end. 23 | -------------------------------------------------------------------------------- /examples/Chat/ChatClientLazarus/ChatClient.rc: -------------------------------------------------------------------------------- 1 | MAINICON ICON "ChatClient.ico" 2 | -------------------------------------------------------------------------------- /examples/Chat/ChatClientLazarus/MainFormClient.lfm: -------------------------------------------------------------------------------- 1 | object Form5: TForm5 2 | Left = 258 3 | Height = 435 4 | Top = 190 5 | Width = 511 6 | ActiveControl = Button1 7 | Caption = 'Delphi Stomp Client - CHAT DEMO - www.danieleteti.it' 8 | ClientHeight = 435 9 | ClientWidth = 511 10 | Font.Height = -11 11 | Font.Name = 'Tahoma' 12 | OnClose = FormClose 13 | OnCreate = FormCreate 14 | LCLVersion = '0.9.29' 15 | object Edit1: TEdit 16 | Left = 7 17 | Height = 23 18 | Top = 10 19 | Width = 137 20 | TabOrder = 0 21 | Text = 'localhost' 22 | end 23 | object Edit2: TEdit 24 | Left = 150 25 | Height = 23 26 | Top = 10 27 | Width = 121 28 | TabOrder = 1 29 | Text = 'ChatRoomName' 30 | end 31 | object Button1: TButton 32 | Left = 404 33 | Height = 25 34 | Top = 8 35 | Width = 99 36 | Caption = 'Enter' 37 | OnClick = Button1Click 38 | TabOrder = 2 39 | end 40 | object Edit3: TEdit 41 | Left = 277 42 | Height = 23 43 | Top = 10 44 | Width = 121 45 | TabOrder = 3 46 | Text = 'daniele_teti' 47 | end 48 | object Memo1: TMemo 49 | Left = 9 50 | Height = 314 51 | Top = 39 52 | Width = 494 53 | Anchors = [akTop, akLeft, akRight, akBottom] 54 | Color = clMenuBar 55 | Font.CharSet = ANSI_CHARSET 56 | Font.Height = -12 57 | Font.Name = 'Courier New' 58 | ParentFont = False 59 | ReadOnly = True 60 | TabOrder = 4 61 | end 62 | object Memo2: TMemo 63 | Left = 8 64 | Height = 68 65 | Top = 359 66 | Width = 389 67 | Anchors = [akLeft, akRight, akBottom] 68 | Enabled = False 69 | Font.CharSet = ANSI_CHARSET 70 | Font.Height = -13 71 | Font.Name = 'Courier New' 72 | Font.Style = [fsBold] 73 | OnKeyUp = Memo2KeyUp 74 | ParentFont = False 75 | TabOrder = 5 76 | end 77 | object Button2: TButton 78 | Left = 403 79 | Height = 68 80 | Top = 359 81 | Width = 100 82 | Anchors = [akRight, akBottom] 83 | Caption = 'Send' 84 | Enabled = False 85 | OnClick = Button2Click 86 | TabOrder = 6 87 | end 88 | object tmr: TTimer 89 | Interval = 20 90 | OnTimer = tmrTimer 91 | left = 392 92 | top = 82 93 | end 94 | end 95 | -------------------------------------------------------------------------------- /examples/Chat/ChatClientLazarus/MainFormClient.lrs: -------------------------------------------------------------------------------- 1 | { This is an automatically generated lazarus resource file } 2 | 3 | LazarusResources.Add('TForm5','FORMDATA',[ 4 | 'TPF0'#6'TForm5'#5'Form5'#4'Left'#3#2#1#6'Height'#3#179#1#3'Top'#3#190#0#5'Wi' 5 | +'dth'#3#255#1#13'ActiveControl'#7#7'Button1'#7'Caption'#6'4Delphi Stomp Clie' 6 | +'nt - CHAT DEMO - www.danieleteti.it'#12'ClientHeight'#3#179#1#11'ClientWidt' 7 | +'h'#3#255#1#11'Font.Height'#2#245#9'Font.Name'#6#6'Tahoma'#7'OnClose'#7#9'Fo' 8 | +'rmClose'#8'OnCreate'#7#10'FormCreate'#10'LCLVersion'#6#6'0.9.29'#0#5'TEdit' 9 | +#5'Edit1'#4'Left'#2#7#6'Height'#2#23#3'Top'#2#10#5'Width'#3#137#0#8'TabOrder' 10 | +#2#0#4'Text'#6#9'localhost'#0#0#5'TEdit'#5'Edit2'#4'Left'#3#150#0#6'Height'#2 11 | +#23#3'Top'#2#10#5'Width'#2'y'#8'TabOrder'#2#1#4'Text'#6#12'ChatRoomName'#0#0 12 | +#7'TButton'#7'Button1'#4'Left'#3#148#1#6'Height'#2#25#3'Top'#2#8#5'Width'#2 13 | +'c'#7'Caption'#6#5'Enter'#7'OnClick'#7#12'Button1Click'#8'TabOrder'#2#2#0#0#5 14 | +'TEdit'#5'Edit3'#4'Left'#3#21#1#6'Height'#2#23#3'Top'#2#10#5'Width'#2'y'#8'T' 15 | +'abOrder'#2#3#4'Text'#6#12'daniele_teti'#0#0#5'TMemo'#5'Memo1'#4'Left'#2#9#6 16 | +'Height'#3':'#1#3'Top'#2''''#5'Width'#3#238#1#7'Anchors'#11#5'akTop'#6'akLef' 17 | +'t'#7'akRight'#8'akBottom'#0#5'Color'#7#9'clMenuBar'#12'Font.CharSet'#7#12'A' 18 | +'NSI_CHARSET'#11'Font.Height'#2#244#9'Font.Name'#6#11'Courier New'#10'Parent' 19 | +'Font'#8#8'ReadOnly'#9#8'TabOrder'#2#4#0#0#5'TMemo'#5'Memo2'#4'Left'#2#8#6'H' 20 | +'eight'#2'D'#3'Top'#3'g'#1#5'Width'#3#133#1#7'Anchors'#11#6'akLeft'#7'akRigh' 21 | +'t'#8'akBottom'#0#7'Enabled'#8#12'Font.CharSet'#7#12'ANSI_CHARSET'#11'Font.H' 22 | +'eight'#2#243#9'Font.Name'#6#11'Courier New'#10'Font.Style'#11#6'fsBold'#0#7 23 | +'OnKeyUp'#7#10'Memo2KeyUp'#10'ParentFont'#8#8'TabOrder'#2#5#0#0#7'TButton'#7 24 | +'Button2'#4'Left'#3#147#1#6'Height'#2'D'#3'Top'#3'g'#1#5'Width'#2'd'#7'Ancho' 25 | +'rs'#11#7'akRight'#8'akBottom'#0#7'Caption'#6#4'Send'#7'Enabled'#8#7'OnClick' 26 | +#7#12'Button2Click'#8'TabOrder'#2#6#0#0#6'TTimer'#3'tmr'#8'Interval'#2#20#7 27 | +'OnTimer'#7#8'tmrTimer'#4'left'#3#136#1#3'top'#2'R'#0#0#0 28 | ]); 29 | -------------------------------------------------------------------------------- /examples/Chat/ChatClientLazarus/MainFormClient.pas: -------------------------------------------------------------------------------- 1 | unit MainFormClient; 2 | 3 | {$MODE Delphi} 4 | 5 | interface 6 | 7 | uses 8 | SysUtils, Classes, Forms, StdCtrls, ExtCtrls, LResources, StompClient; 9 | 10 | type 11 | 12 | TStompFrameReceiveEvent = procedure of object; 13 | 14 | { TReceiverThread } 15 | TReceiverThread = class(TThread) 16 | private 17 | FOnReceiveEvent: TStompFrameReceiveEvent; 18 | protected 19 | procedure Execute; override; 20 | public 21 | property OnReceiveEvent: TStompFrameReceiveEvent read FOnReceiveEvent write FOnReceiveEvent; 22 | end; 23 | 24 | 25 | { TForm5 } 26 | 27 | TForm5 = class(TForm) 28 | Edit1: TEdit; 29 | Edit2: TEdit; 30 | Button1: TButton; 31 | Edit3: TEdit; 32 | Memo1: TMemo; 33 | Memo2: TMemo; 34 | Button2: TButton; 35 | tmr: TTimer; 36 | procedure Button1Click(Sender: TObject); 37 | procedure tmrTimer(Sender: TObject); 38 | procedure FormCreate(Sender: TObject); 39 | procedure FormClose(Sender: TObject; var CloseAction: TCloseAction); 40 | procedure Receive; 41 | procedure Button2Click(Sender: TObject); 42 | procedure Memo2KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); 43 | private 44 | stomp: TStompClient; 45 | roomname: string; 46 | receiver: TReceiverThread; 47 | public 48 | { Public declarations } 49 | end; 50 | 51 | var 52 | Form5: TForm5; 53 | 54 | implementation 55 | 56 | uses 57 | StompTypes; 58 | 59 | { TReceiverThread } 60 | procedure TReceiverThread.Execute; 61 | begin 62 | while not Terminated do 63 | begin 64 | if Assigned(OnReceiveEvent) 65 | then 66 | OnReceiveEvent; 67 | end; 68 | end; 69 | 70 | { TForm5 } 71 | procedure TForm5.Button1Click(Sender: TObject); 72 | begin 73 | roomname := '/topic/' + Edit2.Text; 74 | stomp := TStompClient.Create; 75 | stomp.Connect(Edit1.Text); 76 | 77 | //Setup for reading messages 78 | stomp.Subscribe(roomname, amClient); 79 | 80 | Button1.Enabled := False; 81 | Edit1.Enabled := False; 82 | Edit2.Enabled := False; 83 | Edit3.Enabled := False; 84 | Button2.Enabled := True; 85 | Memo2.Enabled := True; 86 | 87 | receiver.Resume; 88 | end; 89 | 90 | procedure TForm5.FormClose(Sender: TObject; var CloseAction: TCloseAction); 91 | begin 92 | receiver.FreeOnTerminate:=true; 93 | receiver.Terminate; 94 | end; 95 | 96 | procedure TForm5.FormCreate(Sender: TObject); 97 | begin 98 | receiver:=TReceiverThread.Create(true); 99 | receiver.OnReceiveEvent:=Receive; 100 | end; 101 | 102 | procedure TForm5.Button2Click(Sender: TObject); 103 | var 104 | h: IStompHeaders; 105 | begin 106 | h:=StompUtils.NewHeaders; 107 | h.Add('sender', Edit3.Text); 108 | h.Add('datetime', formatdatetime('yyyy/mm/dd hh:nn:ss', now)); 109 | h.Add(TStompHeaders.newPersistentHeader(true)); 110 | 111 | stomp.Send(roomname, Memo2.Lines.Text, h); 112 | 113 | Memo2.Lines.Clear; 114 | end; 115 | 116 | procedure TForm5.Memo2KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); 117 | begin 118 | if (key = 13) and not (ssCtrl in Shift) then 119 | begin 120 | key := 0; 121 | Button2.Click; 122 | end; 123 | end; 124 | 125 | procedure TForm5.tmrTimer(Sender: TObject); 126 | begin 127 | Application.ProcessMessages; 128 | end; 129 | 130 | procedure TForm5.Receive; 131 | var 132 | f: IStompFrame; 133 | begin 134 | f := stomp.Receive; 135 | if assigned(f) then 136 | begin 137 | Memo1.Lines.Add('[' + f.GetHeaders.Value('datetime') + ' ' + f.GetHeaders.Value('sender') + ']' + sLineBreak + f.GetBody); 138 | end; 139 | end; 140 | 141 | initialization 142 | {$i MainFormClient.lrs} 143 | 144 | end. 145 | -------------------------------------------------------------------------------- /examples/HeartBeats/HeartBeatsTest.dpr: -------------------------------------------------------------------------------- 1 | program HeartBeatsTest; 2 | 3 | {$APPTYPE CONSOLE} 4 | 5 | {$R *.res} 6 | 7 | 8 | uses 9 | StompClient in '..\..\StompClient.pas', System.Classes, System.SysUtils; 10 | 11 | procedure Main; 12 | var 13 | lSTOMP: IStompClient; 14 | lFrame: IStompFrame; 15 | const 16 | DESTINATION = '/topic/pippo'; 17 | begin 18 | lSTOMP := StompUtils.StompClient 19 | .SetHeartBeat(500, 0) // very low outgoing heartbeat interval 20 | .SetUserName('guest') 21 | .SetPassword('guest') 22 | .SetAcceptVersion(TStompAcceptProtocol.Ver_1_1) 23 | .Connect; 24 | WriteLn('PROTOCOL: ', lSTOMP.GetProtocolVersion); 25 | WriteLn('SERVER : ', lSTOMP.GetServer); 26 | WriteLn('SESSION : ', lSTOMP.GetSession); 27 | lSTOMP.Subscribe(DESTINATION); 28 | 29 | // let's create a thread to send 10+1 messages to the already defined subscriber 30 | TThread.CreateAnonymousThread( 31 | procedure 32 | var 33 | lSTOMP: IStompClient; 34 | I: Integer; 35 | begin 36 | lSTOMP := StompUtils.StompClient 37 | .SetUserName('guest') 38 | .SetPassword('guest') 39 | .SetAcceptVersion(TStompAcceptProtocol.Ver_1_1) 40 | .Connect; 41 | for I := 1 to 10 do 42 | begin 43 | lSTOMP.Send(DESTINATION, TGuid.NewGuid.ToString + ' ' + DateTimeToStr(now)); 44 | Sleep(500 + Random(1500)); 45 | end; 46 | lSTOMP.Send(DESTINATION, 'FINISHED'); 47 | end).Start; 48 | 49 | // start to receive messages 50 | WriteLn; 51 | WriteLn('Reading messages...');; 52 | while True do 53 | begin 54 | try 55 | lFrame := lSTOMP.Receive(5000); 56 | except 57 | on E: Exception do 58 | begin 59 | WriteLn(E.ClassName, ' ', E.Message); 60 | Break; 61 | end; 62 | end; 63 | if Assigned(lFrame) then 64 | begin 65 | WriteLn(lFrame.Body); 66 | if lFrame.Body = 'FINISHED' then 67 | begin 68 | WriteLn('Bye bye...'); 69 | Break; 70 | end; 71 | end; 72 | end; 73 | end; 74 | 75 | begin 76 | try 77 | Main; 78 | except 79 | on E: Exception do 80 | WriteLn(E.ClassName, ': ', E.Message); 81 | end; 82 | Readln; 83 | 84 | end. 85 | -------------------------------------------------------------------------------- /examples/Multiple/MainForm.dfm: -------------------------------------------------------------------------------- 1 | object Form4: TForm4 2 | Left = 0 3 | Top = 0 4 | Caption = 'STOMP Listener' 5 | ClientHeight = 506 6 | ClientWidth = 527 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -11 11 | Font.Name = 'Tahoma' 12 | Font.Style = [] 13 | OldCreateOrder = False 14 | OnCreate = FormCreate 15 | OnDestroy = FormDestroy 16 | DesignSize = ( 17 | 527 18 | 506) 19 | PixelsPerInch = 96 20 | TextHeight = 13 21 | object Button1: TButton 22 | Left = 279 23 | Top = 8 24 | Width = 117 25 | Height = 42 26 | Caption = 'Start subscriber' 27 | TabOrder = 0 28 | OnClick = Button1Click 29 | end 30 | object Memo1: TMemo 31 | Left = 8 32 | Top = 56 33 | Width = 511 34 | Height = 442 35 | Anchors = [akLeft, akTop, akRight, akBottom] 36 | Font.Charset = ANSI_CHARSET 37 | Font.Color = clWindowText 38 | Font.Height = -13 39 | Font.Name = 'Courier New' 40 | Font.Style = [] 41 | ParentFont = False 42 | TabOrder = 1 43 | end 44 | object Button2: TButton 45 | Left = 402 46 | Top = 8 47 | Width = 117 48 | Height = 42 49 | Caption = 'Stop subscriber' 50 | TabOrder = 2 51 | OnClick = Button2Click 52 | end 53 | object Button3: TButton 54 | Left = 8 55 | Top = 8 56 | Width = 201 57 | Height = 42 58 | Anchors = [akTop, akRight] 59 | Caption = 'Produce messages continuosly on a background thread' 60 | TabOrder = 3 61 | WordWrap = True 62 | OnClick = Button3Click 63 | end 64 | end 65 | -------------------------------------------------------------------------------- /examples/Multiple/MainForm.pas: -------------------------------------------------------------------------------- 1 | unit MainForm; 2 | 3 | interface 4 | 5 | uses 6 | Winapi.Windows, 7 | Winapi.Messages, 8 | System.SysUtils, 9 | System.Variants, 10 | System.Classes, 11 | Vcl.Graphics, 12 | Vcl.Controls, 13 | Vcl.Forms, 14 | Vcl.Dialogs, 15 | Vcl.StdCtrls, 16 | StompClient; 17 | 18 | type 19 | TForm4 = class(TForm, IStompClientListener) 20 | Button1: TButton; 21 | Memo1: TMemo; 22 | Button2: TButton; 23 | Button3: TButton; 24 | procedure Button1Click(Sender: TObject); 25 | procedure FormDestroy(Sender: TObject); 26 | procedure FormCreate(Sender: TObject); 27 | procedure Button2Click(Sender: TObject); 28 | procedure Button3Click(Sender: TObject); 29 | private 30 | FSTOMPListener: IStompListener; 31 | FSTOMPClient: IStompClient; 32 | FFormClosing: Boolean; 33 | FProducerThread: TThread; 34 | public 35 | procedure OnMessage(StompFrame: IStompFrame; var TerminateListener: Boolean); 36 | procedure OnListenerStopped(StompClient: IStompClient); 37 | end; 38 | 39 | var 40 | Form4: TForm4; 41 | 42 | implementation 43 | 44 | {$R *.dfm} 45 | 46 | 47 | procedure TForm4.Button1Click(Sender: TObject); 48 | begin 49 | FSTOMPListener.StopListening; 50 | Memo1.Lines.Add('Listener Started'); 51 | FSTOMPListener.StartListening; 52 | end; 53 | 54 | procedure TForm4.Button2Click(Sender: TObject); 55 | begin 56 | FSTOMPListener.StopListening; 57 | end; 58 | 59 | procedure TForm4.Button3Click(Sender: TObject); 60 | begin 61 | FProducerThread := TThread.CreateAnonymousThread( 62 | procedure 63 | var 64 | i: Integer; 65 | stomp: IStompClient; 66 | begin 67 | stomp := StompUtils.StompClientAndConnect; 68 | i := 1; 69 | while True do 70 | begin 71 | sleep(300); 72 | if FFormClosing then 73 | Exit; 74 | stomp.Send('/topic/danieleteti', 'Hello World ' + IntToStr(i)); 75 | inc(i); 76 | end; 77 | stomp.Disconnect; 78 | end); 79 | FProducerThread.FreeOnTerminate := False; 80 | FProducerThread.Start; 81 | Button3.Enabled := False; 82 | ShowMessage('Background thread started... Now you can start the subscriber'); 83 | end; 84 | 85 | procedure TForm4.FormCreate(Sender: TObject); 86 | begin 87 | FFormClosing := False; 88 | FSTOMPClient := StompUtils.StompClientAndConnect; 89 | FSTOMPClient.Subscribe('/topic/danieleteti', 90 | amAuto, 91 | StompUtils.Headers.Add('include-seq', 'seq')); 92 | FSTOMPListener := StompUtils.CreateListener(FSTOMPClient, Self); 93 | end; 94 | 95 | procedure TForm4.FormDestroy(Sender: TObject); 96 | begin 97 | FFormClosing := True; 98 | if Assigned(FProducerThread) then 99 | begin 100 | FProducerThread.WaitFor; 101 | FProducerThread.Free; 102 | end; 103 | FSTOMPListener := nil; 104 | end; 105 | 106 | procedure TForm4.OnMessage(StompFrame: IStompFrame; var TerminateListener: Boolean); 107 | begin 108 | Memo1.Lines.Add(StompFrame.Body); 109 | TerminateListener := FFormClosing; 110 | end; 111 | 112 | procedure TForm4.OnListenerStopped(StompClient: IStompClient); 113 | begin 114 | Memo1.Lines.Add('Listener Stopped'); 115 | end; 116 | 117 | end. 118 | -------------------------------------------------------------------------------- /examples/Multiple/STOMPListener.dpr: -------------------------------------------------------------------------------- 1 | program STOMPListener; 2 | 3 | uses 4 | Vcl.Forms, 5 | MainForm in 'MainForm.pas' {Form4}, 6 | StompClient in '..\..\StompClient.pas'; 7 | 8 | {$R *.res} 9 | 10 | 11 | begin 12 | ReportMemoryLeaksOnShutdown := True; 13 | Application.Initialize; 14 | Application.MainFormOnTaskbar := True; 15 | Application.CreateForm(TForm4, Form4); 16 | Application.Run; 17 | 18 | end. 19 | -------------------------------------------------------------------------------- /examples/QueueAck/QueueAck.groupproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | {BB470B6D-C5BC-4098-A153-1070BFC7248D} 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | Default.Personality.12 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | -------------------------------------------------------------------------------- /examples/QueueAck/Receiver/Receiver.dpr: -------------------------------------------------------------------------------- 1 | program Receiver; 2 | 3 | uses 4 | Vcl.Forms, 5 | ReceiverForm in 'ReceiverForm.pas' {ReceiverMainForm}, 6 | ThreadReceiver in 'ThreadReceiver.pas', 7 | StompClient in '..\..\..\StompClient.pas'; 8 | 9 | {$R *.res} 10 | 11 | 12 | begin 13 | ReportMemoryLeaksOnShutdown := True; 14 | Application.Initialize; 15 | Application.MainFormOnTaskbar := True; 16 | Application.CreateForm(TReceiverMainForm, ReceiverMainForm); 17 | Application.Run; 18 | 19 | end. 20 | -------------------------------------------------------------------------------- /examples/QueueAck/Receiver/Receiver.dproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | {0DEF043B-A99C-4889-8351-5AB60AD893D1} 4 | 18.1 5 | VCL 6 | Receiver.dpr 7 | True 8 | Debug 9 | Win32 10 | 1 11 | Application 12 | 13 | 14 | true 15 | 16 | 17 | true 18 | Base 19 | true 20 | 21 | 22 | true 23 | Base 24 | true 25 | 26 | 27 | true 28 | Base 29 | true 30 | 31 | 32 | true 33 | Cfg_1 34 | true 35 | true 36 | 37 | 38 | true 39 | Base 40 | true 41 | 42 | 43 | Receiver 44 | System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace) 45 | $(BDS)\bin\delphi_PROJECTICON.ico 46 | bindcompfmx;fmx;rtl;dbrtl;IndySystem;DbxClientDriver;bindcomp;inetdb;DBXInterBaseDriver;DataSnapCommon;DataSnapClient;DataSnapServer;DataSnapProviderClient;xmlrtl;DbxCommonDriver;IndyProtocols;DBXMySQLDriver;dbxcds;soaprtl;bindengine;DBXOracleDriver;CustomIPTransport;dsnap;DBXInformixDriver;IndyCore;fmxase;DBXFirebirdDriver;inet;fmxobj;inetdbxpress;DBXSybaseASADriver;fmxdae;dbexpress;DataSnapIndy10ServerTransport;IPIndyImpl;$(DCC_UsePackage) 47 | .\$(Platform)\$(Config) 48 | .\$(Platform)\$(Config) 49 | 50 | 51 | true 52 | RlxDesignPackageXE2Professional;CustomDockForm;vcldbx;frx16;TeeDB;Rave100VCL;vclib;Tee;inetdbbde;DBXOdbcDriver;DBXSybaseASEDriver;ibxpress;svnui;vclimg;frxDB16;intrawebdb_120_160;fmi;fs16;vclactnband;FMXTee;TeeUI;vcldb;bindcompvcl;vcldsnap;vclie;vcltouch;Intraweb_120_160;DBXDb2Driver;websnap;vclribbon;frxe16;VclSmp;fsDB16;vcl;DataSnapConnectors;CloudService;DBXMSSQLDriver;CodeSiteExpressPkg;FmxTeeUI;dsnapcon;vclx;webdsnap;svn;OmniThreadLibraryRuntimeXE2;bdertl;adortl;$(DCC_UsePackage) 53 | true 54 | Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) 55 | 1033 56 | $(BDS)\bin\default_app.manifest 57 | CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= 58 | 59 | 60 | DBXOdbcDriver;DBXSybaseASEDriver;vclimg;vclactnband;vcldb;bindcompvcl;vcldsnap;vclie;vcltouch;DBXDb2Driver;websnap;VclSmp;vcl;DBXMSSQLDriver;dsnapcon;vclx;webdsnap;$(DCC_UsePackage) 61 | 62 | 63 | DEBUG;$(DCC_Define) 64 | false 65 | true 66 | true 67 | true 68 | 69 | 70 | false 71 | 72 | 73 | false 74 | RELEASE;$(DCC_Define) 75 | 0 76 | 0 77 | 78 | 79 | 80 | MainSource 81 | 82 | 83 |
ReceiverMainForm
84 | dfm 85 |
86 | 87 | 88 | 89 | Cfg_2 90 | Base 91 | 92 | 93 | Base 94 | 95 | 96 | Cfg_1 97 | Base 98 | 99 |
100 | 101 | Delphi.Personality.12 102 | 103 | 104 | 105 | 106 | Receiver.dpr 107 | 108 | 109 | False 110 | False 111 | 1 112 | 0 113 | 0 114 | 0 115 | False 116 | False 117 | False 118 | False 119 | False 120 | 1040 121 | 1252 122 | 123 | 124 | 125 | 126 | 1.0.0.0 127 | 128 | 129 | 130 | 131 | 132 | 1.0.0.0 133 | 134 | 135 | 136 | Microsoft Office 2000 Sample Automation Server Wrapper Components 137 | Microsoft Office XP Sample Automation Server Wrapper Components 138 | Embarcadero C++Builder Office 2000 Servers Package 139 | Embarcadero C++Builder Office XP Servers Package 140 | 141 | 142 | 143 | 144 | 145 | 1 146 | 147 | 148 | 1 149 | 150 | 151 | 152 | 153 | Contents\Resources 154 | 1 155 | 156 | 157 | 158 | 159 | classes 160 | 1 161 | 162 | 163 | 164 | 165 | Contents\MacOS 166 | 0 167 | 168 | 169 | 1 170 | 171 | 172 | Contents\MacOS 173 | 1 174 | 175 | 176 | 177 | 178 | 1 179 | 180 | 181 | 1 182 | 183 | 184 | 1 185 | 186 | 187 | 188 | 189 | res\drawable-xxhdpi 190 | 1 191 | 192 | 193 | 194 | 195 | library\lib\mips 196 | 1 197 | 198 | 199 | 200 | 201 | 1 202 | 203 | 204 | 1 205 | 206 | 207 | 0 208 | 209 | 210 | 1 211 | 212 | 213 | Contents\MacOS 214 | 1 215 | 216 | 217 | library\lib\armeabi-v7a 218 | 1 219 | 220 | 221 | 1 222 | 223 | 224 | 225 | 226 | 0 227 | 228 | 229 | Contents\MacOS 230 | 1 231 | .framework 232 | 233 | 234 | 235 | 236 | 1 237 | 238 | 239 | 1 240 | 241 | 242 | 1 243 | 244 | 245 | 246 | 247 | 1 248 | 249 | 250 | 1 251 | 252 | 253 | 1 254 | 255 | 256 | 257 | 258 | ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF 259 | 1 260 | 261 | 262 | ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF 263 | 1 264 | 265 | 266 | 267 | 268 | 269 | 1 270 | 271 | 272 | 1 273 | 274 | 275 | 1 276 | 277 | 278 | 279 | 280 | 1 281 | 282 | 283 | 1 284 | 285 | 286 | 1 287 | 288 | 289 | 290 | 291 | library\lib\armeabi 292 | 1 293 | 294 | 295 | 296 | 297 | 0 298 | 299 | 300 | 1 301 | 302 | 303 | Contents\MacOS 304 | 1 305 | 306 | 307 | 308 | 309 | 1 310 | 311 | 312 | 1 313 | 314 | 315 | 1 316 | 317 | 318 | 319 | 320 | res\drawable-normal 321 | 1 322 | 323 | 324 | 325 | 326 | res\drawable-xhdpi 327 | 1 328 | 329 | 330 | 331 | 332 | res\drawable-large 333 | 1 334 | 335 | 336 | 337 | 338 | 1 339 | 340 | 341 | 1 342 | 343 | 344 | 1 345 | 346 | 347 | 348 | 349 | ..\ 350 | 1 351 | 352 | 353 | ..\ 354 | 1 355 | 356 | 357 | 358 | 359 | res\drawable-hdpi 360 | 1 361 | 362 | 363 | 364 | 365 | library\lib\armeabi-v7a 366 | 1 367 | 368 | 369 | 370 | 371 | Contents 372 | 1 373 | 374 | 375 | 376 | 377 | ..\ 378 | 1 379 | 380 | 381 | 382 | 383 | 1 384 | 385 | 386 | 1 387 | 388 | 389 | 1 390 | 391 | 392 | 393 | 394 | res\values 395 | 1 396 | 397 | 398 | 399 | 400 | res\drawable-small 401 | 1 402 | 403 | 404 | 405 | 406 | res\drawable 407 | 1 408 | 409 | 410 | 411 | 412 | 1 413 | 414 | 415 | 1 416 | 417 | 418 | 1 419 | 420 | 421 | 422 | 423 | 1 424 | 425 | 426 | 427 | 428 | res\drawable 429 | 1 430 | 431 | 432 | 433 | 434 | 0 435 | 436 | 437 | 0 438 | 439 | 440 | Contents\Resources\StartUp\ 441 | 0 442 | 443 | 444 | 0 445 | 446 | 447 | 0 448 | 449 | 450 | 0 451 | 452 | 453 | 454 | 455 | library\lib\armeabi-v7a 456 | 1 457 | 458 | 459 | 460 | 461 | 0 462 | .bpl 463 | 464 | 465 | 1 466 | .dylib 467 | 468 | 469 | Contents\MacOS 470 | 1 471 | .dylib 472 | 473 | 474 | 1 475 | .dylib 476 | 477 | 478 | 1 479 | .dylib 480 | 481 | 482 | 483 | 484 | res\drawable-mdpi 485 | 1 486 | 487 | 488 | 489 | 490 | res\drawable-xlarge 491 | 1 492 | 493 | 494 | 495 | 496 | res\drawable-ldpi 497 | 1 498 | 499 | 500 | 501 | 502 | 0 503 | .dll;.bpl 504 | 505 | 506 | 1 507 | .dylib 508 | 509 | 510 | Contents\MacOS 511 | 1 512 | .dylib 513 | 514 | 515 | 1 516 | .dylib 517 | 518 | 519 | 1 520 | .dylib 521 | 522 | 523 | 524 | 525 | 526 | 527 | 528 | 529 | 530 | 531 | 532 | 533 | True 534 | False 535 | 536 | 537 | 12 538 | 539 | 540 | 541 | 542 |
543 | -------------------------------------------------------------------------------- /examples/QueueAck/Receiver/Receiver.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/danieleteti/delphistompclient/8aad53b690494f441fee7c3eb3b96007bfdffde6/examples/QueueAck/Receiver/Receiver.res -------------------------------------------------------------------------------- /examples/QueueAck/Receiver/ReceiverForm.dfm: -------------------------------------------------------------------------------- 1 | object ReceiverMainForm: TReceiverMainForm 2 | Left = 0 3 | Top = 0 4 | Anchors = [akLeft, akBottom] 5 | Caption = 'Receiver Message' 6 | ClientHeight = 460 7 | ClientWidth = 477 8 | Color = clBtnFace 9 | Font.Charset = DEFAULT_CHARSET 10 | Font.Color = clWindowText 11 | Font.Height = -11 12 | Font.Name = 'Tahoma' 13 | Font.Style = [] 14 | OldCreateOrder = False 15 | OnCreate = FormCreate 16 | OnDestroy = FormDestroy 17 | DesignSize = ( 18 | 477 19 | 460) 20 | PixelsPerInch = 96 21 | TextHeight = 13 22 | object Label1: TLabel 23 | Left = 8 24 | Top = 66 25 | Width = 181 26 | Height = 13 27 | Caption = 'Message sent from the STOMP broker' 28 | end 29 | object Label2: TLabel 30 | Left = 8 31 | Top = 342 32 | Width = 62 33 | Height = 13 34 | Anchors = [akLeft, akBottom] 35 | Caption = 'Queue Name' 36 | ExplicitTop = 337 37 | end 38 | object Label3: TLabel 39 | Left = 8 40 | Top = 8 41 | Width = 449 42 | Height = 39 43 | Caption = 44 | 'This example show how subscribe a queue and after you receive a ' + 45 | 'message from apollo you can send a ACK message to accept the mes' + 46 | 'sage or NACK message to refuse the message. If you refuse the me' + 47 | 'ssage, broker tries to send the message to another subscriber co' + 48 | 'nnected' 49 | WordWrap = True 50 | end 51 | object Label4: TLabel 52 | Left = 176 53 | Top = 342 54 | Width = 95 55 | Height = 13 56 | Anchors = [akLeft, akBottom] 57 | Caption = 'Current Message Id' 58 | ExplicitTop = 337 59 | end 60 | object Label5: TLabel 61 | Left = 8 62 | Top = 202 63 | Width = 156 64 | Height = 13 65 | Caption = 'Stomp Frame Sent and Received' 66 | end 67 | object MessageMemo: TMemo 68 | Left = 8 69 | Top = 85 70 | Width = 431 71 | Height = 116 72 | Anchors = [akLeft, akTop, akRight, akBottom] 73 | Color = clInfoBk 74 | ReadOnly = True 75 | ScrollBars = ssVertical 76 | TabOrder = 0 77 | end 78 | object SubscribeButton: TButton 79 | Left = 8 80 | Top = 385 81 | Width = 129 82 | Height = 67 83 | Anchors = [akLeft, akBottom] 84 | Caption = '1 - Subscribe ' 85 | TabOrder = 1 86 | OnClick = SubscribeButtonClick 87 | end 88 | object QueueEdit: TEdit 89 | Left = 8 90 | Top = 358 91 | Width = 129 92 | Height = 21 93 | Anchors = [akLeft, akBottom] 94 | TabOrder = 2 95 | Text = '/queue/alarm' 96 | end 97 | object SendAckButton: TButton 98 | Left = 176 99 | Top = 385 100 | Width = 98 101 | Height = 31 102 | Anchors = [akLeft, akBottom] 103 | Caption = '2 - Send ACK' 104 | TabOrder = 3 105 | OnClick = SendAckButtonClick 106 | end 107 | object SendNackButton: TButton 108 | Left = 176 109 | Top = 421 110 | Width = 98 111 | Height = 31 112 | Anchors = [akLeft, akBottom] 113 | Caption = '2 - Send NACK' 114 | TabOrder = 4 115 | OnClick = SendNackButtonClick 116 | end 117 | object UnsubscribeButton: TButton 118 | Left = 311 119 | Top = 385 120 | Width = 129 121 | Height = 67 122 | Anchors = [akLeft, akBottom] 123 | Caption = '3 - Unsubscribe ' 124 | TabOrder = 5 125 | OnClick = UnsubscribeButtonClick 126 | end 127 | object MessageIdEdit: TEdit 128 | Left = 174 129 | Top = 358 130 | Width = 266 131 | Height = 21 132 | Anchors = [akLeft, akRight, akBottom] 133 | TabOrder = 6 134 | end 135 | object LogMemo: TMemo 136 | Left = 8 137 | Top = 218 138 | Width = 431 139 | Height = 117 140 | Anchors = [akLeft, akRight, akBottom] 141 | Color = clInfoBk 142 | ReadOnly = True 143 | TabOrder = 7 144 | end 145 | end 146 | -------------------------------------------------------------------------------- /examples/QueueAck/Receiver/ReceiverForm.pas: -------------------------------------------------------------------------------- 1 | unit ReceiverForm; 2 | 3 | interface 4 | 5 | uses 6 | Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, 7 | System.Classes, Vcl.Graphics, System.UITypes, 8 | Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, StompClient, 9 | ThreadReceiver; 10 | 11 | type 12 | TReceiverMainForm = class(TForm) 13 | MessageMemo: TMemo; 14 | Label1: TLabel; 15 | SubscribeButton: TButton; 16 | QueueEdit: TEdit; 17 | Label2: TLabel; 18 | SendAckButton: TButton; 19 | SendNackButton: TButton; 20 | Label3: TLabel; 21 | UnsubscribeButton: TButton; 22 | MessageIdEdit: TEdit; 23 | Label4: TLabel; 24 | LogMemo: TMemo; 25 | Label5: TLabel; 26 | procedure SubscribeButtonClick(Sender: TObject); 27 | procedure FormCreate(Sender: TObject); 28 | procedure SendNackButtonClick(Sender: TObject); 29 | procedure SendAckButtonClick(Sender: TObject); 30 | procedure UnsubscribeButtonClick(Sender: TObject); 31 | procedure FormDestroy(Sender: TObject); 32 | private 33 | StompClient: IStompClient; 34 | StompFrame: IStompFrame; 35 | ThReceiver: TThreadReceiver; 36 | procedure BeforeSendFrame(AFrame: IStompFrame); 37 | public 38 | end; 39 | 40 | var 41 | ReceiverMainForm: TReceiverMainForm; 42 | 43 | implementation 44 | 45 | {$R *.dfm} 46 | 47 | 48 | procedure TReceiverMainForm.BeforeSendFrame(AFrame: IStompFrame); 49 | begin 50 | LogMemo.Lines.Add(StringReplace(AFrame.Output, #10, sLineBreak, [rfReplaceAll])); 51 | end; 52 | 53 | procedure TReceiverMainForm.FormCreate(Sender: TObject); 54 | begin 55 | StompClient := StompUtils.StompClient; 56 | try 57 | StompClient.Connect; 58 | except 59 | on e: Exception do 60 | begin 61 | raise Exception.Create 62 | ('Cannot connect to Apollo server. Run the server and restart the application'); 63 | end; 64 | end; 65 | StompClient.SetOnBeforeSendFrame(BeforeSendFrame); 66 | StompFrame := StompUtils.NewFrame(); 67 | ThReceiver := TThreadReceiver.Create(True); 68 | ThReceiver.StompClient := StompClient; 69 | end; 70 | 71 | procedure TReceiverMainForm.FormDestroy(Sender: TObject); 72 | begin 73 | ThReceiver.Free; 74 | end; 75 | 76 | procedure TReceiverMainForm.SendAckButtonClick(Sender: TObject); 77 | begin 78 | if MessageIdEdit.Text = '' then 79 | raise Exception.Create('Specify MessageId'); 80 | 81 | if StompClient.Connected then 82 | begin 83 | StompClient.Ack(MessageIdEdit.Text); 84 | end; 85 | end; 86 | 87 | procedure TReceiverMainForm.SendNackButtonClick(Sender: TObject); 88 | begin 89 | if MessageIdEdit.Text = '' then 90 | raise Exception.Create('Specify MessageId'); 91 | 92 | if StompClient.Connected then 93 | begin 94 | StompClient.Nack(MessageIdEdit.Text); 95 | end; 96 | end; 97 | 98 | procedure TReceiverMainForm.SubscribeButtonClick(Sender: TObject); 99 | var 100 | lAuto: Boolean; 101 | lAckMode: TAckMode; 102 | begin 103 | if not StompClient.Connected then 104 | raise Exception.Create('StompClient not connected'); 105 | 106 | if QueueEdit.Text = '' then 107 | raise Exception.Create('Specify queue name'); 108 | 109 | lAuto := MessageDlg('AckMode AUTO (Yes) or CLIENT (No) ?', mtInformation, mbYesNo, 0) = mrYes; 110 | 111 | if lAuto then 112 | lAckMode := amAuto 113 | else 114 | lAckMode := amClient; 115 | 116 | StompClient.Subscribe(QueueEdit.Text, lAckMode); 117 | // StompClient.Subscribe(QueueEdit.Text,amAuto); 118 | if not ThReceiver.Started then 119 | ThReceiver.Start; 120 | end; 121 | 122 | procedure TReceiverMainForm.UnsubscribeButtonClick(Sender: TObject); 123 | begin 124 | if QueueEdit.Text = '' then 125 | raise Exception.Create('Specify queue name'); 126 | 127 | if StompClient.Connected then 128 | begin 129 | StompClient.Unsubscribe(QueueEdit.Text); 130 | // ThReceiver.Start; 131 | end; 132 | end; 133 | 134 | end. 135 | -------------------------------------------------------------------------------- /examples/QueueAck/Receiver/ThreadReceiver.pas: -------------------------------------------------------------------------------- 1 | unit ThreadReceiver; 2 | 3 | interface 4 | 5 | uses 6 | System.Classes, 7 | StompClient; 8 | 9 | type 10 | TThreadReceiver = class(TThread) 11 | private 12 | FStompClient: IStompClient; 13 | FStompFrame: IStompFrame; 14 | procedure SetStompClient(const Value: IStompClient); 15 | protected 16 | procedure Execute; override; 17 | public 18 | procedure ReceiveAlarmMemo; 19 | procedure UpdateMessageMemo; 20 | procedure UpdateMessageIdEdit; 21 | constructor Create(CreateSuspended: Boolean); overload; 22 | property StompClient: IStompClient read FStompClient write SetStompClient; 23 | end; 24 | 25 | implementation 26 | 27 | { 28 | Important: Methods and properties of objects in visual components can only be 29 | used in a method called using Synchronize, for example, 30 | 31 | Synchronize(UpdateCaption); 32 | 33 | and UpdateCaption could look like, 34 | 35 | procedure TThreadReceiver.UpdateCaption; 36 | begin 37 | Form1.Caption := 'Updated in a thread'; 38 | end; 39 | 40 | or 41 | 42 | Synchronize( 43 | procedure 44 | begin 45 | Form1.Caption := 'Updated in thread via an anonymous method' 46 | end 47 | ) 48 | ); 49 | 50 | where an anonymous method is passed. 51 | 52 | Similarly, the developer can call the Queue method with similar parameters as 53 | above, instead passing another TThread class as the first parameter, putting 54 | the calling thread in a queue with the other thread. 55 | 56 | } 57 | 58 | uses ReceiverForm, System.SysUtils; 59 | 60 | { TThreadReceiver } 61 | 62 | constructor TThreadReceiver.Create(CreateSuspended: Boolean); 63 | begin 64 | FStompFrame := StompUtils.CreateFrame; 65 | inherited Create(CreateSuspended); 66 | end; 67 | 68 | procedure TThreadReceiver.Execute; 69 | begin 70 | NameThreadForDebugging('ThreadReceiver'); 71 | 72 | while not Terminated do 73 | begin 74 | if FStompClient.Receive(FStompFrame, 2000) then 75 | begin 76 | Sleep(100); 77 | Synchronize(ReceiveAlarmMemo); 78 | Synchronize(UpdateMessageIdEdit); 79 | end 80 | else 81 | begin 82 | Synchronize(UpdateMessageMemo); 83 | end; 84 | end; 85 | end; 86 | 87 | procedure TThreadReceiver.ReceiveAlarmMemo; 88 | begin 89 | ReceiverMainForm.MessageMemo.Lines.Add( 90 | StringReplace(FStompFrame.Output, #10, sLineBreak, [rfReplaceAll])); 91 | end; 92 | 93 | procedure TThreadReceiver.SetStompClient(const Value: IStompClient); 94 | begin 95 | FStompClient := Value; 96 | end; 97 | 98 | procedure TThreadReceiver.UpdateMessageIdEdit; 99 | begin 100 | ReceiverMainForm.MessageIdEdit.Text := FStompFrame.GetHeaders.Value('message-id'); 101 | end; 102 | 103 | procedure TThreadReceiver.UpdateMessageMemo; 104 | begin 105 | //ReceiverMainForm.MessageMemo.Lines.Add('Wait Messages....'); 106 | end; 107 | 108 | end. 109 | -------------------------------------------------------------------------------- /examples/QueueAck/SendMessage/SendMessage.dpr: -------------------------------------------------------------------------------- 1 | program SendMessage; 2 | 3 | uses 4 | Vcl.Forms, 5 | SendMessageForm in 'SendMessageForm.pas' {SendMessageMainForm}, 6 | StompClient in '..\..\..\StompClient.pas'; 7 | 8 | {$R *.res} 9 | 10 | 11 | begin 12 | ReportMemoryLeaksOnShutdown := True; 13 | Application.Initialize; 14 | Application.MainFormOnTaskbar := True; 15 | Application.CreateForm(TSendMessageMainForm, SendMessageMainForm); 16 | Application.Run; 17 | 18 | end. 19 | -------------------------------------------------------------------------------- /examples/QueueAck/SendMessage/SendMessage.dproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | {D1F6D8B1-3F48-4A39-81BC-1D32E822A74A} 4 | 18.1 5 | VCL 6 | SendMessage.dpr 7 | True 8 | Debug 9 | Win32 10 | 1 11 | Application 12 | 13 | 14 | true 15 | 16 | 17 | true 18 | Base 19 | true 20 | 21 | 22 | true 23 | Base 24 | true 25 | 26 | 27 | true 28 | Base 29 | true 30 | 31 | 32 | true 33 | Cfg_1 34 | true 35 | true 36 | 37 | 38 | true 39 | Base 40 | true 41 | 42 | 43 | SendMessage 44 | System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace) 45 | $(BDS)\bin\delphi_PROJECTICON.ico 46 | bindcompfmx;fmx;rtl;dbrtl;IndySystem;DbxClientDriver;bindcomp;inetdb;DBXInterBaseDriver;DataSnapCommon;DataSnapClient;DataSnapServer;DataSnapProviderClient;xmlrtl;DbxCommonDriver;IndyProtocols;DBXMySQLDriver;dbxcds;soaprtl;bindengine;DBXOracleDriver;CustomIPTransport;dsnap;DBXInformixDriver;IndyCore;fmxase;DBXFirebirdDriver;inet;fmxobj;inetdbxpress;DBXSybaseASADriver;fmxdae;dbexpress;DataSnapIndy10ServerTransport;IPIndyImpl;$(DCC_UsePackage) 47 | .\$(Platform)\$(Config) 48 | .\$(Platform)\$(Config) 49 | 50 | 51 | true 52 | RlxDesignPackageXE2Professional;CustomDockForm;vcldbx;frx16;TeeDB;Rave100VCL;vclib;Tee;inetdbbde;DBXOdbcDriver;DBXSybaseASEDriver;ibxpress;svnui;vclimg;frxDB16;intrawebdb_120_160;fmi;fs16;vclactnband;FMXTee;TeeUI;vcldb;bindcompvcl;vcldsnap;vclie;vcltouch;Intraweb_120_160;DBXDb2Driver;websnap;vclribbon;frxe16;VclSmp;fsDB16;vcl;DataSnapConnectors;CloudService;DBXMSSQLDriver;CodeSiteExpressPkg;FmxTeeUI;dsnapcon;vclx;webdsnap;svn;OmniThreadLibraryRuntimeXE2;bdertl;adortl;$(DCC_UsePackage) 53 | true 54 | Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) 55 | 1033 56 | $(BDS)\bin\default_app.manifest 57 | CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= 58 | 59 | 60 | DBXOdbcDriver;DBXSybaseASEDriver;vclimg;vclactnband;vcldb;bindcompvcl;vcldsnap;vclie;vcltouch;DBXDb2Driver;websnap;VclSmp;vcl;DBXMSSQLDriver;dsnapcon;vclx;webdsnap;$(DCC_UsePackage) 61 | 62 | 63 | DEBUG;$(DCC_Define) 64 | false 65 | true 66 | true 67 | true 68 | 69 | 70 | false 71 | 72 | 73 | false 74 | RELEASE;$(DCC_Define) 75 | 0 76 | 0 77 | 78 | 79 | 80 | MainSource 81 | 82 | 83 |
SendMessageMainForm
84 | dfm 85 |
86 | 87 | 88 | Cfg_2 89 | Base 90 | 91 | 92 | Base 93 | 94 | 95 | Cfg_1 96 | Base 97 | 98 |
99 | 100 | Delphi.Personality.12 101 | 102 | 103 | 104 | 105 | SendMessage.dpr 106 | 107 | 108 | False 109 | False 110 | 1 111 | 0 112 | 0 113 | 0 114 | False 115 | False 116 | False 117 | False 118 | False 119 | 1040 120 | 1252 121 | 122 | 123 | 124 | 125 | 1.0.0.0 126 | 127 | 128 | 129 | 130 | 131 | 1.0.0.0 132 | 133 | 134 | 135 | Microsoft Office 2000 Sample Automation Server Wrapper Components 136 | Microsoft Office XP Sample Automation Server Wrapper Components 137 | Embarcadero C++Builder Office 2000 Servers Package 138 | Embarcadero C++Builder Office XP Servers Package 139 | 140 | 141 | 142 | 143 | 144 | 1 145 | 146 | 147 | 1 148 | 149 | 150 | 151 | 152 | Contents\Resources 153 | 1 154 | 155 | 156 | 157 | 158 | classes 159 | 1 160 | 161 | 162 | 163 | 164 | Contents\MacOS 165 | 0 166 | 167 | 168 | 1 169 | 170 | 171 | Contents\MacOS 172 | 1 173 | 174 | 175 | 176 | 177 | 1 178 | 179 | 180 | 1 181 | 182 | 183 | 1 184 | 185 | 186 | 187 | 188 | res\drawable-xxhdpi 189 | 1 190 | 191 | 192 | 193 | 194 | library\lib\mips 195 | 1 196 | 197 | 198 | 199 | 200 | 1 201 | 202 | 203 | 1 204 | 205 | 206 | 0 207 | 208 | 209 | 1 210 | 211 | 212 | Contents\MacOS 213 | 1 214 | 215 | 216 | library\lib\armeabi-v7a 217 | 1 218 | 219 | 220 | 1 221 | 222 | 223 | 224 | 225 | 0 226 | 227 | 228 | Contents\MacOS 229 | 1 230 | .framework 231 | 232 | 233 | 234 | 235 | 1 236 | 237 | 238 | 1 239 | 240 | 241 | 1 242 | 243 | 244 | 245 | 246 | 1 247 | 248 | 249 | 1 250 | 251 | 252 | 1 253 | 254 | 255 | 256 | 257 | ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF 258 | 1 259 | 260 | 261 | ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF 262 | 1 263 | 264 | 265 | 266 | 267 | 268 | 1 269 | 270 | 271 | 1 272 | 273 | 274 | 1 275 | 276 | 277 | 278 | 279 | 1 280 | 281 | 282 | 1 283 | 284 | 285 | 1 286 | 287 | 288 | 289 | 290 | library\lib\armeabi 291 | 1 292 | 293 | 294 | 295 | 296 | 0 297 | 298 | 299 | 1 300 | 301 | 302 | Contents\MacOS 303 | 1 304 | 305 | 306 | 307 | 308 | 1 309 | 310 | 311 | 1 312 | 313 | 314 | 1 315 | 316 | 317 | 318 | 319 | res\drawable-normal 320 | 1 321 | 322 | 323 | 324 | 325 | res\drawable-xhdpi 326 | 1 327 | 328 | 329 | 330 | 331 | res\drawable-large 332 | 1 333 | 334 | 335 | 336 | 337 | 1 338 | 339 | 340 | 1 341 | 342 | 343 | 1 344 | 345 | 346 | 347 | 348 | ..\ 349 | 1 350 | 351 | 352 | ..\ 353 | 1 354 | 355 | 356 | 357 | 358 | res\drawable-hdpi 359 | 1 360 | 361 | 362 | 363 | 364 | library\lib\armeabi-v7a 365 | 1 366 | 367 | 368 | 369 | 370 | Contents 371 | 1 372 | 373 | 374 | 375 | 376 | ..\ 377 | 1 378 | 379 | 380 | 381 | 382 | 1 383 | 384 | 385 | 1 386 | 387 | 388 | 1 389 | 390 | 391 | 392 | 393 | res\values 394 | 1 395 | 396 | 397 | 398 | 399 | res\drawable-small 400 | 1 401 | 402 | 403 | 404 | 405 | res\drawable 406 | 1 407 | 408 | 409 | 410 | 411 | 1 412 | 413 | 414 | 1 415 | 416 | 417 | 1 418 | 419 | 420 | 421 | 422 | 1 423 | 424 | 425 | 426 | 427 | res\drawable 428 | 1 429 | 430 | 431 | 432 | 433 | 0 434 | 435 | 436 | 0 437 | 438 | 439 | Contents\Resources\StartUp\ 440 | 0 441 | 442 | 443 | 0 444 | 445 | 446 | 0 447 | 448 | 449 | 0 450 | 451 | 452 | 453 | 454 | library\lib\armeabi-v7a 455 | 1 456 | 457 | 458 | 459 | 460 | 0 461 | .bpl 462 | 463 | 464 | 1 465 | .dylib 466 | 467 | 468 | Contents\MacOS 469 | 1 470 | .dylib 471 | 472 | 473 | 1 474 | .dylib 475 | 476 | 477 | 1 478 | .dylib 479 | 480 | 481 | 482 | 483 | res\drawable-mdpi 484 | 1 485 | 486 | 487 | 488 | 489 | res\drawable-xlarge 490 | 1 491 | 492 | 493 | 494 | 495 | res\drawable-ldpi 496 | 1 497 | 498 | 499 | 500 | 501 | 0 502 | .dll;.bpl 503 | 504 | 505 | 1 506 | .dylib 507 | 508 | 509 | Contents\MacOS 510 | 1 511 | .dylib 512 | 513 | 514 | 1 515 | .dylib 516 | 517 | 518 | 1 519 | .dylib 520 | 521 | 522 | 523 | 524 | 525 | 526 | 527 | 528 | 529 | 530 | 531 | 532 | True 533 | False 534 | 535 | 536 | 12 537 | 538 | 539 | 540 | 541 |
542 | -------------------------------------------------------------------------------- /examples/QueueAck/SendMessage/SendMessage.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/danieleteti/delphistompclient/8aad53b690494f441fee7c3eb3b96007bfdffde6/examples/QueueAck/SendMessage/SendMessage.res -------------------------------------------------------------------------------- /examples/QueueAck/SendMessage/SendMessageForm.dfm: -------------------------------------------------------------------------------- 1 | object SendMessageMainForm: TSendMessageMainForm 2 | Left = 0 3 | Top = 0 4 | Caption = 'Send Message' 5 | ClientHeight = 385 6 | ClientWidth = 612 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -11 11 | Font.Name = 'Tahoma' 12 | Font.Style = [] 13 | OldCreateOrder = False 14 | OnCreate = FormCreate 15 | DesignSize = ( 16 | 612 17 | 385) 18 | PixelsPerInch = 96 19 | TextHeight = 13 20 | object Label1: TLabel 21 | Left = 152 22 | Top = 318 23 | Width = 62 24 | Height = 13 25 | Anchors = [akLeft, akBottom] 26 | Caption = 'Queue Name' 27 | end 28 | object Label2: TLabel 29 | Left = 8 30 | Top = 5 31 | Width = 182 32 | Height = 13 33 | Caption = 'Type here text of message to be sent' 34 | end 35 | object Label3: TLabel 36 | Left = 8 37 | Top = 127 38 | Width = 150 39 | Height = 13 40 | Caption = 'Stomp Frame Sent and Receive' 41 | end 42 | object QueueMemo: TMemo 43 | Left = 8 44 | Top = 24 45 | Width = 596 46 | Height = 97 47 | Anchors = [akLeft, akTop, akRight] 48 | TabOrder = 0 49 | ExplicitWidth = 410 50 | end 51 | object SendMessageButton: TButton 52 | Left = 8 53 | Top = 320 54 | Width = 138 55 | Height = 56 56 | Anchors = [akLeft, akBottom] 57 | Caption = 'Send Message' 58 | TabOrder = 1 59 | OnClick = SendMessageButtonClick 60 | ExplicitTop = 269 61 | end 62 | object QueueEdit: TEdit 63 | Left = 152 64 | Top = 337 65 | Width = 266 66 | Height = 21 67 | Anchors = [akLeft, akBottom] 68 | TabOrder = 2 69 | Text = '/queue/alarm' 70 | end 71 | object LogMemo: TMemo 72 | Left = 8 73 | Top = 146 74 | Width = 596 75 | Height = 169 76 | Anchors = [akLeft, akTop, akRight, akBottom] 77 | TabOrder = 3 78 | end 79 | object AutomaticSendCheckBox: TCheckBox 80 | Left = 152 81 | Top = 360 82 | Width = 181 83 | Height = 17 84 | Anchors = [akLeft, akBottom] 85 | Caption = 'Automatic send every 5 seconds ' 86 | TabOrder = 4 87 | OnClick = AutomaticSendCheckBoxClick 88 | end 89 | object AutomaticSendTimer: TTimer 90 | Enabled = False 91 | Interval = 5000 92 | OnTimer = AutomaticSendTimerTimer 93 | Left = 320 94 | Top = 24 95 | end 96 | end 97 | -------------------------------------------------------------------------------- /examples/QueueAck/SendMessage/SendMessageForm.pas: -------------------------------------------------------------------------------- 1 | unit SendMessageForm; 2 | 3 | interface 4 | 5 | uses 6 | Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, 7 | Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, StompClient, 8 | Vcl.ExtCtrls; 9 | 10 | type 11 | TSendMessageMainForm = class(TForm) 12 | QueueMemo: TMemo; 13 | SendMessageButton: TButton; 14 | QueueEdit: TEdit; 15 | Label1: TLabel; 16 | Label2: TLabel; 17 | Label3: TLabel; 18 | LogMemo: TMemo; 19 | AutomaticSendTimer: TTimer; 20 | AutomaticSendCheckBox: TCheckBox; 21 | procedure SendMessageButtonClick(Sender: TObject); 22 | procedure FormCreate(Sender: TObject); 23 | procedure AutomaticSendTimerTimer(Sender: TObject); 24 | procedure AutomaticSendCheckBoxClick(Sender: TObject); 25 | private 26 | StompClient: IStompClient; 27 | procedure BeforeSendFrame(AFrame: IStompFrame); 28 | procedure Send; 29 | public 30 | end; 31 | 32 | var 33 | SendMessageMainForm: TSendMessageMainForm; 34 | 35 | implementation 36 | 37 | {$R *.dfm} 38 | 39 | 40 | procedure TSendMessageMainForm.AutomaticSendCheckBoxClick(Sender: TObject); 41 | begin 42 | if QueueEdit.Text = '' then 43 | raise Exception.Create('Specify queue name'); 44 | if QueueMemo.Lines.Text = '' then 45 | raise Exception.Create('Specify text of message to be sent'); 46 | if AutomaticSendCheckBox.Checked then 47 | AutomaticSendTimer.Enabled := True 48 | else 49 | AutomaticSendTimer.Enabled := False; 50 | end; 51 | 52 | procedure TSendMessageMainForm.BeforeSendFrame(AFrame: IStompFrame); 53 | begin 54 | LogMemo.Lines.Add(StringReplace(AFrame.Output, #10, sLineBreak, [rfReplaceAll])); 55 | end; 56 | 57 | procedure TSendMessageMainForm.FormCreate(Sender: TObject); 58 | begin 59 | StompClient := StompUtils.StompClient; 60 | StompClient.SetOnBeforeSendFrame(BeforeSendFrame); 61 | end; 62 | 63 | procedure TSendMessageMainForm.AutomaticSendTimerTimer(Sender: TObject); 64 | begin 65 | if AutomaticSendCheckBox.Checked then 66 | begin 67 | AutomaticSendTimer.Enabled := False; 68 | Send; 69 | AutomaticSendTimer.Enabled := True; 70 | end; 71 | end; 72 | 73 | procedure TSendMessageMainForm.Send; 74 | begin 75 | StompClient.Connect; 76 | try 77 | try 78 | StompClient.Send(QueueEdit.Text, QueueMemo.Lines.Text); 79 | except 80 | on e: Exception do 81 | begin 82 | LogMemo.Lines.Add('ERROR: ' + e.Message); 83 | end; 84 | end; 85 | finally 86 | StompClient.Disconnect; 87 | end; 88 | end; 89 | 90 | procedure TSendMessageMainForm.SendMessageButtonClick(Sender: TObject); 91 | begin 92 | if QueueEdit.Text = '' then 93 | raise Exception.Create('Specify queue name'); 94 | if QueueMemo.Lines.Text = '' then 95 | raise Exception.Create('Specify text of message to be sent'); 96 | Send; 97 | end; 98 | 99 | end. 100 | -------------------------------------------------------------------------------- /examples/SimpleMessaging/SimpleMessaging.dpr: -------------------------------------------------------------------------------- 1 | program SimpleMessaging; 2 | 3 | {$IFDEF FPC} 4 | {$mode delphi}{$H+} 5 | {$ELSE} 6 | {$APPTYPE CONSOLE} 7 | {$ENDIF} 8 | 9 | 10 | uses 11 | {$IFDEF FPC} 12 | {$IFDEF UNIX} 13 | cthreads, 14 | 15 | {$ENDIF} 16 | {$ENDIF} 17 | SysUtils, 18 | StompClient; 19 | 20 | procedure Example_Durable_Subscription; 21 | var 22 | StompPub, StompSubscriber: IStompClient; 23 | StompFrame: IStompFrame; 24 | StompHeaders: IStompHeaders; 25 | begin 26 | StompHeaders := StompUtils.Headers; 27 | StompHeaders.Add(StompUtils.NewDurableSubscriptionHeader('my-unique-id')); 28 | 29 | WriteLn('==> Example_Durable_Subscription'); 30 | 31 | write('> Register a subscriber to "/queue/durable01" using a client-id...'); 32 | StompSubscriber := StompUTils.StompClientAndConnect('127.0.0.1', 61613, '', 'client-id'); 33 | StompSubscriber.Subscribe('/queue/durable01', amAuto, StompHeaders); 34 | StompSubscriber := nil; 35 | WriteLn('Now, disconnect from the broker.' + sLineBreak); 36 | 37 | write('> Sending a message to "/queue/durable01"'); 38 | StompPub := StompUTils.StompClientAndConnect; 39 | StompPub.Send('/queue/durable01', 40 | 'this message has been sent when the subscriber client was disconnected'); 41 | StompPub := nil; 42 | WriteLn('... and disconnect' + sLineBreak); 43 | 44 | WriteLn('> The previoous subscriber reconnects using the same client-id'); 45 | StompSubscriber := StompUTils.StompClientAndConnect('127.0.0.1', 61613, '', 'client-id'); 46 | StompSubscriber.Subscribe('/queue/durable01', amAuto, StompHeaders); 47 | // default port 48 | repeat 49 | StompFrame := StompSubscriber.Receive(1000); 50 | if not Assigned(StompFrame) then 51 | WriteLn('No Message'); 52 | until Assigned(StompFrame); 53 | WriteLn('> Found the message (even if it was disconnected when the message has been actually published.' 54 | + sLineBreak); 55 | WriteLn(StompFrame.Body); // Print "Some test message" 56 | WriteLn; 57 | end; 58 | 59 | procedure Example_Pub_Subscriber; 60 | var 61 | StompPub, StompSubscriber: IStompClient; 62 | StompFrame: IStompFrame; 63 | begin 64 | WriteLn('==> Example_Pub_Subscriber'); 65 | StompSubscriber := StompUTils.StompClientAndConnect; 66 | // StompSubscriber.Subscribe('/topic/dummy', amAuto, StompUtils.Headers.Add('auto-delete', 'true')); 67 | StompSubscriber.Subscribe('/topic/dummy'); 68 | StompPub := StompUTils.StompClientAndConnect; 69 | StompPub.Send('/topic/dummy', 'Some test message'); 70 | repeat 71 | StompFrame := StompSubscriber.Receive(500); 72 | until Assigned(StompFrame); 73 | WriteLn(StompFrame.Body); // Print "Some test message" 74 | WriteLn; 75 | StompSubscriber.Unsubscribe('/topic/dummy'); 76 | end; 77 | 78 | procedure Example_OnePub_TwoSubscriber; 79 | var 80 | StompPub, StompSub1, StompSub2: IStompClient; 81 | StompFrame: IStompFrame; 82 | begin 83 | WriteLn('==> Example_OnePub_TwoSubscriber'); 84 | // first subscriber 85 | StompSub1 := StompUTils.StompClientAndConnect; 86 | StompSub1.Subscribe('/topic/dummy'); 87 | while Assigned(StompSub1.Receive(100)) do; // empty the queue 88 | 89 | // second subscriber 90 | StompSub2 := StompUTils.StompClientAndConnect; 91 | StompSub2.Subscribe('/topic/dummy'); 92 | while Assigned(StompSub2.Receive(100)) do; // empty the queue 93 | 94 | // publish the messages 95 | StompPub := StompUTils.StompClientAndConnect; 96 | write('> Publishing 2 message on "/topic/dummy"...'); 97 | StompPub.Send('/topic/dummy', 'First test message on a topic'); 98 | StompPub.Send('/topic/dummy', 'Second test message on a topic'); 99 | WriteLn('DONE!'); 100 | 101 | // read messages from the subscriber1 102 | WriteLn('> Reading from SUB1'); 103 | StompFrame := StompSub1.Receive(2000); 104 | if not Assigned(StompFrame) then 105 | raise Exception.Create('Cannot read message'); 106 | WriteLn(StompFrame.Body); 107 | StompFrame := StompSub1.Receive(2000); 108 | if not Assigned(StompFrame) then 109 | raise Exception.Create('Cannot read message'); 110 | WriteLn(StompFrame.Body); 111 | 112 | // read messages from the subscriber2 113 | WriteLn('> Reading from SUB2'); 114 | StompFrame := StompSub2.Receive(2000); 115 | if not Assigned(StompFrame) then 116 | raise Exception.Create('Cannot read message'); 117 | WriteLn(StompFrame.Body); 118 | StompFrame := StompSub2.Receive(2000); 119 | if not Assigned(StompFrame) then 120 | raise Exception.Create('Cannot read message'); 121 | WriteLn(StompFrame.Body); 122 | WriteLn; 123 | end; 124 | 125 | procedure Example_PointToPoint; 126 | var 127 | StompPub, StompSub1, StompSub2: IStompClient; 128 | StompFrame: IStompFrame; 129 | begin 130 | WriteLn('==> Example_PointToPoint'); 131 | StompSub1 := StompUTils.StompClientAndConnect; // default port 132 | StompSub2 := StompUTils.StompClientAndConnect; // default port 133 | StompSub1.Subscribe('/queue/PointToPoint'); 134 | StompSub2.Subscribe('/queue/PointToPoint'); 135 | 136 | // 137 | StompPub := StompUtils.StompClientAndConnect; // default port 138 | StompPub.Send('/queue/PointToPoint', 'First test message on a queue'); 139 | StompPub.Send('/queue/PointToPoint', 'Second test message on a queue'); 140 | 141 | StompFrame := StompSub1.Receive(200); 142 | if Assigned(StompFrame) then 143 | WriteLn(StompFrame.Output); 144 | StompFrame := StompSub1.Receive(200); 145 | if Assigned(StompFrame) then 146 | WriteLn(StompFrame.Output); 147 | 148 | StompFrame := StompSub2.Receive(200); 149 | if Assigned(StompFrame) then 150 | WriteLn(StompFrame.Output); 151 | StompFrame := StompSub2.Receive(200); 152 | if Assigned(StompFrame) then 153 | WriteLn(StompFrame.Output); 154 | 155 | WriteLn; 156 | end; 157 | 158 | procedure Example_Simple_Queue; 159 | var 160 | lProducer, lConsumer: IStompClient; 161 | StompFrame: IStompFrame; 162 | begin 163 | WriteLn('==> Example_Simple_Queue'); 164 | lConsumer := StompUtils.StompClientAndConnect; 165 | 166 | { TODO -oDaniele -cGeneral : Checkthis } 167 | // create an auto-delete queue 168 | lConsumer.Subscribe('/queue/dummy', amClient, 169 | StompUtils.Headers.Add(StompHeaders.AUTO_DELETE, 'true')); 170 | 171 | // creates a durable queue 172 | // lConsumer.Subscribe('/queue/dummy'); 173 | 174 | lProducer := StompUtils.StompClientAndConnect; 175 | lProducer.Send('/queue/dummy', 'Some test message', 176 | StompUtils.Headers.Add(StompHeaders.AUTO_DELETE, 'true')); 177 | repeat 178 | StompFrame := lConsumer.Receive(500); 179 | until Assigned(StompFrame); 180 | WriteLn(StompFrame.Body); // Print "Some test message" 181 | lConsumer.Ack(StompFrame.MessageID); 182 | WriteLn; 183 | lConsumer.Unsubscribe('/queue/dummy123'); 184 | end; 185 | 186 | begin 187 | try 188 | Example_Pub_Subscriber; 189 | Example_Simple_Queue; 190 | Example_OnePub_TwoSubscriber; 191 | Example_PointToPoint; 192 | Example_Durable_Subscription; 193 | WriteLn('>> TEST FINISHED <<'); 194 | except 195 | on E: Exception do 196 | WriteLn(E.ClassName, ': ', E.message); 197 | end; 198 | readln 199 | 200 | end. 201 | -------------------------------------------------------------------------------- /examples/SimpleMessaging/SimpleMessaging.dproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | {969324CB-D957-437E-A536-D75942EA5A95} 4 | 18.2 5 | SimpleMessaging.dpr 6 | Debug 7 | DCC32 8 | None 9 | True 10 | Win32 11 | 1 12 | Console 13 | 14 | 15 | true 16 | 17 | 18 | true 19 | Base 20 | true 21 | 22 | 23 | true 24 | Base 25 | true 26 | 27 | 28 | true 29 | Base 30 | true 31 | 32 | 33 | true 34 | Base 35 | true 36 | 37 | 38 | true 39 | Base 40 | true 41 | 42 | 43 | true 44 | Base 45 | true 46 | 47 | 48 | true 49 | Base 50 | true 51 | 52 | 53 | true 54 | Cfg_2 55 | true 56 | true 57 | 58 | 59 | true 60 | Cfg_2 61 | true 62 | true 63 | 64 | 65 | true 66 | Cfg_2 67 | true 68 | true 69 | 70 | 71 | $(BDS)\bin\delphi_PROJECTICNS.icns 72 | $(BDS)\bin\delphi_PROJECTICON.ico 73 | SimpleMessaging 74 | System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace) 75 | 1040 76 | CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= 77 | ..\..;$(DCC_UnitSearchPath) 78 | ..\bin\SimpleMessaging.exe 79 | 00400000 80 | x86 81 | ..\bin 82 | false 83 | false 84 | false 85 | ..\dcu 86 | false 87 | false 88 | 89 | 90 | $(BDS)\bin\Artwork\Android\FM_LauncherIcon_36x36.png 91 | $(BDS)\bin\Artwork\Android\FM_SplashImage_640x480.png 92 | $(BDS)\bin\Artwork\Android\FM_SplashImage_960x720.png 93 | $(BDS)\bin\Artwork\Android\FM_SplashImage_426x320.png 94 | true 95 | true 96 | true 97 | true 98 | $(BDS)\bin\Artwork\Android\FM_LauncherIcon_144x144.png 99 | true 100 | $(BDS)\bin\Artwork\Android\FM_LauncherIcon_96x96.png 101 | $(BDS)\bin\Artwork\Android\FM_SplashImage_470x320.png 102 | package=com.embarcadero.$(MSBuildProjectName);label=$(MSBuildProjectName);versionCode=1;versionName=1.0.0;persistent=False;restoreAnyVersion=False;installLocation=auto;largeHeap=False;theme=TitleBar;hardwareAccelerated=true;apiKey= 103 | true 104 | true 105 | Debug 106 | $(BDS)\bin\Artwork\Android\FM_LauncherIcon_48x48.png 107 | $(BDS)\bin\Artwork\Android\FM_LauncherIcon_72x72.png 108 | android-support-v4.dex.jar;apk-expansion.dex.jar;cloud-messaging.dex.jar;fmx.dex.jar;google-analytics-v2.dex.jar;google-play-billing.dex.jar;google-play-licensing.dex.jar;google-play-services.dex.jar 109 | true 110 | true 111 | true 112 | 113 | 114 | $(BDS)\bin\Artwork\iOS\iPad\FM_LaunchImageLandscape_2048x1536.png 115 | $(BDS)\bin\Artwork\iOS\iPad\FM_SpotlightSearchIcon_80x80.png 116 | $(BDS)\bin\Artwork\iOS\iPad\FM_LaunchImageLandscape_1024x768.png 117 | true 118 | $(BDS)\bin\Artwork\iOS\iPad\FM_ApplicationIcon_152x152.png 119 | $(BDS)\bin\Artwork\iOS\iPhone\FM_SpotlightSearchIcon_40x40.png 120 | $(BDS)\bin\Artwork\iOS\iPad\FM_SpotlightSearchIcon_40x40.png 121 | $(BDS)\bin\Artwork\iOS\iPad\FM_LaunchImagePortrait_1536x2048.png 122 | $(MSBuildProjectName) 123 | $(BDS)\bin\Artwork\iOS\iPad\FM_LaunchImagePortrait_768x1024.png 124 | Debug 125 | $(BDS)\bin\Artwork\iOS\iPad\FM_ApplicationIcon_76x76.png 126 | $(BDS)\bin\Artwork\iOS\iPhone\FM_ApplicationIcon_60x60.png 127 | $(BDS)\bin\Artwork\iOS\iPhone\FM_SpotlightSearchIcon_80x80.png 128 | $(BDS)\bin\Artwork\iOS\iPhone\FM_ApplicationIcon_120x120.png 129 | CFBundleName=$(MSBuildProjectName);CFBundleDevelopmentRegion=en;CFBundleDisplayName=$(MSBuildProjectName);CFBundleIdentifier=$(MSBuildProjectName);CFBundleInfoDictionaryVersion=7.1;CFBundleVersion=1.0.0.0;CFBundlePackageType=APPL;CFBundleSignature=????;LSRequiresIPhoneOS=true;CFBundleAllowMixedLocalizations=YES;CFBundleExecutable=$(MSBuildProjectName);UIDeviceFamily=iPhone & iPad;CFBundleResourceSpecification=ResourceRules.plist;NSLocationAlwaysUsageDescription=The reason for accessing the location information of the user;NSLocationWhenInUseUsageDescription=The reason for accessing the location information of the user;FMLocalNotificationPermission=false;UIBackgroundModes= 130 | iPhoneAndiPad 131 | 132 | 133 | $(BDS)\bin\Artwork\iOS\iPad\FM_LaunchImageLandscape_2048x1536.png 134 | $(BDS)\bin\Artwork\iOS\iPad\FM_SpotlightSearchIcon_80x80.png 135 | $(BDS)\bin\Artwork\iOS\iPad\FM_LaunchImageLandscape_1024x768.png 136 | true 137 | $(BDS)\bin\Artwork\iOS\iPad\FM_ApplicationIcon_152x152.png 138 | $(BDS)\bin\Artwork\iOS\iPhone\FM_SpotlightSearchIcon_40x40.png 139 | $(BDS)\bin\Artwork\iOS\iPad\FM_SpotlightSearchIcon_40x40.png 140 | $(BDS)\bin\Artwork\iOS\iPad\FM_LaunchImagePortrait_1536x2048.png 141 | $(MSBuildProjectName) 142 | $(BDS)\bin\Artwork\iOS\iPad\FM_LaunchImagePortrait_768x1024.png 143 | Debug 144 | $(BDS)\bin\Artwork\iOS\iPad\FM_ApplicationIcon_76x76.png 145 | $(BDS)\bin\Artwork\iOS\iPhone\FM_ApplicationIcon_60x60.png 146 | $(BDS)\bin\Artwork\iOS\iPhone\FM_SpotlightSearchIcon_80x80.png 147 | $(BDS)\bin\Artwork\iOS\iPhone\FM_ApplicationIcon_120x120.png 148 | CFBundleName=$(MSBuildProjectName);CFBundleDevelopmentRegion=en;CFBundleDisplayName=$(MSBuildProjectName);CFBundleIdentifier=$(MSBuildProjectName);CFBundleInfoDictionaryVersion=7.1;CFBundleVersion=1.0.0.0;CFBundlePackageType=APPL;CFBundleSignature=????;LSRequiresIPhoneOS=true;CFBundleAllowMixedLocalizations=YES;CFBundleExecutable=$(MSBuildProjectName);UIDeviceFamily=iPhone & iPad;CFBundleResourceSpecification=ResourceRules.plist;NSLocationAlwaysUsageDescription=The reason for accessing the location information of the user;NSLocationWhenInUseUsageDescription=The reason for accessing the location information of the user;FMLocalNotificationPermission=false;UIBackgroundModes= 149 | iPhoneAndiPad 150 | 151 | 152 | $(BDS)\bin\Artwork\iOS\iPad\FM_SpotlightSearchIcon_80x80.png 153 | $(BDS)\bin\Artwork\iOS\iPad\FM_LaunchImageLandscape_2048x1536.png 154 | true 155 | $(BDS)\bin\Artwork\iOS\iPad\FM_SpotlightSearchIcon_40x40.png 156 | $(BDS)\bin\Artwork\iOS\iPhone\FM_SpotlightSearchIcon_40x40.png 157 | $(BDS)\bin\Artwork\iOS\iPad\FM_ApplicationIcon_152x152.png 158 | $(BDS)\bin\Artwork\iOS\iPad\FM_LaunchImagePortrait_1536x2048.png 159 | $(BDS)\bin\Artwork\iOS\iPad\FM_LaunchImageLandscape_1024x768.png 160 | $(BDS)\bin\Artwork\iOS\iPad\FM_LaunchImagePortrait_768x1024.png 161 | $(BDS)\bin\Artwork\iOS\iPhone\FM_ApplicationIcon_60x60.png 162 | $(BDS)\bin\Artwork\iOS\iPad\FM_ApplicationIcon_76x76.png 163 | CFBundleName=$(MSBuildProjectName);CFBundleDevelopmentRegion=en;CFBundleDisplayName=$(MSBuildProjectName);CFBundleIdentifier=$(MSBuildProjectName);CFBundleInfoDictionaryVersion=7.1;CFBundleVersion=1.0.0.0;CFBundlePackageType=APPL;CFBundleSignature=????;LSRequiresIPhoneOS=true;CFBundleAllowMixedLocalizations=YES;CFBundleExecutable=$(MSBuildProjectName);UIDeviceFamily=iPhone & iPad;CFBundleResourceSpecification=ResourceRules.plist;NSLocationAlwaysUsageDescription=The reason for accessing the location information of the user;NSLocationWhenInUseUsageDescription=The reason for accessing the location information of the user;FMLocalNotificationPermission=false;UIBackgroundModes= 164 | $(BDS)\bin\Artwork\iOS\iPhone\FM_ApplicationIcon_120x120.png 165 | $(BDS)\bin\Artwork\iOS\iPhone\FM_SpotlightSearchIcon_80x80.png 166 | iPhoneAndiPad 167 | 168 | 169 | Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) 170 | 1033 171 | 172 | 173 | false 174 | RELEASE;$(DCC_Define) 175 | 0 176 | 0 177 | 178 | 179 | DEBUG;$(DCC_Define) 180 | 181 | 182 | true 183 | 184 | 185 | true 186 | 187 | 188 | true 189 | 190 | 191 | 192 | MainSource 193 | 194 | 195 | Cfg_2 196 | Base 197 | 198 | 199 | Base 200 | 201 | 202 | Cfg_1 203 | Base 204 | 205 | 206 | 207 | 208 | Delphi.Personality.12 209 | 210 | 211 | 212 | 213 | False 214 | True 215 | False 216 | 217 | 218 | False 219 | False 220 | 1 221 | 0 222 | 0 223 | 0 224 | False 225 | False 226 | False 227 | False 228 | False 229 | 1040 230 | 1252 231 | 232 | 233 | 234 | 235 | 1.0.0.0 236 | 237 | 238 | 239 | 240 | 241 | 1.0.0.0 242 | 243 | 244 | 245 | SimpleMessaging.dpr 246 | 247 | 248 | 249 | False 250 | False 251 | False 252 | False 253 | False 254 | True 255 | False 256 | 257 | 258 | 12 259 | 260 | 261 | 262 | -------------------------------------------------------------------------------- /examples/SimpleMessaging/SimpleMessaging.lpi: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57 | 58 | 59 | 60 | 61 | 62 | 63 | 64 | 65 | 66 | 67 | 68 | 69 | 70 | 71 | 72 | 73 | 74 | 75 | 76 | 77 | 78 | 79 | 80 | 81 | 82 | 83 | 84 | 85 | 86 | 87 | 88 | 89 | 90 | 91 | 92 | 93 | 94 | 95 | 96 | 97 | 98 | 99 | 100 | 101 | 102 | 103 | 104 | -------------------------------------------------------------------------------- /packages/lazarus/delphistomp.lpk: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | -------------------------------------------------------------------------------- /packages/lazarus/delphistomp.pas: -------------------------------------------------------------------------------- 1 | { This file was automatically created by Lazarus. do not edit! 2 | This source is only used to compile and install the package. 3 | } 4 | 5 | unit delphistomp; 6 | 7 | interface 8 | 9 | uses 10 | StompClient, StompTypes, LazarusPackageIntf; 11 | 12 | implementation 13 | 14 | procedure Register; 15 | begin 16 | end; 17 | 18 | initialization 19 | RegisterPackage('delphistomp', @Register); 20 | end. 21 | -------------------------------------------------------------------------------- /pasdocfiles.txt: -------------------------------------------------------------------------------- 1 | StompClient.pas -------------------------------------------------------------------------------- /test/MainU.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/danieleteti/delphistompclient/8aad53b690494f441fee7c3eb3b96007bfdffde6/test/MainU.pas -------------------------------------------------------------------------------- /test/teststompclient.dpr: -------------------------------------------------------------------------------- 1 | program teststompclient; 2 | {$APPTYPE CONSOLE} 3 | 4 | 5 | uses 6 | MainU in 'MainU.pas', 7 | SysUtils, 8 | StompClient in '..\StompClient.pas'; 9 | 10 | const 11 | SERVERNAME = 12 | 'localhost'; 13 | // '192.168.3.72'; 14 | 15 | begin 16 | ReportMemoryLeaksOnShutdown := True; 17 | try 18 | Main(SERVERNAME, Ver_1_0); 19 | //Main(SERVERNAME, STOMP_Version_1_1); // Your STOMP server supports protocol 1.1 ? 20 | //MainWithTransaction; 21 | //Test_Unicode_Chars; 22 | Writeln('ALL TESTS OK'); 23 | except 24 | on E: Exception do 25 | Writeln(E.Classname, ': ', E.message); 26 | end; 27 | 28 | readln; 29 | 30 | end. 31 | -------------------------------------------------------------------------------- /test/teststompclient2007.bdsproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | 4 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | teststompclient2007.dpr 14 | 15 | 16 | 7.0 17 | 18 | 19 | 8 20 | 0 21 | 1 22 | 1 23 | 0 24 | 0 25 | 1 26 | 1 27 | 1 28 | 0 29 | 0 30 | 1 31 | 0 32 | 1 33 | 0 34 | 1 35 | 0 36 | 0 37 | 0 38 | 0 39 | 0 40 | 1 41 | 1 42 | 1 43 | 1 44 | 1 45 | True 46 | True 47 | WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; 48 | 49 | False 50 | 51 | True 52 | True 53 | True 54 | True 55 | True 56 | True 57 | True 58 | True 59 | True 60 | True 61 | True 62 | True 63 | True 64 | True 65 | True 66 | True 67 | True 68 | True 69 | True 70 | True 71 | True 72 | True 73 | True 74 | True 75 | True 76 | True 77 | True 78 | True 79 | True 80 | True 81 | True 82 | True 83 | True 84 | True 85 | True 86 | True 87 | True 88 | True 89 | True 90 | True 91 | True 92 | True 93 | True 94 | True 95 | True 96 | True 97 | False 98 | False 99 | False 100 | True 101 | True 102 | True 103 | True 104 | True 105 | True 106 | True 107 | True 108 | True 109 | True 110 | True 111 | True 112 | True 113 | True 114 | True 115 | 116 | 117 | 118 | 0 119 | 0 120 | False 121 | 1 122 | False 123 | False 124 | False 125 | 16384 126 | 1048576 127 | 4194304 128 | 129 | 130 | 131 | bin 132 | 133 | 134 | 135 | 136 | 137 | 138 | 139 | False 140 | 141 | 142 | 143 | 144 | 145 | False 146 | 147 | 148 | True 149 | False 150 | 151 | 152 | False 153 | 154 | 155 | False 156 | False 157 | 1 158 | 0 159 | 0 160 | 0 161 | False 162 | False 163 | False 164 | False 165 | False 166 | 1040 167 | 1252 168 | 169 | 170 | 171 | 172 | 1.0.0.0 173 | 174 | 175 | 176 | 177 | 178 | 1.0.0.0 179 | 180 | 181 | 182 | 183 | 184 | 185 | 186 | 187 | 188 | 189 | 190 | 191 | 192 | 193 | 194 | TechInsite Object Persistence Framework (tiOPF) GUI Controls 195 | SnapDataset 196 | CodeGear C++Builder Office 2000 Servers Package 197 | CodeGear C++Builder Office XP Servers Package 198 | Microsoft Office 2000 Sample Automation Server Wrapper Components 199 | Microsoft Office XP Sample Automation Server Wrapper Components 200 | 201 | 202 | 203 | 204 | -------------------------------------------------------------------------------- /test/teststompclient2007.dpr: -------------------------------------------------------------------------------- 1 | program teststompclient2007; 2 | 3 | {$APPTYPE CONSOLE} 4 | 5 | uses 6 | StompTypes in 'StompTypes.pas', 7 | StompClient in 'StompClient.pas', 8 | MainU in 'MainU.pas', 9 | SysUtils, 10 | StopWatch in 'StopWatch.pas'; 11 | 12 | var 13 | address: string; 14 | begin 15 | if ParamCount = 1 then 16 | address := paramstr(1) 17 | else 18 | address := 'localhost'; 19 | try 20 | Main(address); 21 | except 22 | on E: Exception do 23 | Writeln(E.Classname, ': ', E.Message); 24 | end; 25 | end. 26 | 27 | -------------------------------------------------------------------------------- /test/teststompclient2007.dproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | 4 | {3dd24f26-0884-4787-b800-e287987f0521} 5 | teststompclient2007.dpr 6 | Debug 7 | AnyCPU 8 | DCC32 9 | teststompclient2007.exe 10 | 11 | 12 | 7.0 13 | False 14 | False 15 | 0 16 | RELEASE 17 | 18 | 19 | 7.0 20 | DEBUG 21 | $(BDS)\source\Indy\Indy10\Core;$(BDS)\source\Indy\Indy10\System;$(DCC_UnitSearchPath);$(BDS)\Source\DUnit\src 22 | $(BDS)\source\Indy\Indy10\Core;$(BDS)\source\Indy\Indy10\System;$(DCC_UnitSearchPath);$(BDS)\Source\DUnit\src 23 | $(BDS)\source\Indy\Indy10\Core;$(BDS)\source\Indy\Indy10\System;$(DCC_UnitSearchPath);$(BDS)\Source\DUnit\src 24 | $(BDS)\source\Indy\Indy10\Core;$(BDS)\source\Indy\Indy10\System;$(DCC_UnitSearchPath);$(BDS)\Source\DUnit\src 25 | 26 | 27 | Delphi.Personality 28 | VCLApplication 29 | 30 | FalseTrueFalseFalseFalse1000FalseFalseFalseFalseFalse104012521.0.0.01.0.0.0 31 | 32 | 33 | 34 | 35 | 36 | 37 | Microsoft Office 2000 Sample Automation Server Wrapper Components 38 | Microsoft Office XP Sample Automation Server Wrapper Components 39 | teststompclient2007.dpr 40 | 41 | 42 | 43 | 44 | MainSource 45 | 46 | 47 | 48 | 49 | 50 | 51 | -------------------------------------------------------------------------------- /testLazarus/MainU.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/danieleteti/delphistompclient/8aad53b690494f441fee7c3eb3b96007bfdffde6/testLazarus/MainU.pas -------------------------------------------------------------------------------- /testLazarus/teststompclient.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/danieleteti/delphistompclient/8aad53b690494f441fee7c3eb3b96007bfdffde6/testLazarus/teststompclient.ico -------------------------------------------------------------------------------- /testLazarus/teststompclient.lpi: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57 | 58 | 59 | 60 | 61 | 62 | 63 | 64 | 65 | 66 | 67 | 68 | 69 | 70 | 71 | 72 | 73 | 74 | 75 | 76 | 77 | 78 | 79 | 80 | 81 | 82 | 83 | 84 | 85 | 86 | 87 | 88 | 89 | 90 | 91 | 92 | 93 | 94 | 95 | 96 | 97 | 98 | 99 | 100 | 101 | 102 | 103 | 104 | 105 | 106 | 107 | 108 | 109 | 110 | 111 | 112 | 113 | 114 | 115 | 116 | 117 | 118 | 119 | 120 | 121 | 122 | 123 | 124 | 125 | 126 | 127 | 128 | 129 | 130 | 131 | 132 | 133 | 134 | 135 | 136 | 137 | 138 | 139 | 140 | 141 | 142 | 143 | 144 | 145 | 146 | 147 | 148 | 149 | 150 | 151 | 152 | 153 | 154 | 155 | 156 | 157 | 158 | 159 | 160 | 161 | 162 | 163 | 164 | 165 | 166 | 167 | 168 | 169 | 170 | 171 | 172 | 173 | 174 | 175 | 176 | 177 | 178 | 179 | 180 | 181 | 182 | 183 | 184 | 185 | 186 | 187 | 188 | 189 | 190 | 191 | 192 | 193 | 194 | 195 | 196 | 197 | 198 | 199 | 200 | 201 | 202 | 203 | 204 | 205 | 206 | 207 | 208 | 209 | 210 | 211 | 212 | 213 | 214 | 215 | 216 | 217 | 218 | 219 | 220 | -------------------------------------------------------------------------------- /testLazarus/teststompclient.lpr: -------------------------------------------------------------------------------- 1 | program teststompclient; 2 | 3 | {$MODE Delphi} 4 | 5 | uses 6 | 7 | {$IFDEF UNIX} 8 | cthreads, 9 | {$ENDIF} 10 | MainU in 'MainU.pas', 11 | SysUtils, 12 | StompClient in '../StompClient.pas', 13 | StompTypes in '../StompTypes.pas'; 14 | 15 | begin 16 | try 17 | Main; 18 | MainWithTransaction; 19 | // Test_Unicode_Chars; //Non passa 20 | Writeln('ALL TESTS OK'); 21 | except 22 | on E: Exception do 23 | Writeln(E.Classname, ': ', E.message); 24 | end; 25 | 26 | readln; 27 | end. 28 | -------------------------------------------------------------------------------- /testLazarus/teststompclient.rc: -------------------------------------------------------------------------------- 1 | MAINICON ICON "teststompclient.ico" 2 | -------------------------------------------------------------------------------- /tutorial/10_HelloWorld/Group.groupproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | {371E485B-CE07-4B05-9369-25AFB51D4C1F} 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | Default.Personality.12 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | -------------------------------------------------------------------------------- /tutorial/10_HelloWorld/consumer.dpr: -------------------------------------------------------------------------------- 1 | program consumer; 2 | 3 | {$APPTYPE CONSOLE} 4 | 5 | {$R *.res} 6 | 7 | { 8 | https://www.rabbitmq.com/tutorials/tutorial-one-python.html 9 | } 10 | 11 | uses 12 | System.SysUtils, 13 | StompClient in '..\..\StompClient.pas'; 14 | 15 | procedure Main; 16 | var 17 | lClient: IStompClient; 18 | lStompFrame: IStompFrame; 19 | begin 20 | lClient := StompUtils.StompClient; 21 | lClient.Connect(); 22 | WriteLn('Subscribing to queue "myqueue"'); 23 | lClient.Subscribe('/queue/myqueue'); 24 | 25 | WriteLn('Reading just the following 2 messages...'); 26 | WriteLn(sLineBreak + sLineBreak + 'Waiting for the 1st message...' + sLineBreak + 27 | StringOfChar('*', 40)); 28 | 29 | if lClient.Receive(lStompFrame, 5000) then 30 | begin 31 | WriteLn('MESSAGE: ' + lStompFrame.GetBody); 32 | end 33 | else 34 | begin 35 | WriteLn('Cannot read message after timeout...'); 36 | end; 37 | 38 | WriteLn(sLineBreak + sLineBreak + 'Waiting for the 2nd message...' + sLineBreak + 39 | StringOfChar('*', 40)); 40 | if lClient.Receive(lStompFrame, 5000) then 41 | begin 42 | WriteLn('MESSAGE: ' + lStompFrame.GetBody); 43 | end 44 | else 45 | WriteLn('Cannot read message after timeout...'); 46 | 47 | WriteLn('Closing'); 48 | lClient.Disconnect; 49 | end; 50 | 51 | begin 52 | try 53 | Main; 54 | Write('Press return to quit'); 55 | ReadLn; 56 | except 57 | on E: Exception do 58 | begin 59 | WriteLn(E.ClassName, ': ', E.Message); 60 | ReadLn; 61 | end; 62 | end; 63 | 64 | end. 65 | -------------------------------------------------------------------------------- /tutorial/10_HelloWorld/producer.dpr: -------------------------------------------------------------------------------- 1 | program producer; 2 | 3 | {$APPTYPE CONSOLE} 4 | 5 | {$R *.res} 6 | 7 | { 8 | https://www.rabbitmq.com/tutorials/tutorial-one-python.html 9 | } 10 | 11 | uses 12 | System.SysUtils, 13 | StompClient in '..\..\StompClient.pas'; 14 | 15 | procedure Main; 16 | var 17 | lClient: IStompClient; 18 | begin 19 | lClient := StompUtils.StompClient; 20 | lClient.Connect(); 21 | WriteLn('Sending messages to queue "myqueue"'); 22 | lClient.Send('/queue/myqueue', 'Message 1'); 23 | // lFrame := lClient.Receive(100); 24 | // if Assigned(lFrame) then 25 | // WriteLn(lFrame.Output); 26 | lClient.Send('/queue/myqueue', 'Message 2'); 27 | WriteLn('Messages sent'); 28 | lClient.Disconnect; 29 | end; 30 | 31 | begin 32 | try 33 | Main; 34 | write('Press return to quit'); 35 | ReadLn; 36 | except 37 | on E: Exception do 38 | begin 39 | WriteLn(E.ClassName, ': ', E.Message); 40 | ReadLn; 41 | end; 42 | end; 43 | 44 | end. 45 | -------------------------------------------------------------------------------- /tutorial/20_WorkQueues/Group.groupproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | {371E485B-CE07-4B05-9369-25AFB51D4C1F} 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | Default.Personality.12 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | -------------------------------------------------------------------------------- /tutorial/20_WorkQueues/consumer.dpr: -------------------------------------------------------------------------------- 1 | program consumer; 2 | 3 | {$APPTYPE CONSOLE} 4 | 5 | {$R *.res} 6 | 7 | { 8 | https://www.rabbitmq.com/tutorials/tutorial-two-python.html 9 | } 10 | 11 | uses 12 | System.SysUtils, 13 | StompClient in '..\..\StompClient.pas'; 14 | 15 | procedure Main; 16 | var 17 | lClient: IStompClient; 18 | lStompFrame: IStompFrame; 19 | lMessage: string; 20 | begin 21 | lClient := StompUtils.StompClient; 22 | lClient.Connect(); 23 | WriteLn('Subscribing to queue "myjobqueue"'); 24 | lClient.Subscribe('/queue/myjobqueue', 25 | TAckMode.amClient, 26 | StompUtils.Headers 27 | .Add('auto-delete', 'true') 28 | ); 29 | 30 | while true do 31 | begin 32 | WriteLn(sLineBreak + 'Waiting for messages... (KILL program to exit)' + sLineBreak + 33 | StringOfChar('*', 40)); 34 | 35 | if lClient.Receive(lStompFrame, 5000) then 36 | begin 37 | lMessage := lStompFrame.GetBody; 38 | WriteLn(Format('Got message [%s]. Please wait, I''m working on it...', [lMessage])); 39 | Sleep(1000 * lMessage.CountChar('.')); 40 | WriteLn(lMessage); 41 | WriteLn('Informing the broker that the message ' + lStompFrame.MessageID + 42 | ' has been properly processed'); 43 | lClient.Ack(lStompFrame.MessageID); 44 | end 45 | else 46 | WriteLn('Cannot read message after timeout...'); 47 | end; 48 | lClient.Disconnect; 49 | end; 50 | 51 | begin 52 | try 53 | Main; 54 | write('Press return to quit'); 55 | ReadLn; 56 | except 57 | on E: Exception do 58 | begin 59 | WriteLn(E.ClassName, ': ', E.Message); 60 | ReadLn; 61 | end; 62 | end; 63 | 64 | end. 65 | -------------------------------------------------------------------------------- /tutorial/20_WorkQueues/producer.dpr: -------------------------------------------------------------------------------- 1 | program producer; 2 | 3 | {$APPTYPE CONSOLE} 4 | 5 | {$R *.res} 6 | 7 | { 8 | https://www.rabbitmq.com/tutorials/tutorial-two-python.html 9 | } 10 | 11 | uses 12 | System.SysUtils, 13 | StompClient in '..\..\StompClient.pas'; 14 | 15 | procedure Main; 16 | var 17 | lClient: IStompClient; 18 | lMessage: string; 19 | begin 20 | lClient := StompUtils.StompClient; 21 | lClient.Connect(); 22 | WriteLn('Sending messages to queue "myjobqueue"'); 23 | WriteLn('NOTE: Consumers will wait a second for each "." present in the message.'); 24 | WriteLn(' empty message will terminate the program.'); 25 | lMessage := ''; 26 | repeat 27 | write('Message to send: '); 28 | Readln(lMessage); 29 | if not lMessage.IsEmpty then 30 | begin 31 | lClient.Send('/queue/myjobqueue', lMessage, StompUtils.Headers.Add('auto-delete', 'true')); 32 | end; 33 | until lMessage.IsEmpty; 34 | WriteLn('bye bye'); 35 | lClient.Disconnect; 36 | end; 37 | 38 | begin 39 | try 40 | Main; 41 | Readln; 42 | except 43 | on E: Exception do 44 | begin 45 | WriteLn(E.ClassName, ': ', E.Message); 46 | Readln; 47 | end; 48 | end; 49 | 50 | end. 51 | -------------------------------------------------------------------------------- /tutorial/25_DurableWorkQueues/Group.groupproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | {371E485B-CE07-4B05-9369-25AFB51D4C1F} 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | Default.Personality.12 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | -------------------------------------------------------------------------------- /tutorial/25_DurableWorkQueues/consumer.dpr: -------------------------------------------------------------------------------- 1 | program consumer; 2 | 3 | {$APPTYPE CONSOLE} 4 | 5 | {$R *.res} 6 | 7 | { 8 | https://www.rabbitmq.com/tutorials/tutorial-two-python.html 9 | with durability 10 | } 11 | 12 | uses 13 | System.SysUtils, 14 | StompClient in '..\..\StompClient.pas'; 15 | 16 | procedure Main; 17 | var 18 | lClient: IStompClient; 19 | lStompFrame: IStompFrame; 20 | lMessage: string; 21 | begin 22 | lClient := StompUtils.StompClient; 23 | lClient.Connect(); 24 | WriteLn('Subscribing to queue "myjobqueue"'); 25 | lClient.Subscribe('/queue/myjobqueue', TAckMode.amClient, 26 | StompUtils 27 | .Headers 28 | .Add(StompUtils.NewDurableSubscriptionHeader('12345')) 29 | .Add('persistent', 'true') 30 | ); 31 | 32 | while true do 33 | begin 34 | WriteLn(sLineBreak + 'Waiting for messages... (KILL program to exit)' + sLineBreak + 35 | StringOfChar('*', 40)); 36 | 37 | if lClient.Receive(lStompFrame, 5000) then 38 | begin 39 | lMessage := lStompFrame.GetBody; 40 | WriteLn(Format('Got message [%s]. Please wait, I''m working on it...', [lMessage])); 41 | Sleep(1000 * lMessage.CountChar('.')); 42 | WriteLn(lMessage); 43 | WriteLn('Informing the broker that the message ' + lStompFrame.MessageID + 44 | ' has been properly processed'); 45 | lClient.Ack(lStompFrame.MessageID); 46 | end 47 | else 48 | WriteLn('Cannot read message after timeout...'); 49 | end; 50 | lClient.Disconnect; 51 | end; 52 | 53 | begin 54 | try 55 | Main; 56 | write('Press return to quit'); 57 | ReadLn; 58 | except 59 | on E: Exception do 60 | begin 61 | WriteLn(E.ClassName, ': ', E.Message); 62 | ReadLn; 63 | end; 64 | end; 65 | 66 | end. 67 | -------------------------------------------------------------------------------- /tutorial/25_DurableWorkQueues/producer.dpr: -------------------------------------------------------------------------------- 1 | program producer; 2 | 3 | {$APPTYPE CONSOLE} 4 | 5 | {$R *.res} 6 | 7 | { 8 | https://www.rabbitmq.com/tutorials/tutorial-two-python.html 9 | with durability 10 | } 11 | 12 | uses 13 | System.SysUtils, 14 | StompClient in '..\..\StompClient.pas'; 15 | 16 | procedure Main; 17 | var 18 | lClient: IStompClient; 19 | lMessage: String; 20 | lIsEmpty: Boolean; 21 | begin 22 | lClient := StompUtils.StompClient; 23 | lClient.Connect(); 24 | WriteLn('Sending messages to queue "myjobqueue"'); 25 | WriteLn('NOTE: Consumers will wait a second for each "." present in the message.'); 26 | WriteLn(' empty message will terminate the program.'); 27 | lMessage := ''; 28 | repeat 29 | Write('Message to send: '); 30 | Readln(lMessage); 31 | lIsEmpty := lMessage.Trim.IsEmpty; 32 | if not lIsEmpty then 33 | begin 34 | lClient.Send('/queue/myjobqueue', lMessage.Trim, 35 | StompUtils 36 | .Headers 37 | .Add('persistent', 'true') 38 | ); 39 | end; 40 | until lIsEmpty; 41 | WriteLn('bye bye...'); 42 | lClient.Disconnect; 43 | end; 44 | 45 | begin 46 | try 47 | Main; 48 | Write('Press return to exit'); 49 | Readln; 50 | except 51 | on E: Exception do 52 | begin 53 | WriteLn(E.ClassName, ': ', E.Message); 54 | Readln; 55 | end; 56 | end; 57 | 58 | end. 59 | -------------------------------------------------------------------------------- /tutorial/30_PublishSubscribe/Group.groupproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | {907BD3D5-945B-422A-B395-708289F0C4BD} 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | Default.Personality.12 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | -------------------------------------------------------------------------------- /tutorial/30_PublishSubscribe/consumer.dpr: -------------------------------------------------------------------------------- 1 | program consumer; 2 | 3 | {$APPTYPE CONSOLE} 4 | 5 | {$R *.res} 6 | 7 | { 8 | https://www.rabbitmq.com/tutorials/tutorial-three-python.html 9 | } 10 | 11 | uses 12 | System.SysUtils, 13 | StompClient in '..\..\StompClient.pas'; 14 | 15 | procedure Main; 16 | var 17 | lClient: IStompClient; 18 | lStompFrame: IStompFrame; 19 | lMessage: string; 20 | begin 21 | lClient := StompUtils.StompClient 22 | .SetHeartBeat(1000, 1000) 23 | .SetAcceptVersion(TStompAcceptProtocol.Ver_1_1) 24 | .Connect; 25 | WriteLn('Subscribing to queue "myjobqueue"'); 26 | lClient.Subscribe('/topic/mytopic', 27 | TAckMode.amClient 28 | // ,StompUtils.Headers 29 | // .Add('auto-delete', 'true') 30 | ); 31 | 32 | while true do 33 | begin 34 | WriteLn(sLineBreak + 'Waiting for messages... (KILL program to exit)' + sLineBreak + 35 | StringOfChar('*', 40)); 36 | 37 | if lClient.Receive(lStompFrame, 5000) then 38 | begin 39 | lMessage := lStompFrame.GetBody; 40 | WriteLn(Format('Got message [%s]. Please wait, I''m working on it...', [lMessage])); 41 | Sleep(1000 * lMessage.CountChar('.')); 42 | WriteLn(lMessage); 43 | WriteLn('Informing the broker that the message ' + lStompFrame.MessageID + 44 | ' has been properly processed'); 45 | lClient.Ack(lStompFrame.MessageID); 46 | end 47 | else 48 | WriteLn('Cannot read message after timeout...'); 49 | end; 50 | lClient.Disconnect; 51 | end; 52 | 53 | begin 54 | try 55 | Main; 56 | write('Press return to quit'); 57 | ReadLn; 58 | except 59 | on E: Exception do 60 | begin 61 | WriteLn(E.ClassName, ': ', E.Message); 62 | ReadLn; 63 | end; 64 | end; 65 | 66 | end. 67 | -------------------------------------------------------------------------------- /tutorial/30_PublishSubscribe/consumer.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/danieleteti/delphistompclient/8aad53b690494f441fee7c3eb3b96007bfdffde6/tutorial/30_PublishSubscribe/consumer.res -------------------------------------------------------------------------------- /tutorial/30_PublishSubscribe/producer.dpr: -------------------------------------------------------------------------------- 1 | program producer; 2 | 3 | {$APPTYPE CONSOLE} 4 | 5 | {$R *.res} 6 | 7 | { 8 | https://www.rabbitmq.com/tutorials/tutorial-three-python.html 9 | } 10 | 11 | uses 12 | System.SysUtils, 13 | StompClient in '..\..\StompClient.pas'; 14 | 15 | procedure Main; 16 | var 17 | lClient: IStompClient; 18 | lMessage: string; 19 | begin 20 | lClient := StompUtils.StompClient 21 | .SetHeartBeat(0, 2000) 22 | .SetAcceptVersion(TStompAcceptProtocol.Ver_1_1) 23 | .Connect; 24 | WriteLn('Sending messages to topic "mytopic"'); 25 | WriteLn('NOTE: Consumers will wait a second for each "." present in the message.'); 26 | WriteLn(' empty message will terminate the program.'); 27 | lMessage := ''; 28 | repeat 29 | write('Message to send: '); 30 | Readln(lMessage); 31 | if not lMessage.IsEmpty then 32 | begin 33 | lClient.Send('/topic/mytopic', lMessage); 34 | // Server can replyes with an ERROR. 35 | // Server Errors raise exception automatically in the client, 36 | // so we can just "try" to read something. 37 | // If you need to understand the type of the error you can 38 | // read the message normally and check the body. 39 | lClient.Receive(100); 40 | end 41 | else 42 | WriteLn('Nothing to send... we are not kidding here bro!'); 43 | until lMessage.IsEmpty; 44 | WriteLn('bye bye'); 45 | lClient.Disconnect; 46 | end; 47 | 48 | begin 49 | try 50 | Main; 51 | Readln; 52 | except 53 | on E: Exception do 54 | begin 55 | WriteLn(E.ClassName, ': ', E.Message); 56 | Readln; 57 | end; 58 | end; 59 | 60 | end. 61 | -------------------------------------------------------------------------------- /tutorial/30_PublishSubscribe/producer.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/danieleteti/delphistompclient/8aad53b690494f441fee7c3eb3b96007bfdffde6/tutorial/30_PublishSubscribe/producer.res -------------------------------------------------------------------------------- /unittest/TestStompClient.dpr: -------------------------------------------------------------------------------- 1 | program TestStompClient; 2 | 3 | {$IFDEF FPC} 4 | {$mode delphi}{$H+} 5 | {$ELSE} 6 | {$APPTYPE CONSOLE} 7 | {$ENDIF} 8 | 9 | uses 10 | {$IFDEF FPC} 11 | {$IFDEF UNIX} 12 | cthreads, 13 | {$ENDIF } 14 | {$ENDIF } 15 | SysUtils, 16 | StompClient in '..\StompClient.pas'; 17 | 18 | procedure Example_Durable_Subscription; 19 | var 20 | StompPub, StompSubscriber: IStompClient; 21 | StompFrame: IStompFrame; 22 | StompHeaders: IStompHeaders; 23 | begin 24 | StompHeaders := StompUtils.Headers; 25 | StompHeaders.Add(StompUtils.NewDurableSubscriptionHeader('my-unique-id')); 26 | 27 | WriteLn('==> Example_Durable_Subscription'); 28 | 29 | write('> Register a subscriber to "/queue/durable01" using a client-id...'); 30 | StompSubscriber := StompUtils.StompClientAndConnect('127.0.0.1', 61613, 31 | 'client-id'); 32 | StompSubscriber.Subscribe('/queue/durable01', amAuto, StompHeaders); 33 | StompSubscriber := nil; 34 | WriteLn('Now, disconnect from the broker.' + sLineBreak); 35 | 36 | write('> Sending a message to "/queue/durable01"'); 37 | StompPub := StompUtils.StompClientAndConnect; 38 | StompPub.Send('/queue/durable01', 39 | 'this message has been sent when the subscriber client was disconnected'); 40 | StompPub := nil; 41 | WriteLn('... and disconnect' + sLineBreak); 42 | 43 | WriteLn('> The previoous subscriber reconnects using the same client-id'); 44 | StompSubscriber := StompUtils.StompClientAndConnect('127.0.0.1', 61613, 45 | 'client-id'); 46 | StompSubscriber.Subscribe('/queue/durable01', amAuto, StompHeaders); 47 | // default port 48 | repeat 49 | StompFrame := StompSubscriber.Receive(1000); 50 | if not Assigned(StompFrame) then 51 | WriteLn('No Message'); 52 | until Assigned(StompFrame); 53 | WriteLn('> Found the message (even if it was disconnected when the message has been actually published.' 54 | + sLineBreak); 55 | WriteLn(StompFrame.Body); // Print "Some test message" 56 | WriteLn; 57 | end; 58 | 59 | procedure Example_Pub_Subscriber; 60 | var 61 | StompPub, StompSubscriber: IStompClient; 62 | StompFrame: IStompFrame; 63 | begin 64 | WriteLn('==> Example_Pub_Subscriber'); 65 | StompSubscriber := StompUtils.StompClientAndConnect; 66 | // StompSubscriber.Subscribe('/topic/dummy', amAuto, StompUtils.Headers.Add('auto-delete', 'true')); 67 | StompSubscriber.Subscribe('/topic/dummy'); 68 | StompPub := StompUtils.StompClientAndConnect; 69 | StompPub.Send('/topic/dummy', 'Some test message'); 70 | repeat 71 | StompFrame := StompSubscriber.Receive(500); 72 | until Assigned(StompFrame); 73 | WriteLn(StompFrame.Body); // Print "Some test message" 74 | WriteLn; 75 | StompSubscriber.Unsubscribe('/topic/dummy'); 76 | end; 77 | 78 | procedure Example_OnePub_TwoSubscriber; 79 | var 80 | StompPub, StompSub1, StompSub2: IStompClient; 81 | StompFrame: IStompFrame; 82 | begin 83 | WriteLn('==> Example_OnePub_TwoSubscriber'); 84 | // first subscriber 85 | StompSub1 := StompUtils.StompClientAndConnect; 86 | StompSub1.Subscribe('/topic/dummy'); 87 | while Assigned(StompSub1.Receive(100)) do; // empty the queue 88 | 89 | // second subscriber 90 | StompSub2 := StompUtils.StompClientAndConnect; 91 | StompSub2.Subscribe('/topic/dummy'); 92 | while Assigned(StompSub2.Receive(100)) do; // empty the queue 93 | 94 | // publish the messages 95 | StompPub := StompUtils.StompClientAndConnect; 96 | write('> Publishing 2 message on "/topic/dummy"...'); 97 | StompPub.Send('/topic/dummy', 'First test message on a topic'); 98 | StompPub.Send('/topic/dummy', 'Second test message on a topic'); 99 | WriteLn('DONE!'); 100 | 101 | // read messages from the subscriber1 102 | WriteLn('> Reading from SUB1'); 103 | StompFrame := StompSub1.Receive(2000); 104 | if not Assigned(StompFrame) then 105 | raise Exception.Create('Cannot read message'); 106 | WriteLn(StompFrame.Body); 107 | StompFrame := StompSub1.Receive(2000); 108 | if not Assigned(StompFrame) then 109 | raise Exception.Create('Cannot read message'); 110 | WriteLn(StompFrame.Body); 111 | 112 | // read messages from the subscriber2 113 | WriteLn('> Reading from SUB2'); 114 | StompFrame := StompSub2.Receive(2000); 115 | if not Assigned(StompFrame) then 116 | raise Exception.Create('Cannot read message'); 117 | WriteLn(StompFrame.Body); 118 | StompFrame := StompSub2.Receive(2000); 119 | if not Assigned(StompFrame) then 120 | raise Exception.Create('Cannot read message'); 121 | WriteLn(StompFrame.Body); 122 | WriteLn; 123 | end; 124 | 125 | procedure Example_PointToPoint; 126 | var 127 | StompPub, StompSub1, StompSub2: IStompClient; 128 | StompFrame: IStompFrame; 129 | begin 130 | WriteLn('==> Example_PointToPoint'); 131 | StompSub1 := StompUtils.StompClientAndConnect; // default port 132 | StompSub2 := StompUtils.StompClientAndConnect; // default port 133 | StompSub1.Subscribe('/queue/PointToPoint'); 134 | StompSub2.Subscribe('/queue/PointToPoint'); 135 | 136 | // 137 | StompPub := StompUtils.StompClientAndConnect; // default port 138 | StompPub.Send('/queue/PointToPoint', 'First test message on a queue'); 139 | StompPub.Send('/queue/PointToPoint', 'Second test message on a queue'); 140 | 141 | StompFrame := StompSub1.Receive(200); 142 | if Assigned(StompFrame) then 143 | WriteLn(StompFrame.Output); 144 | StompFrame := StompSub1.Receive(200); 145 | if Assigned(StompFrame) then 146 | WriteLn(StompFrame.Output); 147 | 148 | StompFrame := StompSub2.Receive(200); 149 | if Assigned(StompFrame) then 150 | WriteLn(StompFrame.Output); 151 | StompFrame := StompSub2.Receive(200); 152 | if Assigned(StompFrame) then 153 | WriteLn(StompFrame.Output); 154 | 155 | WriteLn; 156 | end; 157 | 158 | procedure Example_Simple_Queue; 159 | var 160 | lProducer, lConsumer: IStompClient; 161 | StompFrame: IStompFrame; 162 | begin 163 | WriteLn('==> Example_Simple_Queue'); 164 | lConsumer := StompUtils.StompClientAndConnect; 165 | 166 | { TODO -oDaniele -cGeneral : Checkthis } 167 | // create an auto-delete queue 168 | lConsumer.Subscribe('/queue/dummy', amClient, 169 | StompUtils.Headers.Add(StompHeaders.AUTO_DELETE, 'true')); 170 | 171 | // creates a durable queue 172 | // lConsumer.Subscribe('/queue/dummy'); 173 | 174 | lProducer := StompUtils.StompClientAndConnect; 175 | lProducer.Send('/queue/dummy', 'Some test message', 176 | StompUtils.Headers.Add(StompHeaders.AUTO_DELETE, 'true')); 177 | repeat 178 | StompFrame := lConsumer.Receive(500); 179 | until Assigned(StompFrame); 180 | WriteLn(StompFrame.Body); // Print "Some test message" 181 | lConsumer.Ack(StompFrame.MessageID); 182 | WriteLn; 183 | lConsumer.Unsubscribe('/queue/dummy123'); 184 | end; 185 | 186 | type 187 | TSimpleProc = procedure; 188 | 189 | TTestItem = record 190 | Proc: TSimpleProc; 191 | Description: String; 192 | end; 193 | 194 | var 195 | TestItems: array [0 .. 4] of TTestItem = ( 196 | (Proc: Example_Pub_Subscriber; Description: 'PUB/SUB TEST'), 197 | (Proc: Example_Simple_Queue; Description: 'SIMPLE QUEUE TEST'), 198 | (Proc: Example_OnePub_TwoSubscriber; Description: 'ONE PUB TWO SUB TEST'), 199 | (Proc: Example_PointToPoint; Description: 'POINT TO POINT TEST'), 200 | (Proc: Example_Durable_Subscription; Description: 'DURABLE SUBSCRIPTION TEST')); 201 | 202 | TestItem: TTestItem; 203 | lFail: Boolean; 204 | 205 | begin 206 | // yes, this should become a proper DUnitX project... 207 | lFail := False; 208 | try 209 | for TestItem in TestItems do 210 | begin 211 | try 212 | WriteLn(TestItem.Description.PadRight(15) + ''.PadRight(10, '*')); 213 | TestItem.Proc; 214 | except 215 | on E: Exception do 216 | begin 217 | WriteLn('[' + TestItem.Description + '] FAILED with message ', 218 | E.Message); 219 | lFail := True; 220 | end; 221 | end; 222 | end; 223 | WriteLn('>> TEST FINISHED <<'); 224 | except 225 | on E: Exception do 226 | WriteLn(E.ClassName, ': ', E.Message); 227 | end; 228 | if DebugHook <> 0 then 229 | ReadLn; 230 | if lFail then 231 | ExitCode := 1 232 | else 233 | ExitCode := 0; 234 | 235 | end. 236 | -------------------------------------------------------------------------------- /unittest/TestStompClient.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/danieleteti/delphistompclient/8aad53b690494f441fee7c3eb3b96007bfdffde6/unittest/TestStompClient.res -------------------------------------------------------------------------------- /unittest/TestStompClientU.pas: -------------------------------------------------------------------------------- 1 | unit TestStompClientU; 2 | 3 | interface 4 | 5 | uses 6 | DUnitX.TestFramework, StompClient, System.Diagnostics, System.SysUtils; 7 | 8 | type 9 | 10 | [TestFixture] 11 | TTestSTOMP = class(TObject) 12 | public 13 | [Setup] 14 | procedure Setup; 15 | [TearDown] 16 | procedure TearDown; 17 | // Sample Methods 18 | // Simple single Test 19 | [Test] 20 | procedure TestPubSub10; 21 | // Test with TestCase Attribute to supply parameters. 22 | // [Test] 23 | // [TestCase('TestA', '1,2')] 24 | // [TestCase('TestB', '3,4')] 25 | // procedure Test2(const AValue1: Integer; const AValue2: Integer); 26 | end; 27 | 28 | implementation 29 | 30 | procedure TTestSTOMP.Setup; 31 | begin 32 | // FSTOMP := TStompClient.CreateAndConnect('127.0.0.1', 61613, '', 33 | // TStompAcceptProtocol.Ver_1_0); 34 | end; 35 | 36 | procedure TTestSTOMP.TearDown; 37 | begin 38 | // FSTOMP := nil; 39 | end; 40 | 41 | procedure TTestSTOMP.TestPubSub10; 42 | var 43 | lFrame: IStompFrame; 44 | lSW: TStopWatch; 45 | lSTOMP: IStompClient; 46 | I: Integer; 47 | begin 48 | lSTOMP := StompUtils.StompClient; 49 | lSTOMP.SetHeartBeat(1000, 0); 50 | lSTOMP.Connect('127.0.0.1', 61613, '', '', TStompAcceptProtocol.Ver_1_1); 51 | lSTOMP.Subscribe('/topic/mytopic'); 52 | Sleep(2000); 53 | lSTOMP.Send('/topic/mytopic', 'Hello World1'); 54 | lSTOMP.Send('/topic/mytopic', 'Hello World2'); 55 | lSTOMP.Send('/topic/mytopic', 'Hello World3'); 56 | lSTOMP.Send('/topic/mytopic', 'Hello World4'); 57 | lSTOMP.Send('/topic/mytopic', 'Hello World5'); 58 | 59 | lSW := TStopWatch.Create; 60 | for I := 1 to 5 do 61 | begin 62 | lFrame := lSTOMP.Receive(5000); 63 | Assert.IsTrue(lSW.ElapsedMilliseconds <= 50); 64 | Assert.IsNotNull(lFrame, 'Message not received by the sender'); 65 | Assert.AreEqual('Hello World' + I.ToString, lFrame.Body); 66 | end; 67 | lFrame := lSTOMP.Receive(50); 68 | end; 69 | 70 | initialization 71 | 72 | TDUnitX.RegisterTestFixture(TTestSTOMP); 73 | 74 | end. 75 | --------------------------------------------------------------------------------