Add WebSocket client tracking, connection management, and targeted test messaging

emiMobileServer/Source/Main.dfm

@@ -46,7 +46,7 @@ object FMain: TFMain
         Left = 0
         Top = 0
         Width = 748
-        Height = 547
+        Height = 487
         Align = alClient
         DataSource = dsConnectedClients
         Options = [dgTitles, dgIndicator, dgColumnResize, dgColLines, dgRowLines, dgTabs, dgRowSelect, dgConfirmDelete, dgCancelOnExit, dgTitleClick, dgTitleHotTrack]
@@ -57,6 +57,59 @@ object FMain: TFMain
         TitleFont.Height = -11
         TitleFont.Name = 'Tahoma'
         TitleFont.Style = []
+        Columns = <
+          item
+            Expanded = False
+            FieldName = 'ConnectionId'
+            Visible = True
+          end
+          item
+            Expanded = False
+            FieldName = 'UserId'
+            Visible = True
+          end
+          item
+            Expanded = False
+            FieldName = 'ConnectedAt'
+            Width = 150
+            Visible = True
+          end>
+      end
+      object pnlConnectedClientsActions: TPanel
+        Left = 0
+        Top = 487
+        Width = 748
+        Height = 60
+        Align = alBottom
+        Caption = 'pnlConnectedClientsActions'
+        ShowCaption = False
+        TabOrder = 1
+        ExplicitTop = 467
+        object btnDisconnectClient: TButton
+          Left = 5
+          Top = 18
+          Width = 141
+          Height = 25
+          Caption = 'Disconnect Selected Client'
+          TabOrder = 0
+          OnClick = btnDisconnectClientClick
+        end
+        object edtClientMessage: TEdit
+          Left = 294
+          Top = 12
+          Width = 317
+          Height = 38
+          TabOrder = 1
+        end
+        object btnSendClientMessage: TButton
+          Left = 617
+          Top = 18
+          Width = 123
+          Height = 25
+          Caption = 'Send Client Message'
+          TabOrder = 2
+          OnClick = btnSendClientMessageClick
+        end
       end
     end
   end
@@ -89,13 +142,13 @@ object FMain: TFMain
   end
   object initTimer: TTimer
     OnTimer = initTimerTimer
-    Left = 30
-    Top = 466
+    Left = 448
+    Top = 4
   end
   object ExeInfo1: TExeInfo
     Version = '1.6.1.1'
-    Left = 32
-    Top = 530
+    Left = 572
+    Top = 4
   end
   object tblConnectedClients: TFDMemTable
     Active = True
@@ -103,12 +156,12 @@ object FMain: TFMain
       item
         Name = 'ConnectionId'
         DataType = ftString
-        Size = 20
+        Size = 50
       end
       item
         Name = 'UserId'
         DataType = ftString
-        Size = 20
+        Size = 30
       end
       item
         Name = 'ConnectedAt'
@@ -123,12 +176,12 @@ object FMain: TFMain
     UpdateOptions.CheckRequired = False
     UpdateOptions.AutoCommitUpdates = True
     StoreDefs = True
-    Left = 134
-    Top = 473
+    Left = 514
+    Top = 3
   end
   object dsConnectedClients: TDataSource
     DataSet = tblConnectedClients
-    Left = 136
-    Top = 527
+    Left = 378
+    Top = 7
   end
 end

emiMobileServer/Source/Main.pas

@@ -7,9 +7,7 @@ uses
   System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs,
   Vcl.StdCtrls, Vcl.ExtCtrls, System.Generics.Collections, System.IniFiles,
   Auth.Service, Auth.Server.Module, Api.Server.Module, App.Server.Module,
-  ExeInfo, Api.Service, Vcl.ComCtrls, WebSocket.Manager,
-  VCL.TMSFNCWebSocketCommon, VCL.TMSFNCCustomComponent,
-  VCL.TMSFNCWebSocketClient, WEBLib.WebSocketClient, FireDAC.Stan.Intf,
+  ExeInfo, Api.Service, Vcl.ComCtrls, WebSocket.Manager, FireDAC.Stan.Intf,
   FireDAC.Stan.Option, FireDAC.Stan.Param, FireDAC.Stan.Error, FireDAC.DatS,
   FireDAC.Phys.Intf, FireDAC.DApt.Intf, Data.DB, Vcl.Grids, Vcl.DBGrids,
   FireDAC.Comp.DataSet, FireDAC.Comp.Client;
@@ -28,16 +26,24 @@ type
     tblConnectedClients: TFDMemTable;
     dsConnectedClients: TDataSource;
     grdConnectedClients: TDBGrid;
+    pnlConnectedClientsActions: TPanel;
+    btnDisconnectClient: TButton;
+    edtClientMessage: TEdit;
+    btnSendClientMessage: TButton;
     procedure btnApiSwaggerUIClick(Sender: TObject);
     procedure btnExitClick(Sender: TObject);
     procedure ContactFormData(AText: String);
     procedure FormClose(Sender: TObject; var Action: TCloseAction);
     procedure initTimerTimer(Sender: TObject);
     procedure btnAuthSwaggerUIClick(Sender: TObject);
+    procedure btnDisconnectClientClick(Sender: TObject);
+    procedure btnSendClientMessageClick(Sender: TObject);
   strict private
     FWebSocketManager: TWebSocketManager;
     procedure StartServers;
     function LogValue(const LabelName: string; const Value: string; FromIni: Boolean): string;
+    procedure HandleConnectedClientsChanged;
+    procedure RefreshConnectedClients;
   private
     function LocalBrowserUrl(const Url: string): string;
   end;
@@ -64,6 +70,33 @@ begin
   Close;
 end;
 
+procedure TFMain.btnSendClientMessageClick(Sender: TObject);
+var
+  connectionId: string;
+begin
+  if tblConnectedClients.IsEmpty then
+    Exit;
+
+  if Trim(edtClientMessage.Text) = '' then
+    Exit;
+
+  connectionId := tblConnectedClients.FieldByName('ConnectionId').AsString;
+
+  FWebSocketManager.SendMessageToClient(connectionId, edtClientMessage.Text);
+end;
+
+procedure TFMain.btnDisconnectClientClick(Sender: TObject);
+var
+  connectionId: string;
+begin
+  if tblConnectedClients.IsEmpty then
+    Exit;
+
+  connectionId := tblConnectedClients.FieldByName('ConnectionId').AsString;
+
+  FWebSocketManager.DisconnectClient(connectionId);
+end;
+
 function TFMain.LocalBrowserUrl(const Url: string): string;
 begin
   Result := StringReplace(Url, '://0.0.0.0:', '://localhost:', [rfIgnoreCase]);
@@ -105,8 +138,11 @@ end;
 
 procedure TFMain.FormClose(Sender: TObject; var Action: TCloseAction);
 begin
-  FWebSocketManager.OnClientsChanged := nil;
-  FWebSocketManager.Free;
+  if Assigned(FWebSocketManager) then
+  begin
+    FWebSocketManager.OnClientsChanged := nil;
+    FreeAndNil(FWebSocketManager);
+  end;
 
   ServerConfig.Free;
   IniEntries.Free;
@@ -155,6 +191,7 @@ begin
     AppServerModule.StartAppServer(ServerConfig.url);
 
     FWebSocketManager := TWebSocketManager.Create;
+    FWebSocketManager.OnClientsChanged := HandleConnectedClientsChanged;
     FWebSocketManager.Start;
     Logger.Log(1, 'WebSocket server started on port 8091');
   except
@@ -163,6 +200,39 @@ begin
   end;
 end;
 
+procedure TFMain.HandleConnectedClientsChanged;
+begin
+  TThread.Queue(nil,
+    procedure
+    begin
+      RefreshConnectedClients;
+    end);
+end;
+
+procedure TFMain.RefreshConnectedClients;
+var
+  clients: TArray<TConnectedClientSnapshot>;
+  client: TConnectedClientSnapshot;
+begin
+  clients := FWebSocketManager.GetClientSnapshots;
+
+  tblConnectedClients.DisableControls;
+  try
+    tblConnectedClients.EmptyDataSet;
+
+    for client in clients do
+    begin
+      tblConnectedClients.Append;
+      tblConnectedClients.FieldByName('ConnectionId').AsString := client.ConnectionId;
+      tblConnectedClients.FieldByName('UserId').AsString := client.UserId;
+      tblConnectedClients.FieldByName('ConnectedAt').AsDateTime := client.ConnectedAt;
+      tblConnectedClients.Post;
+    end;
+  finally
+    tblConnectedClients.EnableControls;
+  end;
+end;
+
 
 end.
 

emiMobileServer/Source/WebSocket.Manager.pas

@@ -27,8 +27,7 @@ type
     property ConnectionId: string read FConnectionId write FConnectionId;
     property UserId: string read FUserId write FUserId;
     property ConnectedAt: TDateTime read FConnectedAt write FConnectedAt;
-    property Connection: TTMSFNCWebSocketServerConnection
-      read FConnection write FConnection;
+    property Connection: TTMSFNCWebSocketServerConnection read FConnection write FConnection;
   end;
 
   TClientsChangedEvent = procedure of object;
@@ -41,22 +40,20 @@ type
     FOnClientsChanged: TClientsChangedEvent;
 
     procedure NotifyClientsChanged;
-    procedure HandshakeResponseSent(Sender: TObject;
-      AConnection: TTMSFNCWebSocketServerConnection);
-    procedure MessageReceived(Sender: TObject;
-      AConnection: TTMSFNCWebSocketConnection; const AMessage: string);
-    procedure ClientDisconnected(Sender: TObject;
-      AConnection: TTMSFNCWebSocketConnection);
+    procedure HandshakeResponseSent(Sender: TObject; AConnection: TTMSFNCWebSocketServerConnection);
+    procedure MessageReceived(Sender: TObject; AConnection: TTMSFNCWebSocketConnection; const AMessage: string);
+    procedure ClientDisconnected(Sender: TObject; AConnection: TTMSFNCWebSocketConnection);
   public
     constructor Create;
     destructor Destroy; override;
 
     procedure Start;
     procedure Stop;
+    procedure DisconnectClient(const AConnectionId: string);
+    procedure SendMessageToClient(const AConnectionId, AText: string);
     function GetClientSnapshots: TArray<TConnectedClientSnapshot>;
 
-    property OnClientsChanged: TClientsChangedEvent
-      read FOnClientsChanged write FOnClientsChanged;
+    property OnClientsChanged: TClientsChangedEvent read FOnClientsChanged write FOnClientsChanged;
   end;
 
 implementation
@@ -102,14 +99,73 @@ begin
   FServer.Active := False;
 end;
 
+procedure TWebSocketManager.DisconnectClient(const AConnectionId: string);
+var
+  client: TConnectedClient;
+  connection: TTMSFNCWebSocketServerConnection;
+begin
+  connection := nil;
+
+  TMonitor.Enter(FClientsLock);
+  try
+    for client in FClients do
+    begin
+      if SameText(client.ConnectionId, AConnectionId) then
+      begin
+        connection := client.Connection;
+        Break;
+      end;
+    end;
+  finally
+    TMonitor.Exit(FClientsLock);
+  end;
+
+  if Assigned(connection) then
+    connection.SendClose;
+end;
+
+procedure TWebSocketManager.SendMessageToClient(const AConnectionId, AText: string);
+var
+  client: TConnectedClient;
+  connection: TTMSFNCWebSocketServerConnection;
+  json: TJSONObject;
+begin
+  connection := nil;
+
+  TMonitor.Enter(FClientsLock);
+  try
+    for client in FClients do
+    begin
+      if SameText(client.ConnectionId, AConnectionId) then
+      begin
+        connection := client.Connection;
+        Break;
+      end;
+    end;
+  finally
+    TMonitor.Exit(FClientsLock);
+  end;
+
+  if not Assigned(connection) then
+    Exit;
+
+  json := TJSONObject.Create;
+  try
+    json.AddPair('message', 'test_message');
+    json.AddPair('text', AText);
+    connection.Send(json.ToJSON);
+  finally
+    json.Free;
+  end;
+end;
+
 procedure TWebSocketManager.NotifyClientsChanged;
 begin
   if Assigned(FOnClientsChanged) then
     FOnClientsChanged;
 end;
 
-procedure TWebSocketManager.HandshakeResponseSent(Sender: TObject;
-  AConnection: TTMSFNCWebSocketServerConnection);
+procedure TWebSocketManager.HandshakeResponseSent(Sender: TObject; AConnection: TTMSFNCWebSocketServerConnection);
 var
   client: TConnectedClient;
   guid: TGUID;
@@ -135,8 +191,7 @@ begin
   NotifyClientsChanged;
 end;
 
-procedure TWebSocketManager.MessageReceived(Sender: TObject;
-  AConnection: TTMSFNCWebSocketConnection; const AMessage: string);
+procedure TWebSocketManager.MessageReceived(Sender: TObject; AConnection: TTMSFNCWebSocketConnection; const AMessage: string);
 var
   json: TJSONValue;
   messageType: string;
@@ -158,9 +213,7 @@ begin
     if not json.TryGetValue<string>('userId', userId) then
       Exit;
 
-    client := TConnectedClient(
-      TTMSFNCWebSocketServerConnection(AConnection).UserData
-    );
+    client := TConnectedClient(TTMSFNCWebSocketServerConnection(AConnection).UserData);
 
     if not Assigned(client) then
       Exit;
@@ -176,17 +229,14 @@ begin
       TMonitor.Exit(FClientsLock);
     end;
 
-    Logger.Log(1, 'WebSocket client identified: ' +
-      connectionId + ' - ' + userId);
-
+    Logger.Log(1, 'WebSocket client identified: ' + connectionId + ' - ' + userId);
     NotifyClientsChanged;
   finally
     json.Free;
   end;
 end;
 
-procedure TWebSocketManager.ClientDisconnected(Sender: TObject;
-  AConnection: TTMSFNCWebSocketConnection);
+procedure TWebSocketManager.ClientDisconnected(Sender: TObject; AConnection: TTMSFNCWebSocketConnection);
 var
   serverConnection: TTMSFNCWebSocketServerConnection;
   client: TConnectedClient;
@@ -210,14 +260,11 @@ begin
     TMonitor.Exit(FClientsLock);
   end;
 
-  Logger.Log(1, 'WebSocket client disconnected: ' +
-    connectionId + ' - ' + userId);
-
+  Logger.Log(1, 'WebSocket client disconnected: ' + connectionId + ' - ' + userId);
   NotifyClientsChanged;
 end;
 
-function TWebSocketManager.GetClientSnapshots:
-  TArray<TConnectedClientSnapshot>;
+function TWebSocketManager.GetClientSnapshots: TArray<TConnectedClientSnapshot>;
 var
   i: Integer;
 begin

emiMobileServer/bin/emiMobileServer.ini

 [Settings]
-LogFileNum=738
+LogFileNum=743
 webClientVersion=9.4.0
 
 [Database]

webEMIMobile/View.Main.pas

@@ -176,10 +176,20 @@ begin
   wsClient.Send(TJSJSON.stringify(msg));
 end;
 
-procedure TFViewMain.wsClientDataReceived(Sender: TObject; Origin: string;
-  SocketData: TJSObjectRecord);
+procedure TFViewMain.wsClientDataReceived(Sender: TObject; Origin: string; SocketData: TJSObjectRecord);
+var
+  messageObj: TJSObject;
+  messageType: string;
+  messageText: string;
 begin
-    console.log('WebSocket message received: ' + SocketData.jsObject.toString);
+  messageObj := TJSObject(TJSJSON.parse(SocketData.jsobject.toString));
+  messageType := string(messageObj['message']);
+
+  if messageType = 'test_message' then
+  begin
+    messageText := string(messageObj['text']);
+    window.alert(messageText);
+  end;
 end;
 
 procedure TFViewMain.wsClientDisconnect(Sender: TObject);