├── TMQTTTest.res ├── TMQTTTest_Icon.ico ├── Tests ├── TMQTTLibTests.res ├── TMQTTLibTests_Icon.ico ├── TMQTTLibTests.dpr ├── dunit.ini ├── TestMQTTReadThread.pas ├── TestMQTT.pas ├── TMQTTLibTests.dproj └── TestMQTTHeaders.pas ├── TMQTTTest.dpr ├── .gitattributes ├── LICENSE.md ├── TMQTT_v2.groupproj ├── .gitignore ├── README.md ├── uMain.dfm ├── uMain.pas ├── TMQTTTest.dproj └── TMQTT ├── MQTTReadThread.pas ├── MQTT.pas └── MQTTHeaders.pas /TMQTTTest.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jamiei/Delphi-TMQTT2/HEAD/TMQTTTest.res -------------------------------------------------------------------------------- /TMQTTTest_Icon.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jamiei/Delphi-TMQTT2/HEAD/TMQTTTest_Icon.ico -------------------------------------------------------------------------------- /Tests/TMQTTLibTests.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jamiei/Delphi-TMQTT2/HEAD/Tests/TMQTTLibTests.res -------------------------------------------------------------------------------- /Tests/TMQTTLibTests_Icon.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jamiei/Delphi-TMQTT2/HEAD/Tests/TMQTTLibTests_Icon.ico -------------------------------------------------------------------------------- /TMQTTTest.dpr: -------------------------------------------------------------------------------- 1 | program TMQTTTest; 2 | 3 | uses 4 | Forms, 5 | uMain in 'uMain.pas' {fMain}, 6 | MQTT in 'TMQTT\MQTT.pas', 7 | MQTTHeaders in 'TMQTT\MQTTHeaders.pas', 8 | MQTTReadThread in 'TMQTT\MQTTReadThread.pas'; 9 | 10 | {$R *.res} 11 | 12 | begin 13 | Application.Initialize; 14 | Application.MainFormOnTaskbar := True; 15 | Application.CreateForm(TfMain, fMain); 16 | Application.Run; 17 | end. 18 | -------------------------------------------------------------------------------- /.gitattributes: -------------------------------------------------------------------------------- 1 | # Auto detect text files and perform LF normalization 2 | * text=auto 3 | 4 | # Custom for Visual Studio 5 | *.cs diff=csharp 6 | 7 | # Standard to msysgit 8 | *.doc diff=astextplain 9 | *.DOC diff=astextplain 10 | *.docx diff=astextplain 11 | *.DOCX diff=astextplain 12 | *.dot diff=astextplain 13 | *.DOT diff=astextplain 14 | *.pdf diff=astextplain 15 | *.PDF diff=astextplain 16 | *.rtf diff=astextplain 17 | *.RTF diff=astextplain 18 | -------------------------------------------------------------------------------- /Tests/TMQTTLibTests.dpr: -------------------------------------------------------------------------------- 1 | program TMQTTLibTests; 2 | { 3 | 4 | Delphi DUnit Test Project 5 | ------------------------- 6 | This project contains the DUnit test framework and the GUI/Console test runners. 7 | Add "CONSOLE_TESTRUNNER" to the conditional defines entry in the project options 8 | to use the console test runner. Otherwise the GUI test runner will be used by 9 | default. 10 | 11 | } 12 | 13 | {$IFDEF CONSOLE_TESTRUNNER} 14 | {$APPTYPE CONSOLE} 15 | {$ENDIF} 16 | 17 | uses 18 | Forms, 19 | TestFramework, 20 | GUITestRunner, 21 | TextTestRunner, 22 | TestMQTTHeaders in 'TestMQTTHeaders.pas', 23 | MQTTHeaders in '..\TMQTT\MQTTHeaders.pas', 24 | TestMQTTReadThread in 'TestMQTTReadThread.pas', 25 | MQTTReadThread in '..\TMQTT\MQTTReadThread.pas', 26 | MQTT in '..\TMQTT\MQTT.pas', 27 | TestMQTT in 'TestMQTT.pas'; 28 | 29 | {$R *.RES} 30 | 31 | begin 32 | Application.Initialize; 33 | if IsConsole then 34 | TextTestRunner.RunRegisteredTests 35 | else 36 | GUITestRunner.RunRegisteredTests; 37 | end. 38 | 39 | -------------------------------------------------------------------------------- /LICENSE.md: -------------------------------------------------------------------------------- 1 | The MIT License (MIT) 2 | 3 | Copyright (c) 2013 Jamie Ingilby 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy of 6 | this software and associated documentation files (the "Software"), to deal in 7 | the Software without restriction, including without limitation the rights to 8 | use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of 9 | the Software, and to permit persons to whom the Software is furnished to do so, 10 | subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS 17 | FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR 18 | COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER 19 | IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN 20 | CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. -------------------------------------------------------------------------------- /Tests/dunit.ini: -------------------------------------------------------------------------------- 1 | [GUITestRunner Config] 2 | AutoSave=1 3 | Left=709 4 | Top=29 5 | Width=500 6 | Height=718 7 | Maximized=0 8 | UseRegistry=0 9 | ResultsPanel.Height=174 10 | ErrorMessage.Height=68 11 | ErrorMessage.Visible=1 12 | FailureList.ColumnWidth[0]=120 13 | FailureList.ColumnWidth[1]=100 14 | FailureList.ColumnWidth[2]=200 15 | FailureList.ColumnWidth[3]=52 16 | HideTestNodesOnOpen=0 17 | BreakOnFailures=0 18 | FailOnNoChecksExecuted=0 19 | FailOnMemoryLeaked=0 20 | IgnoreSetUpTearDownLeaks=0 21 | ReportMemoryLeakTypes=0 22 | SelectTestedNode=1 23 | WarnOnFailTestOverride=0 24 | PopupX=350 25 | PopupY=30 26 | 27 | [Tests.TMQTTLibTests.exe] 28 | TestTMQTTVariableHeader=0 29 | 30 | [Tests.TMQTTLibTests.exe.TestTMQTTVariableHeader] 31 | TestToBytes=0 32 | 33 | [Tests.TMQTTLibTests.exe.TestTMQTTConnectVarHeader] 34 | 35 | [Tests.TMQTTLibTests.exe.TestTMQTTPublishVarHeader] 36 | 37 | [Tests.TMQTTLibTests.exe.TestTMQTTSubscribeVarHeader] 38 | 39 | [Tests.TMQTTLibTests.exe.TestTMQTTUnsubscribeVarHeader] 40 | 41 | [Tests.TMQTTLibTests.exe.TestTMQTTPayload] 42 | 43 | [Tests.TMQTTLibTests.exe.TestTMQTTMessage] 44 | 45 | [Tests.TMQTTLibTests.exe.TestTMQTTFixedHeader] 46 | 47 | [Tests.TMQTTLibTests.exe.TestTMQTT] 48 | 49 | [Tests.TMQTTLibTests.exe.TestUtilityMethods] 50 | 51 | [Tests.TMQTTLibTests.exe.TestTMQTTRecvUtilities] 52 | 53 | -------------------------------------------------------------------------------- /TMQTT_v2.groupproj: -------------------------------------------------------------------------------- 1 | 2 | 3 | {8533DFFC-E042-4B77-A340-6EAB9A8BC91A} 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 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | # Uncomment these types if you want even more clean repository. But be careful. 2 | # It can make harm to an existing project source. Read explanations below. 3 | # 4 | # Resource files are binaries containing manifest, project icon and version info. 5 | # They can not be viewed as text or compared by diff-tools. Consider replacing them with .rc files. 6 | #*.res 7 | # 8 | # Type library file (binary). In old Delphi versions it should be stored. 9 | # Since Delphi 2009 it is produced from .ridl file and can safely be ignored. 10 | #*.tlb 11 | # 12 | # Diagram Portfolio file. Used by the diagram editor up to Delphi 7. 13 | # Uncomment this if you are not using diagrams or use newer Delphi version. 14 | #*.ddp 15 | # 16 | # Visual LiveBindings file. Added in Delphi XE2. 17 | # Uncomment this if you are not using LiveBindings Designer. 18 | #*.vlb 19 | # 20 | # Deployment Manager configuration file for your project. Added in Delphi XE2. 21 | # Uncomment this if it is not mobile development and you do not use remote debug feature. 22 | #*.deployproj 23 | # 24 | 25 | # Delphi compiler-generated binaries (safe to delete) 26 | *.exe 27 | *.dll 28 | *.bpl 29 | *.bpi 30 | *.dcp 31 | *.so 32 | *.apk 33 | *.drc 34 | *.map 35 | *.dres 36 | *.rsm 37 | *.tds 38 | *.dcu 39 | *.lib 40 | 41 | # Delphi autogenerated files (duplicated info) 42 | *.cfg 43 | *Resource.rc 44 | 45 | # Delphi local files (user-specific info) 46 | *.local 47 | *.identcache 48 | *.projdata 49 | *.tvsconfig 50 | *.dsk 51 | 52 | # Delphi history and backups 53 | __history/ 54 | *.~* 55 | 56 | # ========================= 57 | # Operating System Files 58 | # ========================= 59 | 60 | # OSX 61 | # ========================= 62 | 63 | .DS_Store 64 | .AppleDouble 65 | .LSOverride 66 | 67 | # Thumbnails 68 | ._* 69 | 70 | # Files that might appear on external disk 71 | .Spotlight-V100 72 | .Trashes 73 | 74 | # Directories potentially created on remote AFP share 75 | .AppleDB 76 | .AppleDesktop 77 | Network Trash Folder 78 | Temporary Items 79 | .apdisk 80 | 81 | # Windows 82 | # ========================= 83 | 84 | # Windows image file caches 85 | Thumbs.db 86 | ehthumbs.db 87 | 88 | # Folder config file 89 | Desktop.ini 90 | 91 | # Recycle Bin used on file shares 92 | $RECYCLE.BIN/ 93 | 94 | # Windows Installer files 95 | *.cab 96 | *.msi 97 | *.msm 98 | *.msp 99 | 100 | # Windows shortcuts 101 | *.lnk 102 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # TMQTT 2 (ALPHA) for Delphi by Jamie I 2 | 3 | ## Introduction 4 | 5 | **WARNING: This is still considered ALPHA quality, and is NOT considered ready for *any real* use yet. All contributions and bug fix pull requests are appreciated.** 6 | 7 | 8 | TMQTT is a non-visual Delphi Client Library for the IBM Websphere MQ Transport Telemetry protocol ( http://mqtt.org ). It allows you to connect to a Message Broker that uses MQTT such as the [Really Small Message Broker](http://alphaworks.ibm.com/tech/rsmb) which is freely available for evaluation purposes on IBM Alphaworks. Mosquitto is an open source MQTT 3.1 broker ( http://mosquitto.org/ ). 9 | 10 | TMQTT is a complete re-write of the original TMQTTClient that I wrote and it is sufficiently different enough to release in parallel. 11 | 12 | MQTT is an IoT protocol, further information can be found here: http://mqtt.org/ 13 | 14 | 15 | ## Points of Note 16 | * There may be a few bugs. 17 | * It is not currently FPC compatible [Planned] 18 | * There are some improvements related to socket error handling which I have yet to make inspired by ZiCog's contributions to the original TMQTTClient. 19 | Note: You should be aware that it uses part of the Synapse Internet Communications Library for its Socket support so you’ll need to ensure that this is available on your search path. 20 | 21 | 22 | ## Usage 23 | There is a sample VCL project included in the download but usage is relatively simple. This is a non-visual component so all you need to do is to put the TMQTT directory into your compiler paths and then put MQTT in your uses. 24 | 25 | ```delphi 26 | uses MQTT; 27 | var 28 | MQTTClient: TMQTT; 29 | begin 30 | MQTT := TMQTT.Create('localhost', 1883); 31 | try 32 | // Events 33 | MQTT.OnConnAck := GotConnAck; 34 | MQTT.OnPublish := GotPub; 35 | MQTT.OnPingResp := GotPingResp; 36 | MQTT.OnSubAck := GotSubAck; 37 | MQTT.OnUnSubAck := GotUnSubAck; 38 | MQTT.OnPubAck := GotPubAck; 39 | 40 | if MQTT.Connect then 41 | begin 42 | WriteLn('Connected!'); 43 | MQTT.Subscribe('/dev/test', 0); 44 | MQTT.Publish('/dev/test', 'This is a test message'); 45 | end 46 | else 47 | WriteLn('Failed to connect'); 48 | finally 49 | MQTT.Free; 50 | end; 51 | end; 52 | 53 | procedure GotPub(Sender: TObject; topic, payload: Ansistring); 54 | begin 55 | WriteLn('Message Recieved on ' + topic + ' payload: ' + payload); 56 | end; 57 | ``` 58 | 59 | Special thanks for this re-write got to [ZiCog](https://github.com/ZiCog) for his help and improvements to the TMQTTClient library, which helped enormously. 60 | 61 | If you are using my TMQTT then I would to love hear about how you’re using it, if you do appreciate it, please let me know! 62 | -------------------------------------------------------------------------------- /Tests/TestMQTTReadThread.pas: -------------------------------------------------------------------------------- 1 | unit TestMQTTReadThread; 2 | { 3 | 4 | Delphi DUnit Test Case 5 | ---------------------- 6 | This unit contains a skeleton test case class generated by the Test Case Wizard. 7 | Modify the generated code to correctly setup and call the methods from the unit 8 | being tested. 9 | 10 | } 11 | 12 | interface 13 | 14 | uses 15 | TestFramework, Windows, MQTTReadThread, Generics.Collections, SmartInspect, Classes, 16 | SysUtils, MQTTHeaders, blcksock, SyncObjs, SiAuto; 17 | 18 | type 19 | // Test methods for class TMQTTRecvUtilities 20 | 21 | TestTMQTTRecvUtilities = class(TTestCase) 22 | strict private 23 | FMQTTRecvUtilities: TMQTTRecvUtilities; 24 | public 25 | procedure SetUp; override; 26 | procedure TearDown; override; 27 | published 28 | procedure TestMSBLSBToInt; 29 | procedure TestRLBytesToInt; 30 | end; 31 | // Test methods for class TUnparsedMsg 32 | 33 | TestTUnparsedMsg = class(TTestCase) 34 | strict private 35 | FUnparsedMsg: TUnparsedMsg; 36 | public 37 | procedure SetUp; override; 38 | procedure TearDown; override; 39 | end; 40 | // Test methods for class TMQTTReadThread 41 | 42 | TestTMQTTReadThread = class(TTestCase) 43 | strict private 44 | FMQTTReadThread: TMQTTReadThread; 45 | public 46 | procedure SetUp; override; 47 | procedure TearDown; override; 48 | end; 49 | 50 | implementation 51 | 52 | procedure TestTMQTTRecvUtilities.SetUp; 53 | begin 54 | FMQTTRecvUtilities := TMQTTRecvUtilities.Create; 55 | end; 56 | 57 | procedure TestTMQTTRecvUtilities.TearDown; 58 | begin 59 | FMQTTRecvUtilities.Free; 60 | FMQTTRecvUtilities := nil; 61 | end; 62 | 63 | procedure TestTMQTTRecvUtilities.TestMSBLSBToInt; 64 | var 65 | ReturnValue: Integer; 66 | ALengthBytes: TBytes; 67 | begin 68 | ALengthBytes := TMQTTUtilities.IntToMSBLSB(6); 69 | ReturnValue := FMQTTRecvUtilities.MSBLSBToInt(ALengthBytes); 70 | Assert(ReturnValue = 6, 'MSBLSBToInt on 6'); 71 | ALengthBytes := TMQTTUtilities.IntToMSBLSB(0); 72 | ReturnValue := FMQTTRecvUtilities.MSBLSBToInt(ALengthBytes); 73 | Assert(ReturnValue = 0, 'MSBLSBToInt on 0'); 74 | ALengthBytes := TMQTTUtilities.IntToMSBLSB(101); 75 | ReturnValue := FMQTTRecvUtilities.MSBLSBToInt(ALengthBytes); 76 | Assert(ReturnValue = 101, 'MSBLSBToInt on 101'); 77 | end; 78 | 79 | procedure TestTMQTTRecvUtilities.TestRLBytesToInt; 80 | var 81 | ReturnValue: Integer; 82 | ARlBytes: TBytes; 83 | begin 84 | ARlBytes := TMQTTUtilities.RLIntToBytes(0); 85 | ReturnValue := FMQTTRecvUtilities.RLBytesToInt(ARlBytes); 86 | Assert(ReturnValue = 0, 'RLBytes on 0'); 87 | ARlBytes := TMQTTUtilities.RLIntToBytes(6); 88 | ReturnValue := FMQTTRecvUtilities.RLBytesToInt(ARlBytes); 89 | Assert(ReturnValue = 6, 'RLBytes on 6'); 90 | ARlBytes := TMQTTUtilities.RLIntToBytes(40); 91 | ReturnValue := FMQTTRecvUtilities.RLBytesToInt(ARlBytes); 92 | Assert(ReturnValue = 40, 'RLBytes on 40'); 93 | ARlBytes := TMQTTUtilities.RLIntToBytes(112); 94 | ReturnValue := FMQTTRecvUtilities.RLBytesToInt(ARlBytes); 95 | Assert(ReturnValue = 112, 'RLBytes on 112'); 96 | ARlBytes := TMQTTUtilities.RLIntToBytes(512); 97 | ReturnValue := FMQTTRecvUtilities.RLBytesToInt(ARlBytes); 98 | Assert(ReturnValue = 512, 'RLBytes on 512'); 99 | end; 100 | 101 | procedure TestTUnparsedMsg.SetUp; 102 | begin 103 | //FUnparsedMsg := TUnparsedMsg.Create; 104 | //Assert(FUnparsedMsg <> nil, 'Create failed'); 105 | end; 106 | 107 | procedure TestTUnparsedMsg.TearDown; 108 | begin 109 | //FUnparsedMsg.Free; 110 | //FUnparsedMsg := nil; 111 | end; 112 | 113 | procedure TestTMQTTReadThread.SetUp; 114 | begin 115 | //FMQTTReadThread := TMQTTReadThread.Create; 116 | Assert(FMQTTReadThread <> nil, 'Thread Creation Failed'); 117 | end; 118 | 119 | procedure TestTMQTTReadThread.TearDown; 120 | begin 121 | FMQTTReadThread.Free; 122 | FMQTTReadThread := nil; 123 | end; 124 | 125 | initialization 126 | // Register any test cases with the test runner 127 | RegisterTest(TestTMQTTRecvUtilities.Suite); 128 | RegisterTest(TestTUnparsedMsg.Suite); 129 | RegisterTest(TestTMQTTReadThread.Suite); 130 | end. 131 | 132 | -------------------------------------------------------------------------------- /uMain.dfm: -------------------------------------------------------------------------------- 1 | object fMain: TfMain 2 | Left = 0 3 | Top = 0 4 | Caption = 'TMQTT Version 2 Test' 5 | ClientHeight = 413 6 | ClientWidth = 421 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 | PixelsPerInch = 96 15 | TextHeight = 13 16 | object lblHeader: TLabel 17 | Left = 8 18 | Top = 0 19 | Width = 410 20 | Height = 34 21 | Alignment = taCenter 22 | AutoSize = False 23 | Caption = 'Sample Client' 24 | Font.Charset = DEFAULT_CHARSET 25 | Font.Color = clNavy 26 | Font.Height = -21 27 | Font.Name = 'Tahoma' 28 | Font.Style = [fsBold, fsUnderline] 29 | ParentFont = False 30 | Layout = tlCenter 31 | end 32 | object lnlMQTTInfo: TLabel 33 | Left = 8 34 | Top = 337 35 | Width = 194 36 | Height = 13 37 | Caption = 'For more information about MQTT goto: ' 38 | end 39 | object lblMQTTUrl: TLabel 40 | Left = 208 41 | Top = 337 42 | Width = 102 43 | Height = 13 44 | Cursor = crHandPoint 45 | Caption = 'http://www.mqtt.org' 46 | Font.Charset = DEFAULT_CHARSET 47 | Font.Color = clBlue 48 | Font.Height = -11 49 | Font.Name = 'Tahoma' 50 | Font.Style = [fsUnderline] 51 | ParentFont = False 52 | end 53 | object lblPrimarilyTested: TLabel 54 | Left = 8 55 | Top = 356 56 | Width = 154 57 | Height = 13 58 | Caption = 'Server primarily tested against: ' 59 | end 60 | object lblRSMBUrl: TLabel 61 | Left = 168 62 | Top = 356 63 | Width = 181 64 | Height = 13 65 | Cursor = crHandPoint 66 | Caption = 'http://alphaworks.ibm.com/tech/rsmb' 67 | Font.Charset = DEFAULT_CHARSET 68 | Font.Color = clBlue 69 | Font.Height = -11 70 | Font.Name = 'Tahoma' 71 | Font.Style = [fsUnderline] 72 | ParentFont = False 73 | end 74 | object lblLimits: TLabel 75 | Left = 8 76 | Top = 375 77 | Width = 398 78 | Height = 13 79 | Caption = 80 | 'This Sample is not comprehensive of either the TMQTTClient nor t' + 81 | 'he MQTT Protocol' 82 | end 83 | object lblLimits2: TLabel 84 | Left = 8 85 | Top = 392 86 | Width = 288 87 | Height = 13 88 | Caption = 'but is a good place to start in learning how to use the client.' 89 | end 90 | object lblSynapse: TLabel 91 | Left = 8 92 | Top = 40 93 | Width = 402 94 | Height = 13 95 | Caption = 96 | 'You will need the Synapse Internet components to be in your proj' + 97 | 'ect search paths. ' 98 | end 99 | object btnConnect: TButton 100 | Left = 343 101 | Top = 56 102 | Width = 75 103 | Height = 25 104 | Caption = 'Connect' 105 | TabOrder = 0 106 | OnClick = btnConnectClick 107 | end 108 | object btnDisconnect: TButton 109 | Left = 343 110 | Top = 87 111 | Width = 75 112 | Height = 25 113 | Caption = 'Disconnect' 114 | TabOrder = 1 115 | OnClick = btnDisconnectClick 116 | end 117 | object btnPublish: TButton 118 | Left = 343 119 | Top = 150 120 | Width = 75 121 | Height = 25 122 | Caption = 'Publish' 123 | TabOrder = 2 124 | OnClick = btnPublishClick 125 | end 126 | object eTopic: TEdit 127 | Left = 8 128 | Top = 152 129 | Width = 121 130 | Height = 21 131 | TabOrder = 3 132 | Text = '/dev/test' 133 | end 134 | object eMessage: TEdit 135 | Left = 135 136 | Top = 152 137 | Width = 202 138 | Height = 21 139 | TabOrder = 4 140 | Text = 'This is a test message' 141 | end 142 | object eIP: TEdit 143 | Left = 8 144 | Top = 58 145 | Width = 202 146 | Height = 21 147 | TabOrder = 5 148 | Text = '127.0.0.1' 149 | end 150 | object ePort: TEdit 151 | Left = 216 152 | Top = 58 153 | Width = 121 154 | Height = 21 155 | TabOrder = 6 156 | Text = '1883' 157 | end 158 | object btnPing: TButton 159 | Left = 343 160 | Top = 118 161 | Width = 75 162 | Height = 25 163 | Caption = 'Ping' 164 | TabOrder = 7 165 | OnClick = btnPingClick 166 | end 167 | object btnSubscribe: TButton 168 | Left = 343 169 | Top = 179 170 | Width = 75 171 | Height = 25 172 | Caption = 'Subscribe' 173 | TabOrder = 8 174 | OnClick = btnSubscribeClick 175 | end 176 | object eSubTopic: TEdit 177 | Left = 135 178 | Top = 179 179 | Width = 202 180 | Height = 21 181 | TabOrder = 9 182 | Text = '/dev/test' 183 | end 184 | object mStatus: TMemo 185 | Left = 8 186 | Top = 210 187 | Width = 409 188 | Height = 121 189 | TabOrder = 10 190 | end 191 | end 192 | -------------------------------------------------------------------------------- /uMain.pas: -------------------------------------------------------------------------------- 1 | unit uMain; 2 | 3 | interface 4 | 5 | uses 6 | Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 7 | Dialogs, StdCtrls, ExtCtrls, 8 | 9 | MQTT; 10 | 11 | type 12 | TfMain = class(TForm) 13 | lblHeader: TLabel; 14 | lnlMQTTInfo: TLabel; 15 | lblMQTTUrl: TLabel; 16 | lblPrimarilyTested: TLabel; 17 | lblRSMBUrl: TLabel; 18 | lblLimits: TLabel; 19 | lblLimits2: TLabel; 20 | lblSynapse: TLabel; 21 | btnConnect: TButton; 22 | btnDisconnect: TButton; 23 | btnPublish: TButton; 24 | eTopic: TEdit; 25 | eMessage: TEdit; 26 | eIP: TEdit; 27 | ePort: TEdit; 28 | btnPing: TButton; 29 | btnSubscribe: TButton; 30 | eSubTopic: TEdit; 31 | mStatus: TMemo; 32 | procedure btnConnectClick(Sender: TObject); 33 | procedure btnDisconnectClick(Sender: TObject); 34 | procedure btnPingClick(Sender: TObject); 35 | procedure btnPublishClick(Sender: TObject); 36 | procedure btnSubscribeClick(Sender: TObject); 37 | procedure GotConnAck(Sender: TObject; ReturnCode: integer); 38 | procedure GotPingResp(Sender: TObject); 39 | procedure GotSubAck(Sender: TObject; MessageID: integer; GrantedQoS: Array of integer); 40 | procedure GotUnSubAck(Sender: TObject; MessageID: integer); 41 | procedure GotPub(Sender: TObject; topic, payload: Ansistring); 42 | procedure GotPubAck(Sender: TObject; MessageID: integer); 43 | procedure GotPubRec(Sender: TObject; MessageID: integer); 44 | procedure GotPubRel(Sender: TObject; MessageID: integer); 45 | procedure GotPubComp(Sender: TObject; MessageID: integer); 46 | private 47 | { Private declarations } 48 | public 49 | { Public declarations } 50 | end; 51 | 52 | var 53 | fMain: TfMain; 54 | MQTT: TMQTT; 55 | 56 | implementation 57 | 58 | {$R *.dfm} 59 | 60 | procedure TfMain.btnConnectClick(Sender: TObject); 61 | begin 62 | MQTT := TMQTT.Create(eIP.Text, StrToInt(ePort.Text)); 63 | MQTT.WillTopic := '/clients/will'; 64 | MQTT.WillMsg := 'Broker died!'; 65 | // Events 66 | MQTT.OnConnAck := GotConnAck; 67 | MQTT.OnPublish := GotPub; 68 | MQTT.OnPingResp := GotPingResp; 69 | MQTT.OnSubAck := GotSubAck; 70 | MQTT.OnUnSubAck := GotUnSubAck; 71 | MQTT.OnPubAck := GotPubAck; 72 | 73 | if MQTT.Connect then 74 | mStatus.Lines.Add('Connected to ' + eIP.Text + ' on ' + ePort.Text) 75 | else 76 | mStatus.Lines.Add('Failed to connect'); 77 | end; 78 | 79 | procedure TfMain.btnDisconnectClick(Sender: TObject); 80 | begin 81 | if (Assigned(MQTT)) then 82 | begin 83 | MQTT.Disconnect; 84 | mStatus.Lines.Add('Disconnected'); 85 | FreeAndNil(MQTT); 86 | end; 87 | end; 88 | 89 | procedure TfMain.btnPingClick(Sender: TObject); 90 | begin 91 | if (Assigned(MQTT)) then 92 | begin 93 | mStatus.Lines.Add('Ping'); 94 | MQTT.PingReq; 95 | end; 96 | end; 97 | 98 | procedure TfMain.btnPublishClick(Sender: TObject); 99 | begin 100 | if (Assigned(MQTT)) then 101 | begin 102 | MQTT.Publish(eTopic.Text, eMessage.Text); 103 | mStatus.Lines.Add('Published'); 104 | end; 105 | end; 106 | 107 | procedure TfMain.btnSubscribeClick(Sender: TObject); 108 | begin 109 | if (Assigned(MQTT)) then 110 | begin 111 | MQTT.Subscribe(eSubTopic.Text, 0); 112 | mStatus.Lines.Add('Subscribe'); 113 | end; 114 | end; 115 | 116 | procedure TfMain.GotConnAck(Sender: TObject; ReturnCode: integer); 117 | begin 118 | mStatus.Lines.Add('Connection Acknowledged: ' + IntToStr(ReturnCode)); 119 | end; 120 | 121 | procedure TfMain.GotPingResp(Sender: TObject); 122 | begin 123 | mStatus.Lines.Add('PONG!'); 124 | end; 125 | 126 | procedure TfMain.GotPub(Sender: TObject; topic, payload: Ansistring); 127 | begin 128 | mStatus.Lines.Add('Message Recieved on ' + topic + ' payload: ' + payload); 129 | end; 130 | 131 | procedure TfMain.GotPubAck(Sender: TObject; MessageID: integer); 132 | begin 133 | mStatus.Lines.Add('Got PubAck ' + IntToStr(MessageID)); 134 | end; 135 | 136 | procedure TfMain.GotPubComp(Sender: TObject; MessageID: integer); 137 | begin 138 | mStatus.Lines.Add('Got PubComp ' + IntToStr(MessageID)); 139 | end; 140 | 141 | procedure TfMain.GotPubRec(Sender: TObject; MessageID: integer); 142 | begin 143 | mStatus.Lines.Add('Got PubRec ' + IntToStr(MessageID)); 144 | end; 145 | 146 | procedure TfMain.GotPubRel(Sender: TObject; MessageID: integer); 147 | begin 148 | mStatus.Lines.Add('Got PubRel ' + IntToStr(MessageID)); 149 | end; 150 | 151 | procedure TfMain.GotSubAck(Sender: TObject; MessageID: integer; 152 | GrantedQoS: array of integer); 153 | begin 154 | mStatus.Lines.Add('Got SubAck ' + IntToStr(MessageID)); 155 | end; 156 | 157 | procedure TfMain.GotUnSubAck(Sender: TObject; MessageID: integer); 158 | begin 159 | mStatus.Lines.Add('Got UnSubAck ' + IntToStr(MessageID)); 160 | end; 161 | 162 | end. 163 | -------------------------------------------------------------------------------- /Tests/TestMQTT.pas: -------------------------------------------------------------------------------- 1 | unit TestMQTT; 2 | { 3 | 4 | Delphi DUnit Test Case 5 | ---------------------- 6 | This unit contains a skeleton test case class generated by the Test Case Wizard. 7 | Modify the generated code to correctly setup and call the methods from the unit 8 | being tested. 9 | 10 | } 11 | 12 | interface 13 | 14 | uses 15 | TestFramework, MQTT, Generics.Collections, Types, Classes, ExtCtrls, SysUtils, 16 | MQTTHeaders, MQTTReadThread, blcksock, SyncObjs, SmartInspect, SiAuto; 17 | 18 | type 19 | // Test methods for class TMQTT 20 | 21 | TestTMQTT = class(TTestCase) 22 | strict private 23 | FMQTT: TMQTT; 24 | public 25 | procedure SetUp; override; 26 | procedure TearDown; override; 27 | published 28 | procedure TestgetNextMessageId; 29 | procedure TestConnectMessage; 30 | procedure TestDisconnectMessage; 31 | procedure TestPublishMessage; 32 | procedure TestPingReqMessage; 33 | procedure TestSubscribeMessage; 34 | procedure TestUnsubscribeMessage; 35 | procedure TestConnect; 36 | procedure TestDisconnect; 37 | procedure TestPublish; 38 | procedure TestPublish1; 39 | procedure TestPublish2; 40 | procedure TestSubscribe; 41 | procedure TestSubscribe1; 42 | procedure TestUnsubscribe; 43 | procedure TestUnsubscribe1; 44 | procedure TestPingReq; 45 | end; 46 | 47 | implementation 48 | 49 | procedure TestTMQTT.SetUp; 50 | begin 51 | FMQTT := TMQTT.Create('localhost', 1883); 52 | end; 53 | 54 | procedure TestTMQTT.TearDown; 55 | begin 56 | FMQTT.Free; 57 | FMQTT := nil; 58 | end; 59 | 60 | procedure TestTMQTT.TestgetNextMessageId; 61 | var 62 | ReturnValue: Integer; 63 | begin 64 | //ReturnValue := FMQTT.getNextMessageId; 65 | // TODO: Validate method results 66 | end; 67 | 68 | procedure TestTMQTT.TestConnectMessage; 69 | var 70 | ReturnValue: TMQTTMessage; 71 | begin 72 | //ReturnValue := FMQTT.ConnectMessage; 73 | // TODO: Validate method results 74 | end; 75 | 76 | procedure TestTMQTT.TestDisconnectMessage; 77 | var 78 | ReturnValue: TMQTTMessage; 79 | begin 80 | //ReturnValue := FMQTT.DisconnectMessage; 81 | // TODO: Validate method results 82 | end; 83 | 84 | procedure TestTMQTT.TestPublishMessage; 85 | var 86 | ReturnValue: TMQTTMessage; 87 | begin 88 | //ReturnValue := FMQTT.PublishMessage; 89 | // TODO: Validate method results 90 | end; 91 | 92 | procedure TestTMQTT.TestPingReqMessage; 93 | var 94 | ReturnValue: TMQTTMessage; 95 | msgBytes: TBytes; 96 | begin 97 | //ReturnValue := FMQTT.PingReqMessage; 98 | // TODO: Validate method results 99 | ReturnValue := TMQTTMessage.Create; 100 | ReturnValue.FixedHeader.MessageType := Ord(TMQTTMessageType.PINGREQ); 101 | msgBytes := ReturnValue.ToBytes; 102 | 103 | end; 104 | 105 | procedure TestTMQTT.TestSubscribeMessage; 106 | var 107 | ReturnValue: TMQTTMessage; 108 | begin 109 | //ReturnValue := FMQTT.SubscribeMessage; 110 | // TODO: Validate method results 111 | end; 112 | 113 | procedure TestTMQTT.TestUnsubscribeMessage; 114 | var 115 | ReturnValue: TMQTTMessage; 116 | begin 117 | //ReturnValue := FMQTT.UnsubscribeMessage; 118 | // TODO: Validate method results 119 | end; 120 | 121 | procedure TestTMQTT.TestConnect; 122 | var 123 | ReturnValue: Boolean; 124 | begin 125 | //ReturnValue := FMQTT.Connect; 126 | // TODO: Validate method results 127 | end; 128 | 129 | procedure TestTMQTT.TestDisconnect; 130 | var 131 | ReturnValue: Boolean; 132 | begin 133 | //ReturnValue := FMQTT.Disconnect; 134 | // TODO: Validate method results 135 | end; 136 | 137 | procedure TestTMQTT.TestPublish; 138 | var 139 | ReturnValue: Boolean; 140 | sPayload: string; 141 | Topic: string; 142 | begin 143 | // TODO: Setup method call parameters 144 | //ReturnValue := FMQTT.Publish(Topic, sPayload); 145 | // TODO: Validate method results 146 | end; 147 | 148 | procedure TestTMQTT.TestPublish1; 149 | var 150 | ReturnValue: Boolean; 151 | Retain: Boolean; 152 | sPayload: string; 153 | Topic: string; 154 | begin 155 | // TODO: Setup method call parameters 156 | //ReturnValue := FMQTT.Publish(Topic, sPayload, Retain); 157 | // TODO: Validate method results 158 | end; 159 | 160 | procedure TestTMQTT.TestPublish2; 161 | var 162 | ReturnValue: Boolean; 163 | QoS: Integer; 164 | Retain: Boolean; 165 | sPayload: string; 166 | Topic: string; 167 | begin 168 | // TODO: Setup method call parameters 169 | //ReturnValue := FMQTT.Publish(Topic, sPayload, Retain, QoS); 170 | // TODO: Validate method results 171 | end; 172 | 173 | procedure TestTMQTT.TestSubscribe; 174 | var 175 | ReturnValue: Integer; 176 | RequestQoS: Integer; 177 | Topic: string; 178 | begin 179 | // TODO: Setup method call parameters 180 | //ReturnValue := FMQTT.Subscribe(Topic, RequestQoS); 181 | // TODO: Validate method results 182 | end; 183 | 184 | procedure TestTMQTT.TestSubscribe1; 185 | var 186 | ReturnValue: Integer; 187 | //Topics: TDictionary; 188 | begin 189 | // TODO: Setup method call parameters 190 | //ReturnValue := FMQTT.Subscribe(Topics); 191 | // TODO: Validate method results 192 | end; 193 | 194 | procedure TestTMQTT.TestUnsubscribe; 195 | var 196 | ReturnValue: Integer; 197 | Topic: string; 198 | begin 199 | // TODO: Setup method call parameters 200 | //ReturnValue := FMQTT.Unsubscribe(Topic); 201 | // TODO: Validate method results 202 | end; 203 | 204 | procedure TestTMQTT.TestUnsubscribe1; 205 | var 206 | ReturnValue: Integer; 207 | Topics: TStringList; 208 | begin 209 | // TODO: Setup method call parameters 210 | //ReturnValue := FMQTT.Unsubscribe(Topics); 211 | // TODO: Validate method results 212 | end; 213 | 214 | procedure TestTMQTT.TestPingReq; 215 | var 216 | ReturnValue: Boolean; 217 | begin 218 | //ReturnValue := FMQTT.PingReq; 219 | // TODO: Validate method results 220 | end; 221 | 222 | initialization 223 | // Register any test cases with the test runner 224 | RegisterTest(TestTMQTT.Suite); 225 | end. 226 | 227 | -------------------------------------------------------------------------------- /TMQTTTest.dproj: -------------------------------------------------------------------------------- 1 | 2 | 3 | {325199D2-21BE-4089-BB6E-63FBB9BB17D6} 4 | 13.4 5 | TMQTTTest.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 | CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= 45 | Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;Winapi;$(DCC_Namespace) 46 | 2057 47 | ..\..\Development Stuff\Delphi\Synapse;$(DCC_UnitSearchPath) 48 | TMQTTTest.exe 49 | 00400000 50 | x86 51 | false 52 | false 53 | false 54 | false 55 | false 56 | 57 | 58 | $(BDS)\bin\default_app.manifest 59 | TMQTTTest_Icon.ico 60 | 61 | 62 | $(BDS)\bin\default_app.manifest 63 | 1033 64 | true 65 | TMQTTTest_Icon.ico 66 | CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= 67 | System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) 68 | 69 | 70 | false 71 | RELEASE;$(DCC_Define) 72 | 0 73 | false 74 | 75 | 76 | 3 77 | DEBUG;madExcept;$(DCC_Define) 78 | 79 | 80 | D:\Dev\Dev Tools\Delphi\synapse\trunk 81 | true 82 | 1033 83 | 84 | 85 | 86 | MainSource 87 | 88 | 89 |
fMain
90 | 91 | 92 | 93 | 94 | 95 | Cfg_2 96 | Base 97 | 98 | 99 | Base 100 | 101 | 102 | Cfg_1 103 | Base 104 | 105 | 106 | 107 | 108 | Delphi.Personality.12 109 | 110 | 111 | 112 | 113 | False 114 | True 115 | False 116 | 117 | 118 | False 119 | False 120 | 1 121 | 0 122 | 0 123 | 0 124 | False 125 | False 126 | False 127 | False 128 | False 129 | 2057 130 | 1252 131 | 132 | 133 | 134 | 135 | 1.0.0.0 136 | 137 | 138 | 139 | 140 | 141 | 1.0.0.0 142 | 143 | 144 | 145 | TMQTTTest.dpr 146 | 147 | 148 | Microsoft Office 2000 Sample Automation Server Wrapper Components 149 | Microsoft Office XP Sample Automation Server Wrapper Components 150 | Embarcadero C++Builder Office 2000 Servers Package 151 | Embarcadero C++Builder Office XP Servers Package 152 | 153 | 154 | False 155 | 156 | False 157 | True 158 | 159 | 160 | 12 161 | 162 | 163 | 164 | -------------------------------------------------------------------------------- /Tests/TMQTTLibTests.dproj: -------------------------------------------------------------------------------- 1 | 2 | 3 | {0B0BF9D4-E894-423A-A386-0AA7F2D7C9A1} 4 | 13.4 5 | Debug 6 | DCC32 7 | TMQTTLibTests.dpr 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 | CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= 45 | Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;Winapi;$(DCC_Namespace) 46 | 2057 47 | $(BDS)\Source\DUnit\src;$(DCC_UnitSearchPath) 48 | TMQTTLibTests.exe 49 | 00400000 50 | x86 51 | _CONSOLE_TESTRUNNER;$(DCC_Define) 52 | false 53 | false 54 | false 55 | . 56 | false 57 | false 58 | 59 | 60 | $(BDS)\bin\default_app.manifest 61 | TMQTTLibTests_Icon.ico 62 | 63 | 64 | $(BDS)\bin\default_app.manifest 65 | 1033 66 | true 67 | TMQTTLibTests_Icon.ico 68 | CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= 69 | System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) 70 | 71 | 72 | false 73 | RELEASE;$(DCC_Define) 74 | 0 75 | false 76 | 77 | 78 | DEBUG;$(DCC_Define) 79 | 80 | 81 | D:\Dev\Dev Tools\Delphi\synapse\trunk;$(DCC_UnitSearchPath) 82 | true 83 | 1033 84 | 85 | 86 | 87 | MainSource 88 | 89 | 90 | 91 | 92 | 93 | 94 | 95 | 96 | Cfg_2 97 | Base 98 | 99 | 100 | Base 101 | 102 | 103 | Cfg_1 104 | Base 105 | 106 | 107 | 108 | 109 | Delphi.Personality.12 110 | 111 | 112 | 113 | 114 | False 115 | True 116 | False 117 | 118 | 119 | False 120 | False 121 | 1 122 | 0 123 | 0 124 | 0 125 | False 126 | False 127 | False 128 | False 129 | False 130 | 2057 131 | 1252 132 | 133 | 134 | 135 | 136 | 1.0.0.0 137 | 138 | 139 | 140 | 141 | 142 | 1.0.0.0 143 | 144 | 145 | 146 | TMQTTLibTests.dpr 147 | 148 | 149 | Microsoft Office 2000 Sample Automation Server Wrapper Components 150 | Microsoft Office XP Sample Automation Server Wrapper Components 151 | Embarcadero C++Builder Office 2000 Servers Package 152 | Embarcadero C++Builder Office XP Servers Package 153 | 154 | 155 | 156 | DUnit / Delphi Win32 157 | GUI 158 | 159 | 160 | False 161 | True 162 | 163 | 164 | 12 165 | 166 | 167 | 168 | -------------------------------------------------------------------------------- /TMQTT/MQTTReadThread.pas: -------------------------------------------------------------------------------- 1 | unit MQTTReadThread; 2 | 3 | interface 4 | 5 | uses 6 | Classes, 7 | SysUtils, 8 | {$IFDEF MSWINDOWS} 9 | Windows, 10 | {$ENDIF} 11 | Generics.Collections, 12 | SyncObjs, 13 | 14 | MQTTHeaders, 15 | blcksock; 16 | 17 | type 18 | PTCPBlockSocket = ^TTCPBlockSocket; 19 | 20 | TMQTTRecvUtilities = class 21 | public 22 | class function MSBLSBToInt(ALengthBytes: TBytes): integer; 23 | class function RLBytesToInt(ARlBytes: TBytes): Integer; 24 | end; 25 | 26 | TUnparsedMsg = record 27 | public 28 | FixedHeader: Byte; 29 | RL: TBytes; 30 | Data: TBytes; 31 | end; 32 | 33 | TMQTTReadThread = class(TThread) 34 | private 35 | { Private declarations } 36 | FPSocket: TTCPBlockSocket; 37 | 38 | FCSock: TCriticalSection; 39 | FCurrentMsg: TUnparsedMsg; 40 | 41 | FCurrentRecvState: TMQTTRecvState; 42 | // Events 43 | FConnAckEvent: TConnAckEvent; 44 | FPublishEvent: TPublishEvent; 45 | FPingRespEvent: TPingRespEvent; 46 | FPingReqEvent: TPingReqEvent; 47 | FSubAckEvent: TSubAckEvent; 48 | FUnSubAckEvent: TUnSubAckEvent; 49 | FPubAckEvent: TPubAckEvent; 50 | FPubRelEvent: TPubRelEvent; 51 | FPubRecEvent: TPubRecEvent; 52 | FPubCompEvent: TPubCompEvent; 53 | 54 | 55 | procedure ProcessMessage; 56 | function readSingleString(const dataStream: TBytes; const indexStartAt: Integer; var stringRead: Ansistring): integer; 57 | function readMessageId(const dataStream: TBytes; const indexStartAt: Integer; var messageId: integer): integer; 58 | function readStringWithoutPrefix(const dataStream: TBytes; 59 | const indexStartAt: Integer; var stringRead: Ansistring): integer; 60 | protected 61 | procedure CleanStart; 62 | procedure Execute; override; 63 | public 64 | constructor Create(Socket: TTCPBlockSocket; CSSock: TCriticalSection); 65 | 66 | // Event properties. 67 | property OnConnAck : TConnAckEvent read FConnAckEvent write FConnAckEvent; 68 | property OnPublish : TPublishEvent read FPublishEvent write FPublishEvent; 69 | property OnPingResp : TPingRespEvent read FPingRespEvent write FPingRespEvent; 70 | property OnPingReq : TPingRespEvent read FPingRespEvent write FPingRespEvent; 71 | property OnSubAck : TSubAckEvent read FSubAckEvent write FSubAckEvent; 72 | property OnUnSubAck : TUnSubAckEvent read FUnSubAckEvent write FUnSubAckEvent; 73 | property OnPubAck : TUnSubAckEvent read FUnSubAckEvent write FUnSubAckEvent; 74 | property OnPubRec : TUnSubAckEvent read FUnSubAckEvent write FUnSubAckEvent; 75 | property OnPubRel : TUnSubAckEvent read FUnSubAckEvent write FUnSubAckEvent; 76 | property OnPubComp : TUnSubAckEvent read FUnSubAckEvent write FUnSubAckEvent; 77 | end; 78 | 79 | implementation 80 | 81 | uses 82 | MQTT; 83 | 84 | class function TMQTTRecvUtilities.MSBLSBToInt(ALengthBytes: TBytes): integer; 85 | begin 86 | Assert(ALengthBytes <> nil, 'Must not pass nil to this method'); 87 | Assert(Length(ALengthBytes) = 2, 'The MSB-LSB 2 bytes structure must be 2 Bytes in length'); 88 | 89 | Result := 0; 90 | Result := ALengthBytes[0] shl 8; 91 | Result := Result + ALengthBytes[1]; 92 | end; 93 | 94 | class function TMQTTRecvUtilities.RLBytesToInt(ARlBytes: TBytes): Integer; 95 | var 96 | multi: integer; 97 | i: integer; 98 | digit: Byte; 99 | begin 100 | Assert(ARlBytes <> nil, 'Must not pass nil to this method'); 101 | 102 | multi := 1; 103 | i := 0; 104 | Result := 0; 105 | 106 | if ((Length(ARlBytes) > 0) and (Length(ARlBytes) <= 4)) then 107 | begin 108 | digit := ARlBytes[i]; 109 | repeat 110 | digit := ARlBytes[i]; 111 | Result := Result + (digit and 127) * multi; 112 | multi := multi * 128; 113 | Inc(i); 114 | until ((digit and 128) = 0); 115 | end; 116 | end; 117 | 118 | procedure AppendBytes(var DestArray: TBytes; 119 | const NewBytes: TBytes); 120 | var 121 | DestLen: Integer; 122 | begin 123 | if Length(NewBytes) > 0 then 124 | begin 125 | DestLen := Length(DestArray); 126 | SetLength(DestArray, DestLen + Length(NewBytes)); 127 | Move(NewBytes[0], DestArray[DestLen], Length(NewBytes)); 128 | end; 129 | end; 130 | 131 | { TMQTTReadThread } 132 | 133 | procedure TMQTTReadThread.CleanStart; 134 | begin 135 | FCurrentRecvState := TMQTTRecvState.FixedHeaderByte; 136 | end; 137 | 138 | constructor TMQTTReadThread.Create(Socket: TTCPBlockSocket; CSSock: TCriticalSection); 139 | begin 140 | inherited Create(false); 141 | 142 | FPSocket := Socket; 143 | FCSock := CSSock; 144 | FreeOnTerminate := false; 145 | 146 | CleanStart; 147 | end; 148 | 149 | procedure TMQTTReadThread.Execute; 150 | var 151 | CurrentMessage: TUnparsedMsg; 152 | RLInt: Integer; 153 | Buffer: TBytes; 154 | i: integer; 155 | begin 156 | while not Terminated do 157 | begin 158 | FCSock.Acquire; 159 | try 160 | if FPSocket.WaitingDataEx > 0 then 161 | begin 162 | case FCurrentRecvState of 163 | TMQTTRecvState.FixedHeaderByte: 164 | begin 165 | CurrentMessage.FixedHeader := 0; 166 | CurrentMessage.FixedHeader := FPSocket.RecvByte(1000); 167 | if ((FPSocket.LastError = 0) and (CurrentMessage.FixedHeader <> 0)) then FCurrentRecvState := TMQTTRecvState.RemainingLength; 168 | end; 169 | TMQTTRecvState.RemainingLength: 170 | begin 171 | RLInt := 0; 172 | 173 | SetLength(CurrentMessage.RL, 1); 174 | SetLength(Buffer, 1); 175 | CurrentMessage.RL[0] := FPSocket.RecvByte(1000); 176 | for i := 1 to 4 do 177 | begin 178 | if (( CurrentMessage.RL[i - 1] and 128) <> 0) then 179 | begin 180 | Buffer[0] := FPSocket.PeekByte(1000); 181 | AppendBytes(CurrentMessage.RL, Buffer); 182 | end else Break; 183 | end; 184 | 185 | RLInt := TMQTTRecvUtilities.RLBytesToInt(CurrentMessage.RL); 186 | 187 | if (FPSocket.LastError = 0) then FCurrentRecvState := TMQTTRecvState.Data; 188 | end; 189 | TMQTTRecvState.Data: 190 | begin 191 | if (RLInt > 0) then 192 | begin 193 | SetLength(CurrentMessage.Data, RLInt); 194 | RLInt := RLInt - FPSocket.RecvBufferEx(Pointer(CurrentMessage.Data), RLInt, 1000); 195 | end; 196 | 197 | if ((FPSocket.LastError = 0) and (RLInt = 0)) then 198 | begin 199 | FCurrentMsg := CurrentMessage; 200 | Synchronize(ProcessMessage); 201 | CurrentMessage := Default(TUnparsedMsg); 202 | FCurrentRecvState := TMQTTRecvState.FixedHeaderByte; 203 | end; 204 | end; 205 | end; // end of Recv state case 206 | end; // end of waitingdata check 207 | finally 208 | FCSock.Release; 209 | end; 210 | end; 211 | end; 212 | 213 | procedure TMQTTReadThread.ProcessMessage; 214 | var 215 | NewMsg: TUnparsedMsg; 216 | FHCode: Byte; 217 | dataCaret: integer; 218 | grantedQoS: Array of Integer; 219 | I: Integer; 220 | strTopic, strPayload: AnsiString; 221 | begin 222 | dataCaret := 0; 223 | 224 | NewMsg := FCurrentMsg; 225 | FHCode := NewMsg.FixedHeader shr 4; 226 | case FHCode of 227 | Ord(TMQTTMessageType.CONNACK): 228 | begin 229 | if Length(NewMsg.Data) > 0 then 230 | begin 231 | if Assigned(FConnAckEvent) then OnConnAck(Self, NewMsg.Data[0]); 232 | end; 233 | end; 234 | Ord(TMQTTMessageType.PINGREQ): 235 | begin 236 | if Assigned(FPingReqEvent) then OnPingReq(Self); 237 | end; 238 | Ord(TMQTTMessageType.PINGRESP): 239 | begin 240 | if Assigned(FPingRespEvent) then OnPingResp(Self); 241 | end; 242 | Ord(TMQTTMessageType.PUBLISH): 243 | begin 244 | // Todo: This only applies for QoS level 0 messages. 245 | dataCaret := 0; 246 | dataCaret := readSingleString(NewMsg.Data, dataCaret, strTopic); 247 | dataCaret := readStringWithoutPrefix(NewMsg.Data, dataCaret, strPayload); 248 | if Assigned(FPublishEvent) then OnPublish(Self, strTopic, strPayload); 249 | end; 250 | Ord(TMQTTMessageType.SUBACK): 251 | begin 252 | if (Length(NewMsg.Data) > 2) then 253 | begin 254 | SetLength(grantedQoS, Length(NewMsg.Data) - 2); 255 | for I := 0 to Length(NewMsg.Data) - 1 do 256 | begin 257 | grantedQoS[i] := NewMsg.Data[i + 2]; 258 | end; 259 | if Assigned(FSubAckEvent) then OnSubAck(Self, TMQTTRecvUtilities.MSBLSBToInt(Copy(NewMsg.Data, 0, 2)), grantedQoS); 260 | end; 261 | end; 262 | Ord(TMQTTMessageType.UNSUBACK): 263 | begin 264 | if Length(NewMsg.Data) = 2 then 265 | begin 266 | if Assigned(FUnSubAckEvent) then OnUnSubAck(Self, TMQTTRecvUtilities.MSBLSBToInt(NewMsg.Data)) 267 | end; 268 | end; 269 | Ord(TMQTTMessageType.PUBREC): 270 | begin 271 | if Length(NewMsg.Data) = 2 then 272 | begin 273 | if Assigned(FPubRecEvent) then OnPubRec(Self, TMQTTRecvUtilities.MSBLSBToInt(NewMsg.Data)) 274 | end; 275 | end; 276 | Ord(TMQTTMessageType.PUBREL): 277 | begin 278 | if Length(NewMsg.Data) = 2 then 279 | begin 280 | if Assigned(FPubRelEvent) then OnPubRel(Self, TMQTTRecvUtilities.MSBLSBToInt(NewMsg.Data)) 281 | end; 282 | end; 283 | Ord(TMQTTMessageType.PUBACK): 284 | begin 285 | if Length(NewMsg.Data) = 2 then 286 | begin 287 | if Assigned(FPubAckEvent) then OnPubAck(Self, TMQTTRecvUtilities.MSBLSBToInt(NewMsg.Data)) 288 | end; 289 | end; 290 | Ord(TMQTTMessageType.PUBCOMP): 291 | begin 292 | if Length(NewMsg.Data) = 2 then 293 | begin 294 | if Assigned(FPubCompEvent) then OnPubComp(Self, TMQTTRecvUtilities.MSBLSBToInt(NewMsg.Data)) 295 | end; 296 | end; 297 | end; 298 | 299 | end; 300 | 301 | function TMQTTReadThread.readMessageId(const dataStream: TBytes; 302 | const indexStartAt: Integer; var messageId: integer): integer; 303 | begin 304 | messageId := TMQTTRecvUtilities.MSBLSBToInt(Copy(dataStream, indexStartAt, 2)); 305 | Result := indexStartAt + 2; 306 | end; 307 | 308 | function TMQTTReadThread.readStringWithoutPrefix(const dataStream: TBytes; 309 | const indexStartAt: Integer; var stringRead: Ansistring): integer; 310 | var 311 | strLength: integer; 312 | begin 313 | strLength := Length(dataStream) - (indexStartAt + 1); 314 | if strLength > 0 then 315 | begin 316 | SetString(stringRead, PAnsiChar(@dataStream[indexStartAt + 2]), (strLength -1) ); 317 | end; 318 | Result := indexStartAt + strLength; 319 | end; 320 | 321 | function TMQTTReadThread.readSingleString(const dataStream: TBytes; 322 | const indexStartAt: Integer; var stringRead: Ansistring): integer; 323 | var 324 | strLength: integer; 325 | begin 326 | strLength := TMQTTRecvUtilities.MSBLSBToInt(Copy(dataStream, indexStartAt, 2)); 327 | if strLength > 0 then 328 | begin 329 | SetString(stringRead, PAnsiChar(@dataStream[indexStartAt + 2]), strLength); 330 | end; 331 | Result := indexStartAt + strLength; 332 | end; 333 | 334 | end. 335 | -------------------------------------------------------------------------------- /Tests/TestMQTTHeaders.pas: -------------------------------------------------------------------------------- 1 | unit TestMQTTHeaders; 2 | { 3 | 4 | Delphi DUnit Test Case 5 | ---------------------- 6 | This unit contains a skeleton test case class generated by the Test Case Wizard. 7 | Modify the generated code to correctly setup and call the methods from the unit 8 | being tested. 9 | 10 | } 11 | 12 | interface 13 | 14 | uses 15 | TestFramework, Classes, Types, MQTTHeaders, SysUtils; 16 | 17 | type 18 | // Test methods for class TMQTTFixedHeader 19 | 20 | TestTMQTTFixedHeader = class(TTestCase) 21 | strict private 22 | FMQTTFixedHeader: TMQTTFixedHeader; 23 | public 24 | procedure SetUp; override; 25 | procedure TearDown; override; 26 | published 27 | procedure TestToByte; 28 | procedure TestToByteStr; 29 | procedure TestMessageTypes; 30 | end; 31 | 32 | // Test methods for RL Methods 33 | 34 | TestUtilityMethods = class(TTestCase) 35 | strict private 36 | 37 | public 38 | procedure SetUp; override; 39 | procedure TearDown; override; 40 | published 41 | procedure TestToRLToBytes; 42 | procedure TestUTF8EncodeToBytes; 43 | procedure TestIntToMSBLSB; 44 | end; 45 | 46 | // Test methods for class TMQTTConnectVarHeader 47 | 48 | TestTMQTTConnectVarHeader = class(TTestCase) 49 | strict private 50 | FMQTTConnectVarHeader: TMQTTConnectVarHeader; 51 | public 52 | procedure SetUp; override; 53 | procedure TearDown; override; 54 | published 55 | procedure TestToBytes; 56 | procedure TestVersionStrings; 57 | procedure TestKeepAliveOnCreation; 58 | end; 59 | // Test methods for class TMQTTPublishVarHeader 60 | 61 | TestTMQTTPublishVarHeader = class(TTestCase) 62 | strict private 63 | FMQTTPublishVarHeader: TMQTTPublishVarHeader; 64 | public 65 | procedure SetUp; override; 66 | procedure TearDown; override; 67 | published 68 | procedure TestToBytes; 69 | end; 70 | // Test methods for class TMQTTSubscribeVarHeader 71 | 72 | TestTMQTTSubscribeVarHeader = class(TTestCase) 73 | strict private 74 | FMQTTSubscribeVarHeader: TMQTTSubscribeVarHeader; 75 | public 76 | procedure SetUp; override; 77 | procedure TearDown; override; 78 | published 79 | procedure TestToBytes; 80 | end; 81 | // Test methods for class TMQTTUnsubscribeVarHeader 82 | 83 | TestTMQTTUnsubscribeVarHeader = class(TTestCase) 84 | strict private 85 | FMQTTUnsubscribeVarHeader: TMQTTUnsubscribeVarHeader; 86 | public 87 | procedure SetUp; override; 88 | procedure TearDown; override; 89 | published 90 | procedure TestToBytes; 91 | end; 92 | // Test methods for class TMQTTPayload 93 | 94 | TestTMQTTPayload = class(TTestCase) 95 | strict private 96 | FMQTTPayload: TMQTTPayload; 97 | public 98 | procedure SetUp; override; 99 | procedure TearDown; override; 100 | published 101 | procedure TestToBytes; 102 | end; 103 | // Test methods for class TMQTTMessage 104 | 105 | TestTMQTTMessage = class(TTestCase) 106 | strict private 107 | FMQTTMessage: TMQTTMessage; 108 | public 109 | procedure SetUp; override; 110 | procedure TearDown; override; 111 | published 112 | procedure TestToBytes; 113 | procedure TestToBytesPublish; 114 | end; 115 | 116 | implementation 117 | 118 | function IntToBin ( value: LongInt; digits: integer ): string; 119 | begin 120 | result := StringOfChar ( '0', digits ) ; 121 | while value > 0 do begin 122 | if ( value and 1 ) = 1 then 123 | result [ digits ] := '1'; 124 | dec ( digits ) ; 125 | value := value shr 1; 126 | end; 127 | end; 128 | 129 | procedure TestTMQTTConnectVarHeader.SetUp; 130 | begin 131 | FMQTTConnectVarHeader := TMQTTConnectVarHeader.Create; 132 | end; 133 | 134 | procedure TestTMQTTConnectVarHeader.TearDown; 135 | begin 136 | FMQTTConnectVarHeader.Free; 137 | FMQTTConnectVarHeader := nil; 138 | end; 139 | 140 | procedure TestTMQTTConnectVarHeader.TestKeepAliveOnCreation; 141 | var 142 | ConnectVar: TMQTTConnectVarHeader; 143 | begin 144 | ConnectVar := TMQTTConnectVarHeader.Create(10); 145 | Assert( ConnectVar.KeepAlive = 10, 'Keep Alive assigned' ); 146 | ConnectVar.Free; 147 | end; 148 | 149 | procedure TestTMQTTConnectVarHeader.TestToBytes; 150 | var 151 | ReturnValue: TBytes; 152 | i: integer; 153 | begin 154 | FMQTTConnectVarHeader.KeepAlive := 10; 155 | FMQTTConnectVarHeader.CleanStart := 1; 156 | FMQTTConnectVarHeader.WillFlag := 1; 157 | FMQTTConnectVarHeader.QoSLevel := 0; 158 | FMQTTConnectVarHeader.Retain := 0; 159 | //FMQTTConnectVarHeader. 160 | ReturnValue := FMQTTConnectVarHeader.ToBytes; 161 | Assert( Length(ReturnValue) = 12 , 'Length of Connect Variable Header' ); 162 | Assert( ReturnValue[0] = 0, 'Length of version string' ); 163 | Assert( ReturnValue[1] = Length(FMQTTConnectVarHeader.PROTOCOL_ID), 'Length of version string' ); 164 | for I := 1 to Length(FMQTTConnectVarHeader.PROTOCOL_ID) do 165 | begin 166 | Assert( Chr(ReturnValue[i + 1]) = FMQTTConnectVarHeader.PROTOCOL_ID[i], 'Version String, expected: ' + FMQTTConnectVarHeader.PROTOCOL_ID[i] + ' got:' + Chr(ReturnValue[1 + i]) ); 167 | end; 168 | // Todo: Finish the rest of this. 169 | end; 170 | 171 | procedure TestTMQTTConnectVarHeader.TestVersionStrings; 172 | begin 173 | Assert( FMQTTConnectVarHeader.PROTOCOL_ID = 'MQIsdp', 'Version String = MQIsdp' ); 174 | Assert( FMQTTConnectVarHeader.PROTOCOL_VER = 3, 'Version 3 of the Protocol' ); 175 | end; 176 | 177 | procedure TestTMQTTPublishVarHeader.SetUp; 178 | begin 179 | FMQTTPublishVarHeader := TMQTTPublishVarHeader.Create; 180 | end; 181 | 182 | procedure TestTMQTTPublishVarHeader.TearDown; 183 | begin 184 | FMQTTPublishVarHeader.Free; 185 | FMQTTPublishVarHeader := nil; 186 | end; 187 | 188 | procedure TestTMQTTPublishVarHeader.TestToBytes; 189 | var 190 | ReturnValue: TBytes; 191 | begin 192 | ReturnValue := FMQTTPublishVarHeader.ToBytes; 193 | // TODO: Validate method results 194 | end; 195 | 196 | procedure TestTMQTTSubscribeVarHeader.SetUp; 197 | begin 198 | FMQTTSubscribeVarHeader := TMQTTSubscribeVarHeader.Create; 199 | end; 200 | 201 | procedure TestTMQTTSubscribeVarHeader.TearDown; 202 | begin 203 | FMQTTSubscribeVarHeader.Free; 204 | FMQTTSubscribeVarHeader := nil; 205 | end; 206 | 207 | procedure TestTMQTTSubscribeVarHeader.TestToBytes; 208 | var 209 | ReturnValue: TBytes; 210 | begin 211 | ReturnValue := FMQTTSubscribeVarHeader.ToBytes; 212 | // TODO: Validate method results 213 | end; 214 | 215 | procedure TestTMQTTUnsubscribeVarHeader.SetUp; 216 | begin 217 | FMQTTUnsubscribeVarHeader := TMQTTUnsubscribeVarHeader.Create; 218 | end; 219 | 220 | procedure TestTMQTTUnsubscribeVarHeader.TearDown; 221 | begin 222 | FMQTTUnsubscribeVarHeader.Free; 223 | FMQTTUnsubscribeVarHeader := nil; 224 | end; 225 | 226 | procedure TestTMQTTUnsubscribeVarHeader.TestToBytes; 227 | var 228 | ReturnValue: TBytes; 229 | begin 230 | ReturnValue := FMQTTUnsubscribeVarHeader.ToBytes; 231 | // TODO: Validate method results 232 | end; 233 | 234 | procedure TestTMQTTPayload.SetUp; 235 | begin 236 | FMQTTPayload := TMQTTPayload.Create; 237 | end; 238 | 239 | procedure TestTMQTTPayload.TearDown; 240 | begin 241 | FMQTTPayload.Free; 242 | FMQTTPayload := nil; 243 | end; 244 | 245 | procedure TestTMQTTPayload.TestToBytes; 246 | var 247 | ReturnValue: TBytes; 248 | begin 249 | FMQTTPayload.Contents.Add('test'); 250 | ReturnValue := FMQTTPayload.ToBytes; 251 | Assert( ReturnValue[0] = 0, 'Length Bytes' ); 252 | Assert( ReturnValue[1] = 4, 'Length Bytes' ); 253 | Assert( Chr(ReturnValue[2]) = 't', 'test String' ); 254 | Assert( Chr(ReturnValue[3]) = 'e', 'test String' ); 255 | Assert( Chr(ReturnValue[4]) = 's', 'test String' ); 256 | Assert( Chr(ReturnValue[5]) = 't', 'test String' ); 257 | FMQTTPayload.Contents.Add('again'); 258 | ReturnValue := FMQTTPayload.ToBytes; 259 | Assert( ReturnValue[6] = 0, 'Length Bytes' ); 260 | Assert( ReturnValue[7] = 5, 'Length Bytes, Actual Value' + IntToStr(ReturnValue[7]) ); 261 | Assert( Chr(ReturnValue[8]) = 'a', 'again String' ); 262 | Assert( Chr(ReturnValue[9]) = 'g', 'again String' ); 263 | Assert( Chr(ReturnValue[10]) = 'a', 'again String' ); 264 | Assert( Chr(ReturnValue[11]) = 'i', 'again String' ); 265 | Assert( Chr(ReturnValue[12]) = 'n', 'again String' ); 266 | end; 267 | 268 | procedure TestTMQTTMessage.SetUp; 269 | begin 270 | FMQTTMessage := TMQTTMessage.Create; 271 | end; 272 | 273 | procedure TestTMQTTMessage.TearDown; 274 | begin 275 | FMQTTMessage.Free; 276 | FMQTTMessage := nil; 277 | end; 278 | 279 | procedure TestTMQTTMessage.TestToBytes; 280 | var 281 | ReturnValue: TBytes; 282 | FH: TMQTTFixedHeader; 283 | VH: TMQTTConnectVarHeader; 284 | PL: TMQTTPayload; 285 | begin 286 | FH.MessageType := Ord(TMQTTMessageType.CONNECT); 287 | FMQTTMessage.FixedHeader := FH; 288 | VH := TMQTTConnectVarHeader.Create(10); 289 | VH.CleanStart := 1; 290 | VH.WillFlag := 1; 291 | VH.QoSLevel := 1; 292 | FMQTTMessage.VariableHeader := VH; 293 | PL := TMQTTPayload.Create; 294 | PL.Contents.Add('/test'); 295 | PL.Contents.Add('broker died!'); 296 | FMQTTMessage.Payload := PL; 297 | 298 | ReturnValue := FMQTTMessage.ToBytes; 299 | // TODO: Validate the whole message end to end. 300 | Assert( ReturnValue[0] = 16, 'Connect Flag' ); 301 | Assert( ReturnValue[1] = 33, 'Remaining Length Bytes' + IntToStr(ReturnValue[1]) ); //12 + 20 302 | Assert( ReturnValue[2] = 0, 'VString L' ); 303 | Assert( ReturnValue[3] = Length(TMQTTConnectVarHeader.PROTOCOL_ID), 'Variable Length' ); 304 | //Assert( Chr(ReturnValue[2]) = 't', 'test String' ); 305 | //Assert( Chr(ReturnValue[3]) = 'e', 'test String' ); 306 | //Assert( Chr(ReturnValue[4]) = 's', 'test String' ); 307 | //Assert( Chr(ReturnValue[5]) = 't', 'test String' ); 308 | end; 309 | 310 | procedure TestTMQTTMessage.TestToBytesPublish; 311 | var 312 | ReturnValue: TBytes; 313 | FH: TMQTTFixedHeader; 314 | VH: TMQTTPublishVarHeader; 315 | PL: TMQTTPayload; 316 | begin 317 | FH.MessageType := Ord(TMQTTMessageType.PUBLISH); 318 | FMQTTMessage.FixedHeader := FH; 319 | VH := TMQTTPublishVarHeader.Create(0); 320 | VH.Topic := '/dev/test'; 321 | FMQTTMessage.VariableHeader := VH; 322 | PL := TMQTTPayload.Create; 323 | PL.Contents.Add('this is a test!'); 324 | FMQTTMessage.Payload := PL; 325 | 326 | ReturnValue := FMQTTMessage.ToBytes; 327 | // TODO: Validate the whole message end to end. 328 | Assert( ReturnValue[0] = 48, 'Publish Flag' ); 329 | Assert( ReturnValue[1] = 28, 'Remaining Length Bytes: ' + IntToStr(ReturnValue[1]) ); //12 + 20 330 | Assert( ReturnValue[2] = 0, 'String Low:' ); 331 | Assert( ReturnValue[3] = 9, 'String High:' + IntToStr(ReturnValue[3])); 332 | Assert( ReturnValue[13] = 0, 'String Low:' ); 333 | Assert( ReturnValue[14] = 15, 'String High:' + IntToStr(ReturnValue[14])); 334 | Assert( Chr(ReturnValue[15]) = 't', 'test String' ); 335 | Assert( Chr(ReturnValue[16]) = 'h', 'test String' ); 336 | Assert( Chr(ReturnValue[17]) = 'i', 'test String' ); 337 | Assert( Chr(ReturnValue[18]) = 's', 'test String' ); 338 | end; 339 | 340 | { TestTMQTTFixedHeader } 341 | 342 | procedure TestTMQTTFixedHeader.SetUp; 343 | begin 344 | inherited; 345 | FMQTTFixedHeader.MessageType := Ord(TMQTTMessageType.CONNECT); 346 | FMQTTFixedHeader.Retain := 0; 347 | FMQTTFixedHeader.QoSLevel := 0; 348 | FMQTTFixedHeader.Duplicate := 0; 349 | end; 350 | 351 | procedure TestTMQTTFixedHeader.TearDown; 352 | begin 353 | inherited; 354 | 355 | end; 356 | 357 | procedure TestTMQTTFixedHeader.TestMessageTypes; 358 | begin 359 | FMQTTFixedHeader.MessageType := Ord(TMQTTMessageType.CONNECT); 360 | Assert( FMQTTFixedHeader.Flags = 16, 'Fixed Header - Connect' ); 361 | FMQTTFixedHeader.MessageType := Ord(TMQTTMessageType.CONNACK); 362 | Assert( FMQTTFixedHeader.Flags = 32, 'Fixed Header - ConAck' ); 363 | FMQTTFixedHeader.MessageType := Ord(TMQTTMessageType.PUBLISH); 364 | Assert( FMQTTFixedHeader.Flags = 48, 'Fixed Header - Publish' ); 365 | FMQTTFixedHeader.MessageType := Ord(TMQTTMessageType.PUBACK); 366 | Assert( FMQTTFixedHeader.Flags = 64, 'Fixed Header - PubAck' ); 367 | FMQTTFixedHeader.MessageType := Ord(TMQTTMessageType.PUBREC); 368 | Assert( FMQTTFixedHeader.Flags = 80, 'Fixed Header - PubRec' ); 369 | FMQTTFixedHeader.MessageType := Ord(TMQTTMessageType.PUBREL); 370 | Assert( FMQTTFixedHeader.Flags = 96, 'Fixed Header - PubRel' ); 371 | FMQTTFixedHeader.MessageType := Ord(TMQTTMessageType.PUBCOMP); 372 | Assert( FMQTTFixedHeader.Flags = 112, 'Fixed Header - PubComp' ); 373 | FMQTTFixedHeader.MessageType := Ord(TMQTTMessageType.SUBSCRIBE); 374 | Assert( FMQTTFixedHeader.Flags = 128, 'Fixed Header - Subscribe' ); 375 | FMQTTFixedHeader.MessageType := Ord(TMQTTMessageType.SUBACK); 376 | Assert( FMQTTFixedHeader.Flags = 144, 'Fixed Header - Sub Ack' ); 377 | FMQTTFixedHeader.MessageType := Ord(TMQTTMessageType.UNSUBSCRIBE); 378 | Assert( FMQTTFixedHeader.Flags = 160, 'Fixed Header - Unsubscribe' ); 379 | FMQTTFixedHeader.MessageType := Ord(TMQTTMessageType.UNSUBACK); 380 | Assert( FMQTTFixedHeader.Flags = 176, 'Fixed Header - Unsubscribe Ack' ); 381 | FMQTTFixedHeader.MessageType := Ord(TMQTTMessageType.PINGREQ); 382 | Assert( FMQTTFixedHeader.Flags = 192, 'Fixed Header - Ping Req' ); 383 | FMQTTFixedHeader.MessageType := Ord(TMQTTMessageType.PINGRESP); 384 | Assert( FMQTTFixedHeader.Flags = 208, 'Fixed Header - Ping Resp' ); 385 | FMQTTFixedHeader.MessageType := Ord(TMQTTMessageType.DISCONNECT); 386 | Assert( FMQTTFixedHeader.Flags = 224, 'Fixed Header - Disconnect' ); 387 | end; 388 | 389 | procedure TestTMQTTFixedHeader.TestToByte; 390 | var 391 | byteValue: Word; 392 | begin 393 | byteValue := FMQTTFixedHeader.Flags; 394 | Assert( byteValue = 16, 'Fixed Header Flags' ); 395 | end; 396 | 397 | procedure TestTMQTTFixedHeader.TestToByteStr; 398 | var 399 | byteValue: Word; 400 | str: string; 401 | begin 402 | byteValue := FMQTTFixedHeader.Flags; 403 | str := IntToBin(byteValue, 8); 404 | Assert( str = '00010000', 'Fixed Header Flags' ); 405 | end; 406 | 407 | { TestRLMethods } 408 | 409 | procedure TestUtilityMethods.SetUp; 410 | begin 411 | inherited; 412 | 413 | end; 414 | 415 | 416 | procedure TestUtilityMethods.TearDown; 417 | begin 418 | inherited; 419 | 420 | end; 421 | 422 | procedure TestUtilityMethods.TestIntToMSBLSB; 423 | var 424 | LengthBytes: TBytes; 425 | begin 426 | LengthBytes := TMQTTUtilities.IntToMSBLSB(4); 427 | Assert( LengthBytes[0] = 0, 'Zero' ); 428 | Assert( LengthBytes[1] = 4, 'Size' ); 429 | LengthBytes := TMQTTUtilities.IntToMSBLSB(8); 430 | Assert( LengthBytes[0] = 0, 'Zero' ); 431 | Assert( LengthBytes[1] = 8, 'Size' ); 432 | LengthBytes := TMQTTUtilities.IntToMSBLSB(20); 433 | Assert( LengthBytes[0] = 0, 'Zero' ); 434 | Assert( LengthBytes[1] = 20, 'Size' ); 435 | end; 436 | 437 | procedure TestUtilityMethods.TestToRLToBytes; 438 | var 439 | RLBytes: TBytes; 440 | begin 441 | RLBytes := TMQTTUtilities.RLIntToBytes(0); 442 | Assert( Length(RLBytes) = 1, 'Correct number of Bytes' ); 443 | Assert( RLBytes[0] = 0, 'Correct Value in byte 0' ); 444 | RLBytes := TMQTTUtilities.RLIntToBytes(126); 445 | Assert( Length(RLBytes) = 1, 'Correct number of Bytes' ); 446 | Assert( RLBytes[0] = 126, 'Correct Value in byte 0' ); 447 | RLBytes := TMQTTUtilities.RLIntToBytes(128); 448 | Assert( Length(RLBytes) = 2, 'Correct number of Bytes' ); 449 | Assert( RLBytes[0] = 128, 'Correct Value in byte 0' ); 450 | Assert( RLBytes[1] = 1, 'Correct Value in byte 1' ); 451 | RLBytes := TMQTTUtilities.RLIntToBytes(16383); 452 | Assert( Length(RLBytes) = 2, 'Correct number of Bytes' ); 453 | Assert( RLBytes[0] = 255, 'Correct Value in byte 0' ); 454 | Assert( RLBytes[1] = 127, 'Correct Value in byte 1' ); 455 | RLBytes := TMQTTUtilities.RLIntToBytes(16384); 456 | Assert( Length(RLBytes) = 3, 'Correct number of Bytes' ); 457 | Assert( RLBytes[0] = 128, 'Correct Value in byte 0' ); 458 | Assert( RLBytes[1] = 128, 'Correct Value in byte 1' ); 459 | Assert( RLBytes[2] = 1, 'Correct Value in byte 2' ); 460 | RLBytes := TMQTTUtilities.RLIntToBytes(268435455); 461 | Assert( Length(RLBytes) = 4, 'Correct number of Bytes' ); 462 | Assert( RLBytes[0] = 255, 'Correct Value in byte 0' ); 463 | Assert( RLBytes[1] = 255, 'Correct Value in byte 1' ); 464 | Assert( RLBytes[2] = 255, 'Correct Value in byte 2' ); 465 | Assert( RLBytes[3] = 127, 'Correct Value in byte 3' ); 466 | end; 467 | 468 | procedure TestUtilityMethods.TestUTF8EncodeToBytes; 469 | var 470 | str: TBytes; 471 | testStr: string; 472 | testStringSets: Array of string; 473 | i: integer; 474 | begin 475 | SetLength(testStringSets, 3); 476 | testStringSets[0] := 'test'; 477 | testStringSets[1] := 'test'; 478 | testStringSets[2] := 'test'; 479 | 480 | for testStr in testStringSets do 481 | begin 482 | str := TMQTTUtilities.UTF8EncodeToBytes(testStr); 483 | Assert( Length(str) = Length(testStr) + 2, 'Length of UTF8 Bytes' ); 484 | Assert( str[0] = 0, 'Correct Length Value in byte 0' ); 485 | Assert( str[1] = Length(testStr), 'Correct Length Value in byte 1' ); 486 | for I := 2 to Length(str) do 487 | begin 488 | Assert( testStr[i - 1] = Chr(str[i]), 'Correct String, Expected: ' + testStr[i - 1] + ' Got: ' + Chr(str[i])); 489 | end; 490 | end; 491 | end; 492 | 493 | initialization 494 | // Register any test cases with the test runner 495 | RegisterTest(TestTMQTTFixedHeader.Suite); 496 | RegisterTest(TestUtilityMethods.Suite); 497 | RegisterTest(TestTMQTTConnectVarHeader.Suite); 498 | RegisterTest(TestTMQTTPublishVarHeader.Suite); 499 | RegisterTest(TestTMQTTSubscribeVarHeader.Suite); 500 | RegisterTest(TestTMQTTUnsubscribeVarHeader.Suite); 501 | RegisterTest(TestTMQTTPayload.Suite); 502 | RegisterTest(TestTMQTTMessage.Suite); 503 | end. 504 | 505 | -------------------------------------------------------------------------------- /TMQTT/MQTT.pas: -------------------------------------------------------------------------------- 1 | unit MQTT; 2 | 3 | interface 4 | 5 | uses 6 | SysUtils, 7 | Types, 8 | Classes, 9 | ExtCtrls, 10 | Generics.Collections, 11 | SyncObjs, 12 | 13 | blcksock, 14 | 15 | MQTTHeaders, 16 | MQTTReadThread; 17 | 18 | type 19 | {$IF not declared(TBytes)} 20 | TBytes = array of Byte; 21 | {$IFEND} 22 | 23 | TMQTT = class 24 | private 25 | { Private Declarations } 26 | FClientID: AnsiString; 27 | FHostname: string; 28 | FPort: Integer; 29 | FMessageID: Integer; 30 | FisConnected: boolean; 31 | FRecvThread: TMQTTReadThread; 32 | FCSSock: TCriticalSection; 33 | 34 | FWillMsg: AnsiString; 35 | FWillTopic: AnsiString; 36 | FUsername: AnsiString; 37 | FPassword: AnsiString; 38 | 39 | FSocket: TTCPBlockSocket; 40 | FKeepAliveTimer: TTimer; 41 | 42 | // Event Fields 43 | FConnAckEvent: TConnAckEvent; 44 | FPublishEvent: TPublishEvent; 45 | FPingRespEvent: TPingRespEvent; 46 | FPingReqEvent: TPingReqEvent; 47 | FSubAckEvent: TSubAckEvent; 48 | FUnSubAckEvent: TUnSubAckEvent; 49 | FPubAckEvent: TPubAckEvent; 50 | FPubRelEvent: TPubRelEvent; 51 | FPubRecEvent: TPubRecEvent; 52 | FPubCompEvent: TPubCompEvent; 53 | 54 | function WriteData(AData: TBytes): boolean; 55 | function hasWill: boolean; 56 | function getNextMessageId: integer; 57 | function createAndResumeRecvThread(Socket: TTCPBlockSocket): boolean; 58 | 59 | // TMQTTMessage Factory Methods. 60 | function ConnectMessage: TMQTTMessage; 61 | function DisconnectMessage: TMQTTMessage; 62 | function PublishMessage: TMQTTMessage; 63 | function PingReqMessage: TMQTTMessage; 64 | function SubscribeMessage: TMQTTMessage; 65 | function UnsubscribeMessage: TMQTTMessage; 66 | 67 | // Our Keep Alive Ping Timer Event 68 | procedure KeepAliveTimer_Event(sender: TObject); 69 | 70 | // Recv Thread Event Handling Procedures. 71 | procedure GotConnAck(Sender: TObject; ReturnCode: integer); 72 | procedure GotPingResp(Sender: TObject); 73 | procedure GotSubAck(Sender: TObject; MessageID: integer; GrantedQoS: Array of integer); 74 | procedure GotUnSubAck(Sender: TObject; MessageID: integer); 75 | procedure GotPub(Sender: TObject; topic, payload: Ansistring); 76 | procedure GotPubAck(Sender: TObject; MessageID: integer); 77 | procedure GotPubRec(Sender: TObject; MessageID: integer); 78 | procedure GotPubRel(Sender: TObject; MessageID: integer); 79 | procedure GotPubComp(Sender: TObject; MessageID: integer); 80 | 81 | public 82 | { Public Declarations } 83 | 84 | function Connect: boolean; 85 | function Disconnect: boolean; 86 | function Publish(Topic: Ansistring; sPayload: Ansistring): boolean; overload; 87 | function Publish(Topic: Ansistring; sPayload: Ansistring; Retain: boolean): boolean; overload; 88 | function Publish(Topic: Ansistring; sPayload: Ansistring; Retain: boolean; QoS: integer): boolean; overload; 89 | function Subscribe(Topic: Ansistring; RequestQoS: integer): integer; overload; 90 | function Subscribe(Topics: TDictionary): integer; overload; 91 | function Unsubscribe(Topic: Ansistring): integer; overload ; 92 | function Unsubscribe(Topics: TStringList): integer; overload; 93 | function PingReq: boolean; 94 | constructor Create(hostName: string; port: integer); 95 | destructor Destroy; override; 96 | 97 | property WillTopic: AnsiString read FWillTopic write FWillTopic; 98 | property WillMsg: AnsiString read FWillMsg write FWillMsg; 99 | 100 | property Username: AnsiString read FUsername write FUsername; 101 | property Password: AnsiString read FPassword write FPassword; 102 | // Client ID is our Client Identifier. 103 | property ClientID : AnsiString read FClientID write FClientID; 104 | property isConnected: boolean read FisConnected; 105 | 106 | // Event Handlers 107 | property OnConnAck : TConnAckEvent read FConnAckEvent write FConnAckEvent; 108 | property OnPublish : TPublishEvent read FPublishEvent write FPublishEvent; 109 | property OnPingResp : TPingRespEvent read FPingRespEvent write FPingRespEvent; 110 | property OnPingReq : TPingRespEvent read FPingRespEvent write FPingRespEvent; 111 | property OnSubAck : TSubAckEvent read FSubAckEvent write FSubAckEvent; 112 | property OnUnSubAck : TUnSubAckEvent read FUnSubAckEvent write FUnSubAckEvent; 113 | property OnPubAck : TUnSubAckEvent read FUnSubAckEvent write FUnSubAckEvent; 114 | property OnPubRec : TUnSubAckEvent read FUnSubAckEvent write FUnSubAckEvent; 115 | property OnPubRel : TUnSubAckEvent read FUnSubAckEvent write FUnSubAckEvent; 116 | property OnPubComp : TUnSubAckEvent read FUnSubAckEvent write FUnSubAckEvent; 117 | end; 118 | 119 | implementation 120 | 121 | 122 | { TMQTTClient } 123 | 124 | procedure TMQTT.GotConnAck(Sender: TObject; ReturnCode: integer); 125 | begin 126 | if Assigned(FConnAckEvent) then OnConnAck(Self, ReturnCode); 127 | end; 128 | 129 | function TMQTT.Connect: boolean; 130 | var 131 | Msg: TMQTTMessage; 132 | begin 133 | // Create socket and connect. 134 | FSocket := TTCPBlockSocket.Create; 135 | try 136 | FSocket.Connect(Self.FHostname, IntToStr(Self.FPort)); 137 | FisConnected := true; 138 | except 139 | // If we encounter an exception upon connection then reraise it, free the socket 140 | // and reset our isConnected flag. 141 | on E: Exception do 142 | begin 143 | raise; 144 | FisConnected := false; 145 | FSocket.Free; 146 | end; 147 | end; 148 | 149 | if FisConnected then 150 | begin 151 | Msg := ConnectMessage; 152 | try 153 | Msg.Payload.Contents.Add(Self.FClientID); 154 | (Msg.VariableHeader as TMQTTConnectVarHeader).WillFlag := ord(hasWill); 155 | if hasWill then 156 | begin 157 | Msg.Payload.Contents.Add(Self.FWillTopic); 158 | Msg.Payload.Contents.Add(Self.FWillMsg); 159 | end; 160 | 161 | if ((Length(FUsername) > 1) and (Length(FPassword) > 1)) then 162 | begin 163 | Msg.Payload.Contents.Add(FUsername); 164 | Msg.Payload.Contents.Add(FPassword); 165 | end; 166 | 167 | 168 | if WriteData(Msg.ToBytes) then Result := true else Result := false; 169 | // Start our Receive thread. 170 | if (Result and createAndResumeRecvThread(FSocket)) then 171 | begin 172 | // Use the KeepAlive that we just sent to determine our ping timer. 173 | FKeepAliveTimer.Interval := (Round((Msg.VariableHeader as TMQTTConnectVarHeader).KeepAlive * 0.80)) * 1000; 174 | FKeepAliveTimer.Enabled := true; 175 | end; 176 | 177 | finally 178 | Msg.Free; 179 | end; 180 | end; 181 | end; 182 | 183 | function TMQTT.ConnectMessage: TMQTTMessage; 184 | begin 185 | Result := TMQTTMessage.Create; 186 | Result.VariableHeader := TMQTTConnectVarHeader.Create; 187 | Result.Payload := TMQTTPayload.Create; 188 | Result.FixedHeader.MessageType := Ord(TMQTTMessageType.CONNECT); 189 | Result.FixedHeader.Retain := 0; 190 | Result.FixedHeader.QoSLevel := 0; 191 | Result.FixedHeader.Duplicate := 0; 192 | end; 193 | 194 | constructor TMQTT.Create(hostName: string; port: integer); 195 | begin 196 | inherited Create; 197 | 198 | Self.FisConnected := false; 199 | Self.FHostname := Hostname; 200 | Self.FPort := Port; 201 | Self.FMessageID := 1; 202 | // Randomise and create a random client id. 203 | Randomize; 204 | Self.FClientID := 'TMQTT' + IntToStr(Random(1000) + 1); 205 | FCSSock := TCriticalSection.Create; 206 | 207 | // Create the timer responsible for pinging. 208 | FKeepAliveTimer := TTimer.Create(nil); 209 | FKeepAliveTimer.Enabled := false; 210 | FKeepAliveTimer.OnTimer := KeepAliveTimer_Event; 211 | end; 212 | 213 | function TMQTT.createAndResumeRecvThread(Socket: TTCPBlockSocket): boolean; 214 | begin 215 | Result := false; 216 | try 217 | FRecvThread := TMQTTReadThread.Create(Socket, FCSSock); 218 | 219 | { Todo: Assign Event Handlers here. } 220 | FRecvThread.OnConnAck := Self.GotConnAck; 221 | FRecvThread.OnPublish := Self.GotPub; 222 | FRecvThread.OnPingResp := Self.GotPingResp; 223 | FRecvThread.OnSubAck := Self.GotSubAck; 224 | FRecvThread.OnPubAck := Self.GotPubAck; 225 | Result := true; 226 | except 227 | Result := false; 228 | end; 229 | end; 230 | 231 | destructor TMQTT.Destroy; 232 | begin 233 | if Assigned(FSocket) then 234 | begin 235 | Disconnect; 236 | end; 237 | if Assigned(FKeepAliveTimer) then 238 | begin 239 | FreeAndNil(FKeepAliveTimer); 240 | end; 241 | if Assigned(FRecvThread) then 242 | begin 243 | FreeAndNil(FRecvThread); 244 | end; 245 | if Assigned(FCSSock) then 246 | begin 247 | FreeAndNil(FCSSock); 248 | end; 249 | inherited; 250 | end; 251 | 252 | function TMQTT.Disconnect: boolean; 253 | var 254 | Msg: TMQTTMessage; 255 | begin 256 | Result := false; 257 | if isConnected then 258 | begin 259 | FKeepAliveTimer.Enabled := false; 260 | Msg := DisconnectMessage; 261 | if WriteData(Msg.ToBytes) then Result := true else Result := false; 262 | Msg.Free; 263 | // Terminate our socket receive thread. 264 | FRecvThread.Terminate; 265 | FRecvThread.WaitFor; 266 | 267 | // Close our socket. 268 | FSocket.CloseSocket; 269 | FisConnected := False; 270 | 271 | // Free everything. 272 | if Assigned(FRecvThread) then FreeAndNil(FRecvThread); 273 | if Assigned(FSocket) then FreeAndNil(FSocket); 274 | end; 275 | end; 276 | 277 | function TMQTT.DisconnectMessage: TMQTTMessage; 278 | begin 279 | Result := TMQTTMessage.Create; 280 | Result.FixedHeader.MessageType := Ord(TMQTTMessageType.DISCONNECT); 281 | end; 282 | 283 | function TMQTT.getNextMessageId: integer; 284 | begin 285 | // If we've reached the upper bounds of our 16 bit unsigned message Id then 286 | // start again. The spec says it typically does but is not required to Inc(MsgId,1). 287 | if (FMessageID = 65535) then 288 | begin 289 | FMessageID := 1; 290 | end; 291 | 292 | // Return our current message Id 293 | Result := FMessageID; 294 | // Increment message Id 295 | Inc(FMessageID); 296 | end; 297 | 298 | function TMQTT.hasWill: boolean; 299 | begin 300 | if ((Length(FWillTopic) < 1) and (Length(FWillMsg) < 1)) then 301 | begin 302 | Result := false; 303 | end else Result := true; 304 | end; 305 | 306 | procedure TMQTT.KeepAliveTimer_Event(sender: TObject); 307 | begin 308 | if Self.isConnected then 309 | begin 310 | PingReq; 311 | end; 312 | end; 313 | 314 | function TMQTT.PingReq: boolean; 315 | var 316 | Msg: TMQTTMessage; 317 | begin 318 | Result := false; 319 | if isConnected then 320 | begin 321 | Msg := PingReqMessage; 322 | if WriteData(Msg.ToBytes) then Result := true else Result := false; 323 | Msg.Free; 324 | end; 325 | end; 326 | 327 | function TMQTT.PingReqMessage: TMQTTMessage; 328 | begin 329 | Result := TMQTTMessage.Create; 330 | Result.FixedHeader.MessageType := Ord(TMQTTMessageType.PINGREQ); 331 | end; 332 | 333 | procedure TMQTT.GotPingResp(Sender: TObject); 334 | begin 335 | if Assigned(FPingRespEvent) then OnPingResp(Self); 336 | end; 337 | 338 | function TMQTT.Publish(Topic, sPayload: Ansistring; Retain: boolean): boolean; 339 | begin 340 | Result := Publish(Topic, sPayload, Retain, 0); 341 | end; 342 | 343 | function TMQTT.Publish(Topic, sPayload: Ansistring): boolean; 344 | begin 345 | Result := Publish(Topic, sPayload, false, 0); 346 | end; 347 | 348 | function TMQTT.Publish(Topic, sPayload: Ansistring; Retain: boolean; 349 | QoS: integer): boolean; 350 | var 351 | Msg: TMQTTMessage; 352 | begin 353 | if ((QoS > -1) and (QoS <= 3)) then 354 | begin 355 | if isConnected then 356 | begin 357 | Msg := PublishMessage; 358 | Msg.FixedHeader.QoSLevel := QoS; 359 | (Msg.VariableHeader as TMQTTPublishVarHeader).QoSLevel := QoS; 360 | (Msg.VariableHeader as TMQTTPublishVarHeader).Topic := Topic; 361 | if (QoS > 0) then 362 | begin 363 | (Msg.VariableHeader as TMQTTPublishVarHeader).MessageID := getNextMessageId; 364 | end; 365 | Msg.Payload.Contents.Add(sPayload); 366 | Msg.Payload.PublishMessage := true; 367 | if WriteData(Msg.ToBytes) then Result := true else Result := false; 368 | Msg.Free; 369 | end; 370 | end 371 | else 372 | raise EInvalidOp.Create('QoS level can only be equal to or between 0 and 3.'); 373 | end; 374 | 375 | function TMQTT.PublishMessage: TMQTTMessage; 376 | begin 377 | Result := TMQTTMessage.Create; 378 | Result.FixedHeader.MessageType := Ord(TMQTTMessageType.PUBLISH); 379 | Result.VariableHeader := TMQTTPublishVarHeader.Create(0); 380 | Result.Payload := TMQTTPayload.Create; 381 | end; 382 | 383 | procedure TMQTT.GotPubRec(Sender: TObject; MessageID: integer); 384 | begin 385 | if Assigned(FPubRecEvent) then OnPubRec(Self, MessageID); 386 | end; 387 | 388 | procedure TMQTT.GotPubRel(Sender: TObject; MessageID: integer); 389 | begin 390 | if Assigned(FPubRelEvent) then OnPubRel(Self, MessageID); 391 | end; 392 | 393 | function TMQTT.Subscribe(Topic: Ansistring; RequestQoS: integer): integer; 394 | var 395 | dTopics: TDictionary; 396 | begin 397 | dTopics := TDictionary.Create; 398 | dTopics.Add(Topic, RequestQoS); 399 | Result := Subscribe(dTopics); 400 | dTopics.Free; 401 | end; 402 | 403 | procedure TMQTT.GotSubAck(Sender: TObject; MessageID: integer; 404 | GrantedQoS: array of integer); 405 | begin 406 | if Assigned(FSubAckEvent) then OnSubAck(Self, MessageID, GrantedQoS); 407 | end; 408 | 409 | function TMQTT.Subscribe(Topics: TDictionary): integer; 410 | var 411 | Msg: TMQTTMessage; 412 | MsgId: Integer; 413 | sTopic: AnsiString; 414 | data: TBytes; 415 | begin 416 | Result := -1; 417 | if isConnected then 418 | begin 419 | Msg := SubscribeMessage; 420 | MsgId := getNextMessageId; 421 | (Msg.VariableHeader as TMQTTSubscribeVarHeader).MessageID := MsgId; 422 | 423 | for sTopic in Topics.Keys do 424 | begin 425 | Msg.Payload.Contents.Add(sTopic); 426 | Msg.Payload.Contents.Add(IntToStr(Topics.Items[sTopic])) 427 | end; 428 | // the subscribe message contains integer literals not encoded as strings. 429 | Msg.Payload.ContainsIntLiterals := true; 430 | 431 | data := Msg.ToBytes; 432 | if WriteData(data) then Result := MsgId; 433 | 434 | Msg.Free; 435 | end; 436 | end; 437 | 438 | function TMQTT.SubscribeMessage: TMQTTMessage; 439 | begin 440 | Result := TMQTTMessage.Create; 441 | Result.FixedHeader.MessageType := Ord(TMQTTMessageType.SUBSCRIBE); 442 | Result.FixedHeader.QoSLevel := 0; 443 | Result.VariableHeader := TMQTTSubscribeVarHeader.Create; 444 | Result.Payload := TMQTTPayload.Create; 445 | end; 446 | 447 | function TMQTT.Unsubscribe(Topic: Ansistring): integer; 448 | var 449 | slTopics: TStringList; 450 | begin 451 | slTopics := TStringList.Create; 452 | slTopics.Add(Topic); 453 | Result := Unsubscribe(slTopics); 454 | slTopics.Free; 455 | end; 456 | 457 | procedure TMQTT.GotUnSubAck(Sender: TObject; MessageID: integer); 458 | begin 459 | if Assigned(FUnSubAckEvent) then OnUnSubAck(Self, MessageID); 460 | end; 461 | 462 | function TMQTT.Unsubscribe(Topics: TStringList): integer; 463 | var 464 | Msg: TMQTTMessage; 465 | MsgId: integer; 466 | sTopic: AnsiString; 467 | begin 468 | Result := -1; 469 | if isConnected then 470 | begin 471 | Msg := UnsubscribeMessage; 472 | MsgId := getNextMessageId; 473 | (Msg.VariableHeader as TMQTTSubscribeVarHeader).MessageID := MsgId; 474 | 475 | Msg.Payload.Contents.AddStrings(Topics); 476 | 477 | if WriteData(Msg.ToBytes) then Result := MsgId; 478 | 479 | Msg.Free; 480 | end; 481 | end; 482 | 483 | function TMQTT.UnsubscribeMessage: TMQTTMessage; 484 | var 485 | Msg: TMQTTMessage; 486 | begin 487 | Result := TMQTTMessage.Create; 488 | Result.FixedHeader.MessageType := Ord(TMQTTMessageType.UNSUBSCRIBE); 489 | Result.FixedHeader.QoSLevel := 1; 490 | Result.VariableHeader := TMQTTUnsubscribeVarHeader.Create; 491 | Result.Payload := TMQTTPayload.Create; 492 | end; 493 | 494 | function TMQTT.WriteData(AData: TBytes): boolean; 495 | var 496 | sentData: integer; 497 | attemptsToWrite: integer; 498 | begin 499 | Result := False; 500 | sentData := 0; 501 | attemptsToWrite := 1; 502 | if isConnected then 503 | begin 504 | repeat 505 | FCSSock.Acquire; 506 | try 507 | if FSocket.CanWrite(500 * attemptsToWrite) then 508 | begin 509 | sentData := sentData + FSocket.SendBuffer(Pointer(Copy(AData, sentData - 1, Length(AData) + 1)), Length(AData) - sentData); 510 | Inc(attemptsToWrite); 511 | end; 512 | finally 513 | FCSSock.Release; 514 | end; 515 | until ((attemptsToWrite = 3) or (sentData = Length(AData))); 516 | if sentData = Length(AData) then 517 | begin 518 | Result := True; 519 | FisConnected := true; 520 | end 521 | else 522 | begin 523 | Result := False; 524 | FisConnected := false; 525 | raise Exception.Create('Error Writing to Socket, it appears to be disconnected'); 526 | end; 527 | end; 528 | end; 529 | 530 | 531 | procedure TMQTT.GotPub(Sender: TObject; topic, payload: Ansistring); 532 | begin 533 | if Assigned(FPublishEvent) then OnPublish(Self, topic, payload); 534 | end; 535 | 536 | procedure TMQTT.GotPubAck(Sender: TObject; MessageID: integer); 537 | begin 538 | if Assigned(FPubAckEvent) then OnPubAck(Self, MessageID); 539 | end; 540 | 541 | procedure TMQTT.GotPubComp(Sender: TObject; MessageID: integer); 542 | begin 543 | if Assigned(FPubCompEvent) then OnPubComp(Self, MessageID); 544 | end; 545 | 546 | end. 547 | -------------------------------------------------------------------------------- /TMQTT/MQTTHeaders.pas: -------------------------------------------------------------------------------- 1 | unit MQTTHeaders; 2 | 3 | interface 4 | 5 | uses 6 | SysUtils, 7 | Types, 8 | Classes; 9 | 10 | type 11 | 12 | TMQTTMessageType = ( 13 | Reserved0, //0 Reserved 14 | CONNECT, // 1 Client request to connect to Broker 15 | CONNACK, // 2 Connect Acknowledgment 16 | PUBLISH, // 3 Publish message 17 | PUBACK, // 4 Publish Acknowledgment 18 | PUBREC, // 5 Publish Received (assured delivery part 1) 19 | PUBREL, // 6 Publish Release (assured delivery part 2) 20 | PUBCOMP, // 7 Publish Complete (assured delivery part 3) 21 | SUBSCRIBE, // 8 Client Subscribe request 22 | SUBACK, // 9 Subscribe Acknowledgment 23 | UNSUBSCRIBE, // 10 Client Unsubscribe request 24 | UNSUBACK, // 11 Unsubscribe Acknowledgment 25 | PINGREQ, // 12 PING Request 26 | PINGRESP, // 13 PING Response 27 | DISCONNECT, // 14 Client is Disconnecting 28 | Reserved15 // 15 29 | ); 30 | 31 | TMQTTRecvState = ( 32 | FixedHeaderByte, 33 | RemainingLength, 34 | Data 35 | ); 36 | 37 | { 38 | bit 7 6 5 4 3 2 1 0 39 | byte 1 Message Type DUP flag QoS level RETAIN 40 | byte 2 Remaining Length 41 | } 42 | TMQTTFixedHeader = packed record 43 | private 44 | function GetBits(const aIndex: Integer): Integer; 45 | procedure SetBits(const aIndex: Integer; const aValue: Integer); 46 | public 47 | Flags: Byte; 48 | property Retain: Integer index $0001 read GetBits write SetBits; // 1 bits at offset 0 49 | property QoSLevel: Integer index $0102 read GetBits write SetBits; // 2 bits at offset 1 50 | property Duplicate: Integer index $0301 read GetBits write SetBits; // 1 bits at offset 3 51 | property MessageType: Integer index $0404 read GetBits write SetBits; // 4 bits at offset 4 52 | end; 53 | 54 | { 55 | Description 7 6 5 4 3 2 1 0 56 | Connect Flags 57 | byte 10 1 1 0 0 1 1 1 x 58 | Will RETAIN (0) 59 | Will QoS (01) 60 | Will flag (1) 61 | Clean Start (1) 62 | Username Flag (1) 63 | Password Flag (1) 64 | } 65 | TMQTTConnectFlags = packed record 66 | private 67 | function GetBits(const aIndex: Integer): Integer; 68 | procedure SetBits(const aIndex: Integer; const aValue: Integer); 69 | public 70 | Flags: Byte; 71 | property CleanStart: Integer index $0101 read GetBits write SetBits; // 1 bit at offset 1 72 | property WillFlag: Integer index $0201 read GetBits write SetBits; // 1 bit at offset 2 73 | property WillQoS: Integer index $0302 read GetBits write SetBits; // 2 bits at offset 3 74 | property WillRetain: Integer index $0501 read GetBits write SetBits; // 1 bit at offset 5 75 | property Password: Integer index $0601 read GetBits write SetBits; // 1 bit at offset 6 76 | property UserName: Integer index $0701 read GetBits write SetBits; // 1 bit at offset 7 77 | end; 78 | 79 | TConnAckEvent = procedure (Sender: TObject; ReturnCode: integer) of object; 80 | TPublishEvent = procedure (Sender: TObject; topic, payload: Ansistring) of object; 81 | TPingRespEvent = procedure (Sender: TObject) of object; 82 | TPingReqEvent = procedure (Sender: TObject) of object; 83 | TSubAckEvent = procedure (Sender: TObject; MessageID: integer; GrantedQoS: Array of integer) of object; 84 | TUnSubAckEvent = procedure (Sender: TObject; MessageID: integer) of object; 85 | TPubAckEvent = procedure (Sender: TObject; MessageID: integer) of object; 86 | TPubRelEvent = procedure (Sender: TObject; MessageID: integer) of object; 87 | TPubRecEvent = procedure (Sender: TObject; MessageID: integer) of object; 88 | TPubCompEvent = procedure (Sender: TObject; MessageID: integer) of object; 89 | 90 | TMQTTVariableHeader = class 91 | private 92 | FBytes: TBytes; 93 | protected 94 | procedure AddField(AByte: Byte); overload; 95 | procedure AddField(ABytes: TBytes); overload; 96 | procedure ClearField; 97 | public 98 | constructor Create; 99 | function ToBytes: TBytes; virtual; 100 | end; 101 | 102 | TMQTTConnectVarHeader = class(TMQTTVariableHeader) 103 | const 104 | PROTOCOL_ID = 'MQIsdp'; 105 | PROTOCOL_VER = 3; 106 | private 107 | FConnectFlags: TMQTTConnectFlags; 108 | FKeepAlive: integer; 109 | function rebuildHeader: boolean; 110 | procedure setupDefaultValues; 111 | function get_CleanStart: integer; 112 | function get_QoSLevel: integer; 113 | function get_Retain: integer; 114 | procedure set_CleanStart(const Value: integer); 115 | procedure set_QoSLevel(const Value: integer); 116 | procedure set_Retain(const Value: integer); 117 | function get_WillFlag: integer; 118 | procedure set_WillFlag(const Value: integer); 119 | function get_Username: integer; 120 | procedure set_Username(const Value: integer); 121 | function get_Password: integer; 122 | procedure set_Password(const Value: integer); 123 | public 124 | constructor Create(AKeepAlive: integer); overload; 125 | constructor Create; overload; 126 | constructor Create(ACleanStart: boolean); overload; 127 | property KeepAlive: integer read FKeepAlive write FKeepAlive; 128 | property CleanStart: integer read get_CleanStart write set_CleanStart; 129 | property QoSLevel: integer read get_QoSLevel write set_QoSLevel; 130 | property Retain: integer read get_Retain write set_Retain; 131 | property Username: integer read get_Username write set_Username; 132 | property Password: integer read get_Password write set_Password; 133 | property WillFlag: integer read get_WillFlag write set_WillFlag; 134 | function ToBytes: TBytes; override; 135 | end; 136 | 137 | TMQTTPublishVarHeader = class(TMQTTVariableHeader) 138 | private 139 | FTopic: AnsiString; 140 | FQoSLevel: integer; 141 | FMessageID: integer; 142 | function get_MessageID: integer; 143 | function get_QoSLevel: integer; 144 | procedure set_MessageID(const Value: integer); 145 | procedure set_QoSLevel(const Value: integer); 146 | function get_Topic: AnsiString; 147 | procedure set_Topic(const Value: AnsiString); 148 | procedure rebuildHeader; 149 | public 150 | constructor Create(QoSLevel: integer); overload; 151 | property MessageID: integer read get_MessageID write set_MessageID; 152 | property QoSLevel: integer read get_QoSLevel write set_QoSLevel; 153 | property Topic: AnsiString read get_Topic write set_Topic; 154 | function ToBytes: TBytes; override; 155 | end; 156 | 157 | TMQTTSubscribeVarHeader = class(TMQTTVariableHeader) 158 | private 159 | FMessageID: integer; 160 | function get_MessageID: integer; 161 | procedure set_MessageID(const Value: integer); 162 | public 163 | constructor Create(MessageId: integer); overload; 164 | property MessageID: integer read get_MessageID write set_MessageID; 165 | function ToBytes: TBytes; override; 166 | end; 167 | 168 | TMQTTUnsubscribeVarHeader = class(TMQTTVariableHeader) 169 | private 170 | FMessageID: integer; 171 | function get_MessageID: integer; 172 | procedure set_MessageID(const Value: integer); 173 | public 174 | constructor Create(MessageId: integer); overload; 175 | property MessageID: integer read get_MessageID write set_MessageID; 176 | function ToBytes: TBytes; override; 177 | end; 178 | 179 | TMQTTPayload = class 180 | private 181 | FContents: TStringList; 182 | FContainsIntLiterals: boolean; 183 | FPublishMessage: boolean; 184 | public 185 | constructor Create; 186 | destructor Destroy; override; 187 | function ToBytes: TBytes; overload; 188 | function ToBytes(WithIntegerLiterals: boolean): TBytes; overload; 189 | property Contents: TStringList read FContents; 190 | property ContainsIntLiterals: boolean read FContainsIntLiterals write FContainsIntLiterals; 191 | property PublishMessage: boolean read FPublishMessage write FPublishMessage; 192 | end; 193 | 194 | TMQTTMessage = class 195 | private 196 | FRemainingLength: Integer; 197 | public 198 | FixedHeader: TMQTTFixedHeader; 199 | VariableHeader: TMQTTVariableHeader; 200 | Payload: TMQTTPayload; 201 | constructor Create; 202 | destructor Destroy; override; 203 | function ToBytes: TBytes; 204 | property RemainingLength: integer read FRemainingLength; 205 | end; 206 | 207 | TMQTTUtilities = class 208 | public 209 | class function UTF8EncodeToBytes(AStrToEncode: AnsiString): TBytes; 210 | class function UTF8EncodeToBytesNoLength(AStrToEncode: AnsiString): TBytes; 211 | class function RLIntToBytes(ARlInt: integer): TBytes; 212 | class function IntToMSBLSB(ANumber: Word): TBytes; 213 | end; 214 | 215 | implementation 216 | 217 | function GetDWordBits(const Bits: Byte; const aIndex: Integer): Integer; 218 | begin 219 | Result := (Bits shr (aIndex shr 8)) // offset 220 | and ((1 shl Byte(aIndex)) - 1); // mask 221 | end; 222 | 223 | procedure SetDWordBits(var Bits: Byte; const aIndex: Integer; const aValue: Integer); 224 | var 225 | Offset: Byte; 226 | Mask: Integer; 227 | begin 228 | Mask := ((1 shl Byte(aIndex)) - 1); 229 | Assert(aValue <= Mask); 230 | 231 | Offset := aIndex shr 8; 232 | Bits := (Bits and (not (Mask shl Offset))) 233 | or DWORD(aValue shl Offset); 234 | end; 235 | 236 | class function TMQTTUtilities.IntToMSBLSB(ANumber: Word): TBytes; 237 | begin 238 | SetLength(Result, 2); 239 | Result[0] := ANumber div 256; 240 | Result[1] := ANumber mod 256; 241 | end; 242 | 243 | { MSBLSBToInt is in the MQTTRecvThread unit } 244 | 245 | class function TMQTTUtilities.UTF8EncodeToBytes(AStrToEncode: AnsiString): TBytes; 246 | var 247 | i: integer; 248 | begin 249 | { This is a UTF-8 hack to give 2 Bytes of Length MSB-LSB followed by a Single-byte 250 | per character String. } 251 | SetLength(Result, Length(AStrToEncode) + 2); 252 | 253 | Result[0] := Length(AStrToEncode) div 256; 254 | Result[1] := Length(AStrToEncode) mod 256; 255 | 256 | for I := 0 to Length(AStrToEncode) - 1 do 257 | begin 258 | Result[i + 2] := Ord(AStrToEncode[i + 1]); 259 | end; 260 | end; 261 | 262 | class function TMQTTUtilities.UTF8EncodeToBytesNoLength(AStrToEncode: AnsiString): TBytes; 263 | var 264 | i: integer; 265 | begin 266 | SetLength(Result, Length(AStrToEncode)); 267 | for i := 0 to Length(AStrToEncode) - 1 do 268 | begin 269 | Result[i] := Ord(AStrToEncode[i + 1]); 270 | end; 271 | end; 272 | 273 | procedure AppendToByteArray(ASourceBytes: TBytes; var ATargetBytes: TBytes); overload; 274 | var 275 | iUpperBnd: integer; 276 | begin 277 | if Length(ASourceBytes) > 0 then 278 | begin 279 | iUpperBnd := Length(ATargetBytes); 280 | SetLength(ATargetBytes, iUpperBnd + Length(ASourceBytes)); 281 | Move(ASourceBytes[0], ATargetBytes[iUpperBnd], Length(ASourceBytes)); 282 | end; 283 | end; 284 | 285 | procedure AppendToByteArray(ASourceByte: Byte; var ATargetBytes: TBytes); overload; 286 | var 287 | iUpperBnd: integer; 288 | begin 289 | iUpperBnd := Length(ATargetBytes); 290 | SetLength(ATargetBytes, iUpperBnd + 1); 291 | Move(ASourceByte, ATargetBytes[iUpperBnd], 1); 292 | end; 293 | 294 | class function TMQTTUtilities.RLIntToBytes(ARlInt: integer): TBytes; 295 | var 296 | byteindex: integer; 297 | digit: integer; 298 | begin 299 | SetLength(Result, 1); 300 | byteindex := 0; 301 | while (ARlInt > 0) do 302 | begin 303 | digit := ARlInt mod 128; 304 | ARlInt := ARlInt div 128; 305 | if ARlInt > 0 then 306 | begin 307 | digit := digit or $80; 308 | end; 309 | Result[byteindex] := digit; 310 | if ARlInt > 0 then 311 | begin 312 | inc(byteindex); 313 | SetLength(Result, Length(Result) + 1); 314 | end; 315 | end; 316 | end; 317 | 318 | { TMQTTFixedHeader } 319 | 320 | function TMQTTFixedHeader.GetBits(const aIndex: Integer): Integer; 321 | begin 322 | Result := GetDWordBits(Flags, aIndex); 323 | end; 324 | 325 | procedure TMQTTFixedHeader.SetBits(const aIndex, aValue: Integer); 326 | begin 327 | SetDWordBits(Flags, aIndex, aValue); 328 | end; 329 | 330 | { TMQTTMessage } 331 | 332 | 333 | { TMQTTVariableHeader } 334 | 335 | procedure TMQTTVariableHeader.AddField(AByte: Byte); 336 | var 337 | DestUpperBnd: Integer; 338 | begin 339 | DestUpperBnd := Length(FBytes); 340 | SetLength(FBytes, DestUpperBnd + SizeOf(AByte)); 341 | Move(AByte, FBytes[DestUpperBnd], SizeOf(AByte)); 342 | end; 343 | 344 | procedure TMQTTVariableHeader.AddField(ABytes: TBytes); 345 | var 346 | DestUpperBnd: Integer; 347 | begin 348 | DestUpperBnd := Length(FBytes); 349 | SetLength(FBytes, DestUpperBnd + Length(ABytes)); 350 | Move(ABytes[0], FBytes[DestUpperBnd], Length(ABytes)); 351 | end; 352 | 353 | procedure TMQTTVariableHeader.ClearField; 354 | begin 355 | SetLength(FBytes, 0); 356 | end; 357 | 358 | constructor TMQTTVariableHeader.Create; 359 | begin 360 | end; 361 | 362 | function TMQTTVariableHeader.ToBytes: TBytes; 363 | begin 364 | Result := FBytes; 365 | end; 366 | 367 | { TMQTTConnectVarHeader } 368 | 369 | constructor TMQTTConnectVarHeader.Create(ACleanStart: boolean); 370 | begin 371 | inherited Create; 372 | setupDefaultValues; 373 | Self.FConnectFlags.CleanStart := Ord(ACleanStart); 374 | end; 375 | 376 | function TMQTTConnectVarHeader.get_CleanStart: integer; 377 | begin 378 | Result := Self.FConnectFlags.CleanStart; 379 | end; 380 | 381 | function TMQTTConnectVarHeader.get_Password: integer; 382 | begin 383 | Result := Self.FConnectFlags.Password; 384 | end; 385 | 386 | function TMQTTConnectVarHeader.get_QoSLevel: integer; 387 | begin 388 | Result := Self.FConnectFlags.WillQoS; 389 | end; 390 | 391 | function TMQTTConnectVarHeader.get_Retain: integer; 392 | begin 393 | Result := Self.FConnectFlags.WillRetain; 394 | end; 395 | 396 | function TMQTTConnectVarHeader.get_Username: integer; 397 | begin 398 | Result := Self.FConnectFlags.UserName; 399 | end; 400 | 401 | function TMQTTConnectVarHeader.get_WillFlag: integer; 402 | begin 403 | Result := Self.FConnectFlags.WillFlag; 404 | end; 405 | 406 | constructor TMQTTConnectVarHeader.Create(AKeepAlive: integer); 407 | begin 408 | inherited Create; 409 | setupDefaultValues; 410 | Self.FKeepAlive := AKeepAlive; 411 | end; 412 | 413 | constructor TMQTTConnectVarHeader.Create; 414 | begin 415 | inherited Create; 416 | setupDefaultValues; 417 | end; 418 | 419 | function TMQTTConnectVarHeader.rebuildHeader: boolean; 420 | begin 421 | try 422 | ClearField; 423 | AddField(TMQTTUtilities.UTF8EncodeToBytes(Self.PROTOCOL_ID)); 424 | AddField(Byte(Self.PROTOCOL_VER)); 425 | AddField(FConnectFlags.Flags); 426 | AddField(TMQTTUtilities.IntToMSBLSB(FKeepAlive)); 427 | except 428 | Result := false; 429 | end; 430 | Result := true; 431 | end; 432 | 433 | procedure TMQTTConnectVarHeader.setupDefaultValues; 434 | begin 435 | Self.FConnectFlags.Flags := 0; 436 | Self.FConnectFlags.CleanStart := 1; 437 | Self.FConnectFlags.WillQoS := 1; 438 | Self.FConnectFlags.WillRetain := 0; 439 | Self.FConnectFlags.WillFlag := 1; 440 | Self.FConnectFlags.UserName := 0; 441 | Self.FConnectFlags.Password := 0; 442 | Self.FKeepAlive := 10; 443 | end; 444 | 445 | procedure TMQTTConnectVarHeader.set_CleanStart(const Value: integer); 446 | begin 447 | Self.FConnectFlags.CleanStart := Value; 448 | end; 449 | 450 | procedure TMQTTConnectVarHeader.set_Password(const Value: integer); 451 | begin 452 | Self.FConnectFlags.UserName := Value; 453 | end; 454 | 455 | procedure TMQTTConnectVarHeader.set_QoSLevel(const Value: integer); 456 | begin 457 | Self.FConnectFlags.WillQoS := Value; 458 | end; 459 | 460 | procedure TMQTTConnectVarHeader.set_Retain(const Value: integer); 461 | begin 462 | Self.FConnectFlags.WillRetain := Value; 463 | end; 464 | 465 | procedure TMQTTConnectVarHeader.set_Username(const Value: integer); 466 | begin 467 | Self.FConnectFlags.Password := Value; 468 | end; 469 | 470 | procedure TMQTTConnectVarHeader.set_WillFlag(const Value: integer); 471 | begin 472 | Self.FConnectFlags.WillFlag := Value; 473 | end; 474 | 475 | function TMQTTConnectVarHeader.ToBytes: TBytes; 476 | begin 477 | Self.rebuildHeader; 478 | Result := FBytes; 479 | end; 480 | 481 | { TMQTTConnectFlags } 482 | 483 | function TMQTTConnectFlags.GetBits(const aIndex: Integer): Integer; 484 | begin 485 | Result := GetDWordBits(Flags, aIndex); 486 | end; 487 | 488 | procedure TMQTTConnectFlags.SetBits(const aIndex, aValue: Integer); 489 | begin 490 | SetDWordBits(Flags, aIndex, aValue); 491 | end; 492 | 493 | { TMQTTPayload } 494 | 495 | constructor TMQTTPayload.Create; 496 | begin 497 | FContents := TStringList.Create(); 498 | FContainsIntLiterals := false; 499 | FPublishMessage := false; 500 | end; 501 | 502 | destructor TMQTTPayload.Destroy; 503 | begin 504 | FContents.Free; 505 | inherited; 506 | end; 507 | 508 | function TMQTTPayload.ToBytes(WithIntegerLiterals: boolean): TBytes; 509 | var 510 | line: string; 511 | lineAsBytes: TBytes; 512 | lineAsInt: integer; 513 | begin 514 | SetLength(Result, 0); 515 | for line in FContents do 516 | begin 517 | // This is really nasty and needs refactoring into subclasses 518 | if PublishMessage then 519 | begin 520 | lineAsBytes := TMQTTUtilities.UTF8EncodeToBytesNoLength(line); 521 | AppendToByteArray(lineAsBytes, Result); 522 | end 523 | else 524 | begin 525 | if (WithIntegerLiterals and TryStrToInt(line, lineAsInt))then 526 | begin 527 | AppendToByteArray(Lo(lineAsInt), Result); 528 | end 529 | else 530 | begin 531 | lineAsBytes := TMQTTUtilities.UTF8EncodeToBytes(line); 532 | AppendToByteArray(lineAsBytes, Result); 533 | end; 534 | end; 535 | end; 536 | end; 537 | 538 | function TMQTTPayload.ToBytes: TBytes; 539 | begin 540 | Result := ToBytes(FContainsIntLiterals); 541 | end; 542 | 543 | { TMQTTMessage } 544 | 545 | constructor TMQTTMessage.Create; 546 | begin 547 | inherited; 548 | // Fill our Fixed Header with Zeros to wipe any unintended noise. 549 | //FillChar(FixedHeader, SizeOf(FixedHeader), #0); 550 | end; 551 | 552 | destructor TMQTTMessage.Destroy; 553 | begin 554 | if Assigned(VariableHeader) then VariableHeader.Free; 555 | if Assigned(Payload) then Payload.Free; 556 | inherited; 557 | end; 558 | 559 | function TMQTTMessage.ToBytes: TBytes; 560 | var 561 | iRemainingLength: integer; 562 | bytesRemainingLength: TBytes; 563 | i: integer; 564 | begin 565 | 566 | try 567 | iRemainingLength := 0; 568 | if Assigned(VariableHeader) then iRemainingLength := iRemainingLength + Length(VariableHeader.ToBytes); 569 | if Assigned(Payload) then iRemainingLength := iRemainingLength + Length(Payload.ToBytes); 570 | 571 | FRemainingLength := iRemainingLength; 572 | bytesRemainingLength := TMQTTUtilities.RLIntToBytes(FRemainingLength); 573 | 574 | AppendToByteArray(FixedHeader.Flags, Result); 575 | AppendToByteArray(bytesRemainingLength, Result); 576 | if Assigned(VariableHeader) then AppendToByteArray(VariableHeader.ToBytes, Result); 577 | if Assigned(Payload) then AppendToByteArray(Payload.ToBytes, Result); 578 | 579 | except 580 | //on E:Exception do 581 | 582 | end; 583 | end; 584 | 585 | { TMQTTPublishVarHeader } 586 | 587 | constructor TMQTTPublishVarHeader.Create(QoSLevel: integer); 588 | begin 589 | inherited Create; 590 | FQosLevel := QoSLevel; 591 | end; 592 | 593 | function TMQTTPublishVarHeader.get_MessageID: integer; 594 | begin 595 | Result := FMessageID; 596 | end; 597 | 598 | function TMQTTPublishVarHeader.get_QoSLevel: integer; 599 | begin 600 | Result := FQoSLevel; 601 | end; 602 | 603 | function TMQTTPublishVarHeader.get_Topic: AnsiString; 604 | begin 605 | Result := FTopic; 606 | end; 607 | 608 | procedure TMQTTPublishVarHeader.rebuildHeader; 609 | begin 610 | ClearField; 611 | AddField(TMQTTUtilities.UTF8EncodeToBytes(FTopic)); 612 | if (FQoSLevel > 0) then 613 | begin 614 | AddField(TMQTTUtilities.IntToMSBLSB(FMessageID)); 615 | end; 616 | end; 617 | 618 | procedure TMQTTPublishVarHeader.set_MessageID(const Value: integer); 619 | begin 620 | FMessageID := Value; 621 | end; 622 | 623 | procedure TMQTTPublishVarHeader.set_QoSLevel(const Value: integer); 624 | begin 625 | FQoSLevel := Value; 626 | end; 627 | 628 | procedure TMQTTPublishVarHeader.set_Topic(const Value: AnsiString); 629 | begin 630 | FTopic := Value; 631 | end; 632 | 633 | function TMQTTPublishVarHeader.ToBytes: TBytes; 634 | begin 635 | Self.rebuildHeader; 636 | Result := Self.FBytes; 637 | end; 638 | 639 | { TMQTTSubscribeVarHeader } 640 | 641 | constructor TMQTTSubscribeVarHeader.Create(MessageId: integer); 642 | begin 643 | inherited Create; 644 | FMessageID := MessageId; 645 | end; 646 | 647 | function TMQTTSubscribeVarHeader.get_MessageID: integer; 648 | begin 649 | Result := FMessageID; 650 | end; 651 | 652 | procedure TMQTTSubscribeVarHeader.set_MessageID(const Value: integer); 653 | begin 654 | FMessageID := Value; 655 | end; 656 | 657 | function TMQTTSubscribeVarHeader.ToBytes: TBytes; 658 | begin 659 | ClearField; 660 | AddField(TMQTTUtilities.IntToMSBLSB(FMessageID)); 661 | Result := FBytes; 662 | end; 663 | 664 | { TMQTTUnsubscribeVarHeader } 665 | 666 | constructor TMQTTUnsubscribeVarHeader.Create(MessageId: integer); 667 | begin 668 | inherited Create; 669 | FMessageID := MessageId; 670 | end; 671 | 672 | function TMQTTUnsubscribeVarHeader.get_MessageID: integer; 673 | begin 674 | Result := FMessageID; 675 | end; 676 | 677 | procedure TMQTTUnsubscribeVarHeader.set_MessageID(const Value: integer); 678 | begin 679 | FMessageID := Value; 680 | end; 681 | 682 | function TMQTTUnsubscribeVarHeader.ToBytes: TBytes; 683 | begin 684 | ClearField; 685 | AddField(TMQTTUtilities.IntToMSBLSB(FMessageID)); 686 | Result := FBytes; 687 | end; 688 | 689 | end. 690 | --------------------------------------------------------------------------------