Merge pull request #11 from digao-dalpiaz/auto-reconnection

Auto reconnection
digao-dalpiaz · May 26, 2021 · 3113a20 · 3113a20
2 parents 572ff56 + 59d48ed
commit 3113a20
Show file tree

Hide file tree

Showing 5 changed files with 338 additions and 152 deletions.
diff --git a/CompInstall.ini b/CompInstall.ini
@@ -1,6 +1,6 @@
 [General]
 Name=Digao Dalpiaz - DzSocket component
-Version=2.6
+Version=3.0
 DelphiVersions=XE3;XE4;XE5;XE6;XE7;XE8;10;10.1;10.2;10.3;10.4
 Packages=DzSocket
 AddLibrary=1

diff --git a/Demos/MainDemo/UFrm.dfm b/Demos/MainDemo/UFrm.dfm
@@ -231,7 +231,7 @@ object Frm: TFrm
     Font.Style = []
     ParentFont = False
     ScrollBars = ssBoth
-    TabOrder = 17
+    TabOrder = 18
     WordWrap = False
   end
   object S_Cmd: TEdit
@@ -259,15 +259,15 @@ object Frm: TFrm
     Height = 21
     Enabled = False
     MaxLength = 1
-    TabOrder = 18
+    TabOrder = 19
     Text = 'M'
   end
   object C_Msg: TEdit
     Left = 536
     Top = 480
     Width = 449
     Height = 21
-    TabOrder = 19
+    TabOrder = 20
     OnKeyPress = C_MsgKeyPress
   end
   object LCon: TListBox
@@ -426,7 +426,7 @@ object Frm: TFrm
     Top = 64
     Width = 121
     Height = 21
-    TabOrder = 14
+    TabOrder = 15
     Text = 'User_Test'
   end
   object EdClientPort: TEdit
@@ -619,7 +619,7 @@ object Frm: TFrm
       8989898989CCCCCC8989E8E8E8E8E8E8E8E8E8E8E8818181E8E8898989898989
       89898989898989898989E8E8E8E8E8E8E8E8E8E8E8E8E8E8E8E8}
     NumGlyphs = 2
-    TabOrder = 16
+    TabOrder = 17
     TabStop = False
     OnClick = BtnSendPrintClick
   end
@@ -640,18 +640,31 @@ object Frm: TFrm
     Height = 89
     Style = lbOwnerDrawFixed
     ItemHeight = 18
-    TabOrder = 15
+    TabOrder = 16
     OnDrawItem = LUsersDrawItem
   end
+  object BtnStopReconnection: TBitBtn
+    Left = 704
+    Top = 64
+    Width = 113
+    Height = 25
+    Caption = 'Stop Reconnection'
+    TabOrder = 14
+    OnClick = BtnStopReconnectionClick
+  end
   object C: TDzTCPClient
     KeepAlive = True
+    AutoReconnect = True
+    AutoReconnectInterval = 5000
+    AutoReconnectAttempts = 3
     OnLoginRequest = CLoginRequest
     OnLoginResponse = CLoginResponse
     OnConnect = CConnect
     OnDisconnect = CDisconnect
     OnRead = CRead
     OnError = CError
     OnConnectionLost = CConnectionLost
+    OnReconnect = CReconnect
     Left = 640
     Top = 232
   end

diff --git a/Demos/MainDemo/UFrm.pas b/Demos/MainDemo/UFrm.pas
@@ -34,6 +34,7 @@   TFrm = class(TForm)
     LbServerLog: TLabel;
     LbClientLog: TLabel;
     Divider: TBevel;
+    BtnStopReconnection: TBitBtn;
     procedure FormCreate(Sender: TObject);
     procedure BtnOnServerClick(Sender: TObject);
     procedure BtnOffServerClick(Sender: TObject);
@@ -72,6 +73,9 @@   TFrm = class(TForm)
     procedure SClientLoginCheck(Sender: TObject; Socket: TDzSocket;
       var Accept: Boolean; const RequestData: string; var ResponseData: string);
     procedure SClientLoginSuccess(Sender: TObject; Socket: TDzSocket);
+    procedure BtnStopReconnectionClick(Sender: TObject);
+    procedure CReconnect(Sender: TObject; Socket: TDzSocket; Attempt: Integer;
+      var Cancel: Boolean);
   private
     procedure LogServer(const A: string);
     procedure LogClient(const A: string);
@@ -393,6 +397,8 @@ procedure TFrm.CConnect(Sender: TObject; Socket: TDzSocket);
   LogClient('Connected');
   if C.KeepAlive then
     LogClient(Format('KeepAlive enabled [%d ms]', [C.KeepAliveInterval]));
+  if C.AutoReconnect then
+    LogClient(Format('AutoReconnect enabled [%d ms]', [C.AutoReconnectInterval]));
 
   BtnClientDisconnect.Enabled := True;
 end;
@@ -416,6 +422,12 @@ procedure TFrm.CConnectionLost(Sender: TObject; Socket: TDzSocket);
   LogClient('Connection lost!');
 end;
 
+procedure TFrm.CReconnect(Sender: TObject; Socket: TDzSocket; Attempt: Integer;
+  var Cancel: Boolean);
+begin
+  LogClient(Format('Reconnecting... (Attempt %d)', [Attempt]));
+end;
+
 procedure TFrm.CDisconnect(Sender: TObject; Socket: TDzSocket;
   const WasConnected: Boolean);
 begin
@@ -525,4 +537,9 @@ procedure TFrm.BtnSendPrintClick(Sender: TObject);
   SendPrint;
 end;
 
+procedure TFrm.BtnStopReconnectionClick(Sender: TObject);
+begin
+  C.StopReconnection;
+end;
+
 end.