├── .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 |
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 |
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 |
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 |
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 |
--------------------------------------------------------------------------------