From 043b6f68c327fad4f920e8f688bae13c7c86867d Mon Sep 17 00:00:00 2001 From: bkeevil Date: Wed, 5 Sep 2018 17:35:26 -0400 Subject: [PATCH] Fix Issue 9 --- Apps/MQTTClient/MQTTClientApp.lps | 3 +- Apps/MQTTServer/MQTTServerApp.lpi | 12 ++-- Apps/MQTTServer/MQTTServerApp.lps | 116 +++++++++++++++--------------- Apps/MQTTServer/MQTTServerApp.res | Bin 138936 -> 138932 bytes Forms/clientfm.lfm | 8 +-- Forms/clientfm.pas | 6 +- Forms/serverfm.lfm | 64 +++++++++++------ Forms/serverfm.pas | 12 +++- src/mqttserver.pas | 6 +- 9 files changed, 134 insertions(+), 93 deletions(-) diff --git a/Apps/MQTTClient/MQTTClientApp.lps b/Apps/MQTTClient/MQTTClientApp.lps index 2123d61..54a7dcb 100644 --- a/Apps/MQTTClient/MQTTClientApp.lps +++ b/Apps/MQTTClient/MQTTClientApp.lps @@ -18,8 +18,8 @@ + - @@ -89,7 +89,6 @@ - diff --git a/Apps/MQTTServer/MQTTServerApp.lpi b/Apps/MQTTServer/MQTTServerApp.lpi index 4661ea7..31823ed 100644 --- a/Apps/MQTTServer/MQTTServerApp.lpi +++ b/Apps/MQTTServer/MQTTServerApp.lpi @@ -25,16 +25,19 @@ - + - + - + - + + + + @@ -92,6 +95,7 @@ + diff --git a/Apps/MQTTServer/MQTTServerApp.lps b/Apps/MQTTServer/MQTTServerApp.lps index 91e0895..7c2424f 100644 --- a/Apps/MQTTServer/MQTTServerApp.lps +++ b/Apps/MQTTServer/MQTTServerApp.lps @@ -7,7 +7,6 @@ - @@ -20,8 +19,9 @@ - - + + + @@ -33,9 +33,9 @@ - + - + @@ -47,7 +47,7 @@ - + @@ -132,7 +132,7 @@ - + @@ -141,14 +141,15 @@ - - - + + - + + + @@ -157,15 +158,15 @@ - + - + - + @@ -181,7 +182,7 @@ - + @@ -216,15 +217,16 @@ - - + + + - + @@ -554,130 +556,130 @@ - + - + - + - + - + - + - + - - + + - + - + - + - + - + - + - - + + - + - + - + - + - + - + - + - + - + - - + + - + - - + + - - + + - - + + - - + + - - + + diff --git a/Apps/MQTTServer/MQTTServerApp.res b/Apps/MQTTServer/MQTTServerApp.res index 4ff746d8ad795966bb1af52e6626a7a90a04cb91..877868cb4251927ab961b2295948c0d753ecb7cd 100644 GIT binary patch delta 43 zcmdn7mt)IbjtL5kmJ1ab*&PcC{1S6hCu=a;Y|dm9XKk)$Yp-Wx++NSdWGMjvKxqvk delta 49 zcmdn8mt)6XjtL5kb_*35*(38yiyR9ICTlR-uqtGv7Nu@ZVH9U=u3>AhVPo80!^UJG F0RWvE4-WtU diff --git a/Forms/clientfm.lfm b/Forms/clientfm.lfm index 49771c7..f0c408c 100644 --- a/Forms/clientfm.lfm +++ b/Forms/clientfm.lfm @@ -53,9 +53,9 @@ object ClientForm: TClientForm Height = 296 Top = 48 Width = 664 - ActivePage = LogTab + ActivePage = PacketsInMemTab Anchors = [akTop, akLeft, akRight, akBottom] - TabIndex = 2 + TabIndex = 3 TabOrder = 4 object SubscriptionsTab: TTabSheet Caption = 'Subscriptions' @@ -261,11 +261,11 @@ object ClientForm: TClientForm ) end end - object TabSheet1: TTabSheet + object PacketsInMemTab: TTabSheet Caption = 'PacketsInMem' ClientHeight = 265 ClientWidth = 654 - OnContextPopup = TabSheet1ContextPopup + OnContextPopup = PacketsInMemTabContextPopup object PacketsMemo: TMemo Left = 0 Height = 240 diff --git a/Forms/clientfm.pas b/Forms/clientfm.pas index 9f13a9d..349e0b1 100644 --- a/Forms/clientfm.pas +++ b/Forms/clientfm.pas @@ -34,7 +34,7 @@ TClientForm = class(TForm) PacketsMemo: TMemo; StatusBar: TStatusBar; LogTab: TTabSheet; - TabSheet1: TTabSheet; + PacketsInMemTab: TTabSheet; TCP: TLTCPComponent; RefreshSubscriptionsItm: TMenuItem; PageControl: TPageControl; @@ -65,7 +65,7 @@ TClientForm = class(TForm) procedure RefreshPacketsBtnClick(Sender: TObject); procedure RefreshSubscriptionsItmClick(Sender: TObject); procedure SubscribeBtnClick(Sender: TObject); - procedure TabSheet1ContextPopup(Sender: TObject; MousePos: TPoint; + procedure PacketsInMemTabContextPopup(Sender: TObject; MousePos: TPoint; var Handled: Boolean); procedure TCPCanSend(aSocket: TLSocket); procedure TCPConnect(aSocket: TLSocket); @@ -305,7 +305,7 @@ procedure TClientForm.SubscribeBtnClick(Sender: TObject); end; end; -procedure TClientForm.TabSheet1ContextPopup(Sender: TObject; MousePos: TPoint; +procedure TClientForm.PacketsInMemTabContextPopup(Sender: TObject; MousePos: TPoint; var Handled: Boolean); begin diff --git a/Forms/serverfm.lfm b/Forms/serverfm.lfm index 891cfbb..345a6d4 100644 --- a/Forms/serverfm.lfm +++ b/Forms/serverfm.lfm @@ -5,31 +5,31 @@ object ServerForm: TServerForm Width = 817 ActiveControl = PageControl Caption = 'MQTT Server' - ClientHeight = 348 + ClientHeight = 346 ClientWidth = 817 Menu = MainMenu OnCreate = FormCreate OnDestroy = FormDestroy Position = poScreenCenter - LCLVersion = '1.6.4.0' + LCLVersion = '1.8.2.0' object PageControl: TPageControl Left = 0 - Height = 348 + Height = 346 Top = 0 Width = 817 - ActivePage = ConnectionsTab + ActivePage = PacketsInMemTab Align = alClient - TabIndex = 0 + TabIndex = 5 TabOrder = 0 object ConnectionsTab: TTabSheet Caption = 'Connections' - ClientHeight = 313 - ClientWidth = 811 + ClientHeight = 315 + ClientWidth = 807 object ConnectionsGrid: TStringGrid Left = 0 - Height = 313 + Height = 315 Top = 0 - Width = 811 + Width = 807 Align = alClient AutoEdit = False AutoFillColumns = True @@ -54,7 +54,7 @@ object ServerForm: TServerForm ButtonStyle = cbsEllipsis SizePriority = 0 Title.Caption = 'Will Message' - Width = 509 + Width = 505 end> DefaultRowHeight = 20 Enabled = False @@ -68,14 +68,14 @@ object ServerForm: TServerForm 80 120 100 - 509 + 505 ) end end object SubscriptionsTab: TTabSheet Caption = 'Subscriptions' - ClientHeight = 313 - ClientWidth = 811 + ClientHeight = 315 + ClientWidth = 807 object SubscriptionsGrid: TStringGrid Left = 0 Height = 336 @@ -105,6 +105,7 @@ object ServerForm: TServerForm SizePriority = 0 Title.Alignment = taRightJustify Title.Caption = 'Age' + Width = 64 end> DefaultRowHeight = 20 Enabled = False @@ -124,8 +125,8 @@ object ServerForm: TServerForm end object SessionsTab: TTabSheet Caption = 'Sessions' - ClientHeight = 313 - ClientWidth = 811 + ClientHeight = 315 + ClientWidth = 807 object SessionsGrid: TStringGrid Left = 0 Height = 336 @@ -172,8 +173,8 @@ object ServerForm: TServerForm end object RetainedMessagesTab: TTabSheet Caption = 'Retained Messages' - ClientHeight = 313 - ClientWidth = 811 + ClientHeight = 315 + ClientWidth = 807 object RetainedMessagesGrid: TStringGrid Left = 0 Height = 336 @@ -220,8 +221,8 @@ object ServerForm: TServerForm end object TabSheet1: TTabSheet Caption = 'Log' - ClientHeight = 313 - ClientWidth = 811 + ClientHeight = 315 + ClientWidth = 807 object LogGrid: TStringGrid Left = 0 Height = 286 @@ -312,6 +313,30 @@ object ServerForm: TServerForm end end end + object PacketsInMemTab: TTabSheet + Caption = 'PacketsInMem' + ClientHeight = 315 + ClientWidth = 807 + object RefreshPacketListBtn: TButton + Left = 0 + Height = 25 + Top = 0 + Width = 807 + Align = alTop + Caption = 'Refresh' + OnClick = RefreshPacketListBtnClick + TabOrder = 0 + end + object PacketListMemo: TMemo + Left = 0 + Height = 290 + Top = 25 + Width = 807 + Align = alClient + ScrollBars = ssVertical + TabOrder = 1 + end + end end object MainMenu: TMainMenu left = 256 @@ -374,7 +399,6 @@ object ServerForm: TServerForm end end object Server: TMQTTServer - MaximumQOS = qtAT_MOST_ONCE RequireAuthentication = False AllowNullClientIDs = True OnAccepted = ServerAccepted diff --git a/Forms/serverfm.pas b/Forms/serverfm.pas index 46f3551..0bff09b 100644 --- a/Forms/serverfm.pas +++ b/Forms/serverfm.pas @@ -25,6 +25,8 @@ TDebugMessage = record { TServerForm } TServerForm = class(TForm) + PacketListMemo: TMemo; + RefreshPacketListBtn: TButton; CBEnabled: TCheckBox; CBFiltered: TCheckBox; ClearBtn: TButton; @@ -36,6 +38,7 @@ TServerForm = class(TForm) RetainedMessagesGrid: TStringGrid; RetainedMessagesTab: TTabSheet; TabSheet1: TTabSheet; + PacketsInMemTab: TTabSheet; TCP: TLTCPComponent; SessionsGrid: TStringGrid; MainMenu: TMainMenu; @@ -72,6 +75,7 @@ TServerForm = class(TForm) procedure LoadConfigurationItmClick(Sender: TObject); procedure PropertiesItmClick(Sender: TObject); procedure RefreshConnectionsItmClick(Sender: TObject); + procedure RefreshPacketListBtnClick(Sender: TObject); procedure RefreshRetainedMessagesItmClick(Sender: TObject); procedure RefreshSessionsItmClick(Sender: TObject); procedure RefreshSubscriptionsItmClick(Sender: TObject); @@ -115,7 +119,7 @@ implementation {$R *.lfm} uses - IniFiles, HelpFM, ServerPropertiesFM; + MQTTPackets, MQTTPacketDefs, IniFiles, HelpFM, ServerPropertiesFM; { TServerForm } @@ -537,6 +541,12 @@ procedure TServerForm.RefreshConnectionsItmClick(Sender: TObject); end; end; +procedure TServerForm.RefreshPacketListBtnClick(Sender: TObject); +begin + PacketListMemo.Clear; + PacketList.Dump(PacketListMemo.Lines); +end; + procedure TServerForm.RefreshSessionsItmClick(Sender: TObject); var I: Integer; diff --git a/src/mqttserver.pas b/src/mqttserver.pas index 87efa11..15f4f9d 100644 --- a/src/mqttserver.pas +++ b/src/mqttserver.pas @@ -129,6 +129,7 @@ TMQTTServer = class(TComponent) FSessions : TMQTTSessionList; FRetainedMessages : TMQTTMessageList; FEnabled : Boolean; + FShutdown : Boolean; FRequireAuthentication : Boolean; FAllowNullClientIDs : Boolean; FStrictClientIDValidation : Boolean; @@ -315,6 +316,7 @@ constructor TMQTTServer.Create(AOwner: TComponent); destructor TMQTTServer.Destroy; begin + FShutdown := True; FThread.FServer := nil; FThread.Terminate; FSessions.Free; @@ -352,7 +354,7 @@ procedure TMQTTServer.UpdateSystemClockMessages; DispatchMessage(nil,'System/Time/Day',IntToStr(LNow.Day),qtAT_MOST_ONCE,true); if (LNow.Hour <> FLastTime.Hour) then DispatchMessage(nil,'System/Time/Hour',IntToStr(LNow.Hour),qtAT_MOST_ONCE,true); - //if (LNow.DayOfWeek <> FLastTime.DayOfWeek) then + //if (LNow.DayOfWeek <> FLastTime.DayOfWeek) then { Doesn't work in Raspberry pi } // DispatchMessage(nil,'System/Time/DOW',IntToStr(LNow.DayOfWeek),qtAT_MOST_ONCE,true); if (LNow.Minute <> FLastTime.Minute) then begin @@ -439,7 +441,7 @@ procedure TMQTTServer.DestroyConnection(Connection: TMQTTServerConnection); procedure TMQTTServer.ConnectionsChanged; begin - if Assigned(FOnConnectionsChanged) then + if (not FShutdown) and Assigned(FOnConnectionsChanged) then FOnConnectionsChanged(Self); end;