Add WebSocket push updates with PostgreSQL notification listener and client connection handling

emiMobile.groupproj

-<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
-    <PropertyGroup>
-        <ProjectGuid>{012E57DC-0378-4E45-B2F6-DFA72B2D10B1}</ProjectGuid>
-    </PropertyGroup>
-    <ItemGroup>
-        <Projects Include="emiMobileServer\emiMobileServer.dproj">
-            <Dependencies/>
-        </Projects>
-        <Projects Include="webEMIMobile\webEmiMobile.dproj">
-            <Dependencies/>
-        </Projects>
-    </ItemGroup>
-    <ProjectExtensions>
-        <Borland.Personality>Default.Personality.12</Borland.Personality>
-        <Borland.ProjectType/>
-        <BorlandProject>
-            <Default.Personality/>
-        </BorlandProject>
-    </ProjectExtensions>
-    <Target Name="emiMobileServer">
-        <MSBuild Projects="emiMobileServer\emiMobileServer.dproj"/>
-    </Target>
-    <Target Name="emiMobileServer:Clean">
-        <MSBuild Projects="emiMobileServer\emiMobileServer.dproj" Targets="Clean"/>
-    </Target>
-    <Target Name="emiMobileServer:Make">
-        <MSBuild Projects="emiMobileServer\emiMobileServer.dproj" Targets="Make"/>
-    </Target>
-    <Target Name="webEmiMobile">
-        <MSBuild Projects="webEMIMobile\webEmiMobile.dproj"/>
-    </Target>
-    <Target Name="webEmiMobile:Clean">
-        <MSBuild Projects="webEMIMobile\webEmiMobile.dproj" Targets="Clean"/>
-    </Target>
-    <Target Name="webEmiMobile:Make">
-        <MSBuild Projects="webEMIMobile\webEmiMobile.dproj" Targets="Make"/>
-    </Target>
-    <Target Name="Build">
-        <CallTarget Targets="emiMobileServer;webEmiMobile"/>
-    </Target>
-    <Target Name="Clean">
-        <CallTarget Targets="emiMobileServer:Clean;webEmiMobile:Clean"/>
-    </Target>
-    <Target Name="Make">
-        <CallTarget Targets="emiMobileServer:Make;webEmiMobile:Make"/>
-    </Target>
-    <Import Project="$(BDS)\Bin\CodeGear.Group.Targets" Condition="Exists('$(BDS)\Bin\CodeGear.Group.Targets')"/>
-</Project>

emiMobileServer/Source/Api.Database.dfm

@@ -1359,4 +1359,11 @@ object ApiDatabaseModule: TApiDatabaseModule
     Left = 162
     Top = 42
   end
+  object UniAlerter1: TUniAlerter
+    Connection = ucENTCAD
+    Events = 'disupdate'
+    OnEvent = UniAlerter1Event
+    Left = 324
+    Top = 382
+  end
 end

emiMobileServer/Source/Api.Database.pas

@@ -5,7 +5,8 @@ interface
 uses
   System.SysUtils, System.Classes, Data.DB, MemDS, DBAccess, Uni, UniProvider,
   PostgreSQLUniProvider, System.Variants, System.Generics.Collections, System.IniFiles,
-  Common.Logging, Vcl.Forms, System.Character, Common.Ini;
+  Common.Logging, Vcl.Forms, System.Character, Common.Ini, DAAlerter,
+  UniAlerter;
 
 type
   TApiDatabaseModule = class(TDataModule)
@@ -203,12 +204,16 @@ type
     uqMapUnitsagencytype: TStringField;
     uqUnitListagencytype: TStringField;
     uqMapComplaintscomplaint: TStringField;
+    UniAlerter1: TUniAlerter;
     procedure uqComplaintListCalcFields(DataSet: TDataSet);
     procedure uqMapComplaintsCalcFields(DataSet: TDataSet);
     procedure DataModuleCreate(Sender: TObject);
+    procedure UniAlerter1Event(Sender: TDAAlerter; const EventName,
+      Message: string);
   private
     { Private declarations }
   public
+    CADUpdate: Boolean;
     function HandleUniqueFilenames(const category: string): string;
     function BadgeCounts(const BaseQuery: TUniQuery): Integer;
   end;
@@ -225,6 +230,8 @@ implementation
 
 procedure TApiDatabaseModule.DataModuleCreate(Sender: TObject);
 begin
+  CADUpdate := False;
+
   ucENTCAD.ProviderName := 'PostgreSQL';
   ucENTCAD.Server := IniEntries.DatabaseServer;
   ucENTCAD.Port := IniEntries.DatabasePort;
@@ -238,6 +245,10 @@ begin
 
   ucENTCAD.ExecSQL('set search_path to lems, avl, entcad, public');
   Logger.Log(2, 'PostgreSQL API search_path set to lems, avl, entcad, public');
+
+  Logger.Log(1, 'Starting PostgreSQL disupdate listener');
+  UniAlerter1.Start;
+  Logger.Log(1, 'PostgreSQL disupdate listener started');
 end;
 
 procedure TApiDatabaseModule.uqComplaintListCalcFields(DataSet: TDataSet);
@@ -307,6 +318,12 @@ begin
 end;
 
 
+procedure TApiDatabaseModule.UniAlerter1Event(Sender: TDAAlerter; const EventName, Message: string);
+begin
+  if SameText(EventName, 'disupdate') then
+    CADUpdate := True;
+end;
+
 function TApiDatabaseModule.BadgeCounts(const BaseQuery: TUniQuery): Integer;
 var
   Q: TUniQuery;

emiMobileServer/Source/Main.dfm

@@ -23,7 +23,6 @@ object FMain: TFMain
     ActivePage = tabConnectedClients
     Anchors = [akLeft, akTop, akRight, akBottom]
     TabOrder = 3
-    ExplicitHeight = 552
     object tabServerLog: TTabSheet
       Caption = 'Server Log'
       object memoInfo: TMemo
@@ -36,7 +35,6 @@ object FMain: TFMain
         ScrollBars = ssVertical
         TabOrder = 0
         WordWrap = False
-        ExplicitHeight = 524
       end
     end
     object tabConnectedClients: TTabSheet
@@ -84,7 +82,6 @@ object FMain: TFMain
         Caption = 'pnlConnectedClientsActions'
         ShowCaption = False
         TabOrder = 1
-        ExplicitTop = 467
         object btnDisconnectClient: TButton
           Left = 5
           Top = 18
@@ -98,7 +95,7 @@ object FMain: TFMain
           Left = 294
           Top = 12
           Width = 317
-          Height = 38
+          Height = 21
           TabOrder = 1
         end
         object btnSendClientMessage: TButton
@@ -141,50 +138,9 @@ object FMain: TFMain
     TabOrder = 2
     OnClick = btnAuthSwaggerUIClick
   end
-  object pgcMain: TPageControl
-    Left = 8
-    Top = 39
-    Width = 784
-    Height = 573
-    Anchors = [akLeft, akTop, akRight, akBottom]
-    TabOrder = 3
-    object tabLog: TTabSheet
-      Caption = 'Log'
-      object memoInfo: TMemo
-        Left = 0
-        Top = 0
-        Width = 776
-        Height = 545
-        Align = alClient
-        ReadOnly = True
-        TabOrder = 0
-      end
-    end
-    object tabClients: TTabSheet
-      Caption = 'Connected Clients'
-      object sgClients: TStringGrid
-        Left = 0
-        Top = 0
-        Width = 776
-        Height = 545
-        Align = alClient
-        ColCount = 3
-        DefaultColWidth = 220
-        DefaultRowHeight = 20
-        FixedCols = 0
-        RowCount = 2
-        Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goColSizing]
-        TabOrder = 0
-        ColWidths = (
-          200
-          200
-          176)
-      end
-    end
-  end
   object initTimer: TTimer
     OnTimer = initTimerTimer
-    Left = 448
+    Left = 422
     Top = 4
   end
   object ExeInfo1: TExeInfo
@@ -218,12 +174,12 @@ object FMain: TFMain
     UpdateOptions.CheckRequired = False
     UpdateOptions.AutoCommitUpdates = True
     StoreDefs = True
-    Left = 514
-    Top = 3
+    Left = 490
+    Top = 5
   end
   object dsConnectedClients: TDataSource
     DataSet = tblConnectedClients
-    Left = 378
+    Left = 352
     Top = 7
   end
 end

emiMobileServer/Source/Main.pas

@@ -3,15 +3,17 @@ unit Main;
 interface
 
 uses
-  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, Winapi.ShellApi,
-  System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs,
-  Vcl.StdCtrls, Vcl.ExtCtrls, Vcl.ComCtrls, Vcl.Grids,
-  System.Generics.Collections, System.IniFiles,
+  Winapi.Windows, Winapi.Messages, Winapi.ShellApi,
+  System.SysUtils, System.Variants, System.Classes, System.Generics.Collections,
+  System.IniFiles,
+  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls,
+  Vcl.ExtCtrls, Vcl.ComCtrls, Vcl.Grids, Vcl.DBGrids,
+  Data.DB,
+  FireDAC.Stan.Intf, FireDAC.Stan.Option, FireDAC.Stan.Param,
+  FireDAC.Stan.Error, FireDAC.DatS, FireDAC.Phys.Intf, FireDAC.DApt.Intf,
+  FireDAC.Comp.DataSet, FireDAC.Comp.Client,
   Auth.Service, Auth.Server.Module, Api.Server.Module, App.Server.Module,
-  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, Ws.Server.Module;
+  ExeInfo, Api.Service, WebSocket.Manager, Ws.Server.Module;
 
 type
   TFMain = class(TForm)
@@ -33,21 +35,19 @@ type
     btnSendClientMessage: TButton;
     procedure btnApiSwaggerUIClick(Sender: TObject);
     procedure btnExitClick(Sender: TObject);
-    procedure ContactFormData(AText: String);
+    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;
-    procedure RefreshClientList;
-    function LogValue(const LabelName: string; const Value: string; FromIni: Boolean): string;
     procedure HandleConnectedClientsChanged;
     procedure RefreshConnectedClients;
+    function LogValue(LabelName: string; Value: string; FromIni: Boolean): string;
   private
-    function LocalBrowserUrl(const Url: string): string;
+    function LocalBrowserUrl(Url: string): string;
   end;
 
 var
@@ -65,8 +65,6 @@ uses
 
 {$R *.dfm}
 
-{ --- Event Handlers --- }
-
 procedure TFMain.btnExitClick(Sender: TObject);
 begin
   Close;
@@ -76,6 +74,9 @@ procedure TFMain.btnSendClientMessageClick(Sender: TObject);
 var
   connectionId: string;
 begin
+  if not Assigned(WsServerModule) then
+    Exit;
+
   if tblConnectedClients.IsEmpty then
     Exit;
 
@@ -83,23 +84,24 @@ begin
     Exit;
 
   connectionId := tblConnectedClients.FieldByName('ConnectionId').AsString;
-
-  FWebSocketManager.SendMessageToClient(connectionId, edtClientMessage.Text);
+  WsServerModule.SendMessageToClient(connectionId, edtClientMessage.Text);
 end;
 
 procedure TFMain.btnDisconnectClientClick(Sender: TObject);
 var
   connectionId: string;
 begin
+  if not Assigned(WsServerModule) then
+    Exit;
+
   if tblConnectedClients.IsEmpty then
     Exit;
 
   connectionId := tblConnectedClients.FieldByName('ConnectionId').AsString;
-
-  FWebSocketManager.DisconnectClient(connectionId);
+  WsServerModule.DisconnectClient(connectionId);
 end;
 
-function TFMain.LocalBrowserUrl(const Url: string): string;
+function TFMain.LocalBrowserUrl(Url: string): string;
 begin
   Result := StringReplace(Url, '://0.0.0.0:', '://localhost:', [rfIgnoreCase]);
 end;
@@ -120,18 +122,27 @@ begin
   ShellExecute(Handle, 'open', PChar(LocalBrowserUrl(url)), nil, nil, SW_SHOWNORMAL);
 end;
 
-procedure TFMain.ContactFormData(AText: String);
+procedure TFMain.ContactFormData(AText: string);
 begin
   if memoInfo.CanFocus then
-    TThread.Queue(nil, procedure begin memoInfo.Lines.Add(AText); end)
+    TThread.Queue(nil,
+      procedure
+      begin
+        memoInfo.Lines.Add(AText);
+      end)
   else
-    TThread.Synchronize(nil, procedure begin memoInfo.Lines.Add(AText); end);
+    TThread.Synchronize(nil,
+      procedure
+      begin
+        memoInfo.Lines.Add(AText);
+      end);
 end;
 
 procedure TFMain.initTimerTimer(Sender: TObject);
 begin
   initTimer.Enabled := False;
   Caption := Caption + ' ver ' + ExeInfo1.FileVersion;
+
   ServerConfig := TServerConfig.Create;
   LoadIniEntries;
   LoadServerConfig;
@@ -140,48 +151,18 @@ end;
 
 procedure TFMain.FormClose(Sender: TObject; var Action: TCloseAction);
 begin
-if Assigned(WsServerModule) then
-  WsServerModule.OnClientsChanged := nil;
-
-  ServerConfig.Free;
-  IniEntries.Free;
-  AuthServerModule.Free;
-  ApiServerModule.Free;
-  AppServerModule.Free;
-  WsServerModule.Free;
+  if Assigned(WsServerModule) then
+    WsServerModule.OnClientsChanged := nil;
+
+  FreeAndNil(WsServerModule);
+  FreeAndNil(AppServerModule);
+  FreeAndNil(ApiServerModule);
+  FreeAndNil(AuthServerModule);
+  FreeAndNil(IniEntries);
+  FreeAndNil(ServerConfig);
 end;
 
-{ --- Connected Client List --- }
-
-procedure TFMain.RefreshClientList;
-var
-  snapshots: TArray<TConnectedClientSnapshot>;
-  i: Integer;
-begin
-  snapshots := WsServerModule.GetClientSnapshots;
-
-  sgClients.RowCount := Length(snapshots) + 1;  // +1 for header row
-
-  // Header
-  sgClients.Cells[0, 0] := 'Connection ID';
-  sgClients.Cells[1, 0] := 'User ID';
-  sgClients.Cells[2, 0] := 'Connected At';
-
-  for i := 0 to Length(snapshots) - 1 do
-  begin
-    sgClients.Cells[0, i + 1] := snapshots[i].ConnectionId;
-    sgClients.Cells[1, i + 1] := snapshots[i].UserId;
-    sgClients.Cells[2, i + 1] :=
-      FormatDateTime('yyyy-mm-dd hh:nn:ss', snapshots[i].ConnectedAt);
-  end;
-
-  tabClients.Caption :=
-    Format('Connected Clients (%d)', [Length(snapshots)]);
-end;
-
-{ --- Helpers --- }
-
-function TFMain.LogValue(const LabelName: string; const Value: string; FromIni: Boolean): string;
+function TFMain.LogValue(LabelName: string; Value: string; FromIni: Boolean): string;
 begin
   Result := LabelName + ': ' + Value + IfThen(FromIni, ' [from ini]', ' [default]');
 end;
@@ -202,26 +183,26 @@ begin
 
   Logger.Log(1, '');
   Logger.Log(1, '--- URLs ---');
+
   try
     AuthServerModule := TAuthServerModule.Create(Self);
-    AuthServerModule.StartAuthServer(ServerConfig.url, AUTH_MODEL);
+    AuthServerModule.StartAuthServer(ServerConfig.Url, AUTH_MODEL);
 
     ApiServerModule := TApiServerModule.Create(Self);
-    ApiServerModule.StartApiServer(ServerConfig.url, API_MODEL);
+    ApiServerModule.StartApiServer(ServerConfig.Url, API_MODEL);
 
     AppServerModule := TAppServerModule.Create(Self);
-    AppServerModule.StartAppServer(ServerConfig.url);
+    AppServerModule.StartAppServer(ServerConfig.Url);
 
     WsServerModule := TWsServerModule.Create(Self);
-    FWsServerModule.OnClientsChanged := HandleConnectedClientsChanged;
-    FWsServerModule.StartWsServer(ServerConfig.Url, WS_MODEL);
+    WsServerModule.OnClientsChanged := HandleConnectedClientsChanged;
+    WsServerModule.StartWsServer;
   except
     on E: Exception do
       Logger.Log(2, 'Failed to start server modules: ' + E.Message);
   end;
 
-  // Initialise the grid headers even before any client connects.
-  RefreshClientList;
+  RefreshConnectedClients;
 end;
 
 procedure TFMain.HandleConnectedClientsChanged;
@@ -237,4 +218,29 @@ procedure TFMain.RefreshConnectedClients;
 var
   clients: TArray<TConnectedClientSnapshot>;
   client: TConnectedClientSnapshot;
-begin
+begin
\ No newline at end of file
+  if not Assigned(WsServerModule) then
+    Exit;
+
+  clients := WsServerModule.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;
+
+  tabConnectedClients.Caption := Format('Connected Clients (%d)', [Length(clients)]);
+end;
+
+end.

emiMobileServer/Source/WebSocket.Manager.pas

+unit WebSocket.Manager;
+
+interface
+
+uses
+  System.Classes,
+  System.SysUtils,
+  System.JSON,
+  System.Generics.Collections,
+  VCL.TMSFNCWebSocketServer,
+  VCL.TMSFNCWebSocketCommon;
+
+const
+  WEBSOCKET_PORT = 8091;
+
+type
+  TConnectedClientSnapshot = record
+    ConnectionId: string;
+    UserId: string;
+    ConnectedAt: TDateTime;
+  end;
+
+  TConnectedClient = class
+  private
+    FConnectionId: string;
+    FUserId: string;
+    FConnectedAt: TDateTime;
+    FConnection: TTMSFNCWebSocketServerConnection;
+  public
+    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;
+  end;
+
+  TClientsChangedEvent = procedure of object;
+
+  TWebSocketManager = class
+  private
+    FServer: TTMSFNCWebSocketServer;
+    FClients: TObjectList<TConnectedClient>;
+    FClientsLock: TObject;
+    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);
+  public
+    constructor Create;
+    destructor Destroy; override;
+
+    procedure Start;
+    procedure Stop;
+    procedure Broadcast(AMessage: string);
+    procedure DisconnectClient(AConnectionId: string);
+    procedure SendMessageToClient(AConnectionId, AText: string);
+    function GetClientSnapshots: TArray<TConnectedClientSnapshot>;
+
+    property OnClientsChanged: TClientsChangedEvent read FOnClientsChanged write FOnClientsChanged;
+  end;
+
+implementation
+
+uses
+  Common.Logging;
+
+constructor TWebSocketManager.Create;
+begin
+  inherited Create;
+
+  FClientsLock := TObject.Create;
+  FClients := TObjectList<TConnectedClient>.Create(True);
+
+  FServer := TTMSFNCWebSocketServer.Create;
+  FServer.Port := WEBSOCKET_PORT;
+  FServer.UseSSL := False;
+  FServer.OnHandshakeResponseSent := HandshakeResponseSent;
+  FServer.OnMessageReceived := MessageReceived;
+  FServer.OnDisconnect := ClientDisconnected;
+end;
+
+destructor TWebSocketManager.Destroy;
+begin
+  Stop;
+  FServer.Free;
+  FClients.Free;
+  FClientsLock.Free;
+
+  inherited;
+end;
+
+procedure TWebSocketManager.Start;
+begin
+  FServer.Active := True;
+end;
+
+procedure TWebSocketManager.Stop;
+begin
+  FServer.Active := False;
+end;
+
+procedure TWebSocketManager.Broadcast(AMessage: string);
+var
+  connections: TArray<TTMSFNCWebSocketServerConnection>;
+  i: Integer;
+begin
+  TMonitor.Enter(FClientsLock);
+  try
+    SetLength(connections, FClients.Count);
+
+    for i := 0 to FClients.Count - 1 do
+      connections[i] := FClients[i].Connection;
+  finally
+    TMonitor.Exit(FClientsLock);
+  end;
+
+  for i := 0 to Length(connections) - 1 do
+  begin
+    try
+      connections[i].Send(AMessage);
+    except
+      on E: Exception do
+        Logger.Log(2, 'WebSocket broadcast failed: ' + E.Message);
+    end;
+  end;
+end;
+
+procedure TWebSocketManager.DisconnectClient(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(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);
+var
+  client: TConnectedClient;
+  guid: TGUID;
+begin
+  CreateGUID(guid);
+
+  client := TConnectedClient.Create;
+  client.ConnectionId := GUIDToString(guid);
+  client.ConnectedAt := Now;
+  client.Connection := AConnection;
+
+  TMonitor.Enter(FClientsLock);
+  try
+    FClients.Add(client);
+  finally
+    TMonitor.Exit(FClientsLock);
+  end;
+
+  AConnection.OwnsUserData := False;
+  AConnection.UserData := client;
+
+  Logger.Log(1, 'WebSocket client connected: ' + client.ConnectionId);
+  NotifyClientsChanged;
+end;
+
+procedure TWebSocketManager.MessageReceived(Sender: TObject; AConnection: TTMSFNCWebSocketConnection; const AMessage: string);
+var
+  json: TJSONValue;
+  messageType: string;
+  userId: string;
+  connectionId: string;
+  client: TConnectedClient;
+begin
+  json := TJSONObject.ParseJSONValue(AMessage);
+  try
+    if not Assigned(json) then
+      Exit;
+
+    if not json.TryGetValue<string>('message', messageType) then
+      Exit;
+
+    if messageType <> 'identify' then
+      Exit;
+
+    if not json.TryGetValue<string>('userId', userId) then
+      Exit;
+
+    client := TConnectedClient(TTMSFNCWebSocketServerConnection(AConnection).UserData);
+
+    if not Assigned(client) then
+      Exit;
+
+    TMonitor.Enter(FClientsLock);
+    try
+      if FClients.IndexOf(client) < 0 then
+        Exit;
+
+      client.UserId := userId;
+      connectionId := client.ConnectionId;
+    finally
+      TMonitor.Exit(FClientsLock);
+    end;
+
+    Logger.Log(1, 'WebSocket client identified: ' + connectionId + ' - ' + userId);
+    NotifyClientsChanged;
+  finally
+    json.Free;
+  end;
+end;
+
+procedure TWebSocketManager.ClientDisconnected(Sender: TObject; AConnection: TTMSFNCWebSocketConnection);
+var
+  serverConnection: TTMSFNCWebSocketServerConnection;
+  client: TConnectedClient;
+  connectionId: string;
+  userId: string;
+begin
+  serverConnection := TTMSFNCWebSocketServerConnection(AConnection);
+  client := TConnectedClient(serverConnection.UserData);
+
+  if not Assigned(client) then
+    Exit;
+
+  connectionId := client.ConnectionId;
+  userId := client.UserId;
+  serverConnection.UserData := nil;
+
+  TMonitor.Enter(FClientsLock);
+  try
+    FClients.Remove(client);
+  finally
+    TMonitor.Exit(FClientsLock);
+  end;
+
+  Logger.Log(1, 'WebSocket client disconnected: ' + connectionId + ' - ' + userId);
+  NotifyClientsChanged;
+end;
+
+function TWebSocketManager.GetClientSnapshots: TArray<TConnectedClientSnapshot>;
+var
+  i: Integer;
+begin
+  TMonitor.Enter(FClientsLock);
+  try
+    SetLength(Result, FClients.Count);
+
+    for i := 0 to FClients.Count - 1 do
+    begin
+      Result[i].ConnectionId := FClients[i].ConnectionId;
+      Result[i].UserId := FClients[i].UserId;
+      Result[i].ConnectedAt := FClients[i].ConnectedAt;
+    end;
+  finally
+    TMonitor.Exit(FClientsLock);
+  end;
+end;
+
+end.
\ No newline at end of file

emiMobileServer/Source/Ws.DataModel.pas

-unit Ws.DataModel;
+unit Ws.DataModel;
 
 // Server-side WebSocket data model.
 // Owns a VCL timer that fires every FIntervalMs milliseconds, queries the
@@ -39,7 +39,7 @@ type
     function BuildUnitListJson: string;
     function BuildComplaintListJson: string;
   public
-    constructor Create(ABroadcast: TWsBroadcastProc; AIntervalMs: Integer = 30000);
+    constructor Create(ABroadcast: TWsBroadcastProc; AIntervalMs: Integer = 5000);
     destructor Destroy; override;
   end;
 
@@ -71,6 +71,10 @@ end;
 
 procedure TWsDataModel.TimerFire(Sender: TObject);
 begin
+  if not FDb.CADUpdate then
+    Exit;
+
+  FDb.CADUpdate := False;
   BroadcastAll;
 end;
 
@@ -247,6 +251,7 @@ begin
 
         complaintId := FDb.uqMapComplaintsCOMPLAINTID.AsString;
         item.AddPair('ComplaintId',           complaintId);
+        item.AddPair('Complaint',             FDb.uqMapComplaintsCOMPLAINT.AsString);
         item.AddPair('DispatchDistrict',      FDb.uqMapComplaintsDISPATCHDISTRICT.AsString);
         item.AddPair('Agency',                FDb.uqMapComplaintsAGENCY.AsString);
         item.AddPair('AgencyName',            FDb.uqMapComplaintsAGENCY_NAME.AsString);

emiMobileServer/Source/Ws.Server.Module.dfm

 object WsServerModule: TWsServerModule
-  OldCreateOrder = False
   OnCreate = DataModuleCreate
   OnDestroy = DataModuleDestroy
   Height = 150

emiMobileServer/Source/Ws.Server.Module.pas

@@ -17,11 +17,12 @@ type
     function GetOnClientsChanged: TClientsChangedEvent;
     procedure SetOnClientsChanged(const AValue: TClientsChangedEvent);
   public
-    procedure StartWsServer(ABaseUrl: string; AModelName: string);
+    procedure StartWsServer;
     procedure Broadcast(const AMessage: string);
     function GetClientSnapshots: TArray<TConnectedClientSnapshot>;
-    property OnClientsChanged: TClientsChangedEvent
-      read GetOnClientsChanged write SetOnClientsChanged;
+    property OnClientsChanged: TClientsChangedEvent read GetOnClientsChanged write SetOnClientsChanged;
+    procedure DisconnectClient(AConnectionId: string);
+    procedure SendMessageToClient(AConnectionId, AText: string);
   end;
 
 var
@@ -48,7 +49,7 @@ begin
   FManager := nil;
 end;
 
-procedure TWsServerModule.StartWsServer(ABaseUrl: string; AModelName: string);
+procedure TWsServerModule.StartWsServer;
 begin
   FManager.Start;
   Logger.Log(1, Format('WebSocket server listening on port %d', [WEBSOCKET_PORT]));
@@ -58,9 +59,9 @@ begin
     begin
       Broadcast(AMessage);
     end,
-    30000  // broadcast interval in ms
+    5000 // notification check interval in ms
   );
-  Logger.Log(1, 'WsDataModel started (30 s broadcast interval)');
+  Logger.Log(1, 'WsDataModel started (5 s notification check interval)');
 end;
 
 procedure TWsServerModule.Broadcast(const AMessage: string);
@@ -68,6 +69,16 @@ begin
   FManager.Broadcast(AMessage);
 end;
 
+procedure TWsServerModule.DisconnectClient(AConnectionId: string);
+begin
+  FManager.DisconnectClient(AConnectionId);
+end;
+
+procedure TWsServerModule.SendMessageToClient(AConnectionId, AText: string);
+begin
+  FManager.SendMessageToClient(AConnectionId, AText);
+end;
+
 function TWsServerModule.GetClientSnapshots: TArray<TConnectedClientSnapshot>;
 begin
   Result := FManager.GetClientSnapshots;

emiMobileServer/bin/emiMobileServer.ini

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

emiMobileServer/emiMobileServer.dproj

-<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
+<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
     <PropertyGroup>
         <ProjectGuid>{2A3028D9-BC39-4625-9BA5-0338012E2824}</ProjectGuid>
         <ProjectVersion>20.4</ProjectVersion>
@@ -871,6 +871,9 @@
                     <Platform Name="Win64x">
                         <Operation>1</Operation>
                     </Platform>
+                    <Platform Name="WinARM64EC">
+                        <Operation>1</Operation>
+                    </Platform>
                 </DeployClass>
                 <DeployClass Name="ProjectiOSDeviceDebug">
                     <Platform Name="iOSDevice32">
@@ -941,6 +944,10 @@
                         <RemoteDir>Assets</RemoteDir>
                         <Operation>1</Operation>
                     </Platform>
+                    <Platform Name="WinARM64EC">
+                        <RemoteDir>Assets</RemoteDir>
+                        <Operation>1</Operation>
+                    </Platform>
                 </DeployClass>
                 <DeployClass Name="UWP_DelphiLogo44">
                     <Platform Name="Win32">
@@ -951,6 +958,10 @@
                         <RemoteDir>Assets</RemoteDir>
                         <Operation>1</Operation>
                     </Platform>
+                    <Platform Name="WinARM64EC">
+                        <RemoteDir>Assets</RemoteDir>
+                        <Operation>1</Operation>
+                    </Platform>
                 </DeployClass>
                 <DeployClass Name="iOS_AppStore1024">
                     <Platform Name="iOSDevice64">

webEMIMobile/ConnectionModule.pas

@@ -20,7 +20,7 @@ type
     FWsUrl: string;
   public
     property WsUrl: string read FWsUrl;
-    const clientVersion = '0.1.0';
+    const clientVersion = '9.4.0';
     procedure InitApp(SuccessProc: TSuccessProc;
       UnauthorizedAccessProc: TUnauthorizedAccessProc);
     procedure SetClientConfig(Callback: TVersionCheckCallback);

webEMIMobile/Module.Websocket.dfm

 object dmWebsocket: TdmWebsocket
+  OnCreate = WebDataModuleCreate
+  OnDestroy = WebDataModuleDestroy
   Height = 480
   Width = 640
   object EMiMobileWebSocketClient: TWebSocketClient
@@ -6,7 +8,6 @@ object dmWebsocket: TdmWebsocket
     Port = 443
     HostName = 'webapps.em-sys.net'
     PathName = '/emiMobile/ws/emimobile'
-    Protocols.Strings = ()
     OnConnect = EMiMobileWebSocketClientConnect
     OnBinaryDataReceived = EMiMobileWebSocketClientBinaryDataReceived
     OnDisconnect = EMiMobileWebSocketClientDisconnect

webEMIMobile/Module.Websocket.pas

-unit Module.Websocket;
+unit Module.Websocket;
 
 interface
 
@@ -11,6 +11,8 @@ type
   TWsDataHandler = procedure(aData: TJSObject) of object;
 
   TdmWebsocket = class(TWebDataModule)
+    procedure WebDataModuleCreate(Sender: TObject);
+    procedure WebDataModuleDestroy(Sender: TObject);
 
   private
     procedure EMiMobileWebSocketClientConnect(Sender: TObject);
@@ -32,7 +34,6 @@ type
 
   public
     EMiMobileWebSocketClient: TWebSocketClient;
-    procedure DataModuleCreate(Sender: TObject);
     procedure Connect(const AWsUrl: string);
 
     // Assign these before calling Connect so that pushes are routed immediately.
@@ -53,11 +54,6 @@ implementation
 
 {$R *.dfm}
 
-procedure TdmWebsocket.DataModuleCreate(Sender: TObject);
-begin
-
-end;
-
 procedure TdmWebsocket.Connect(const AWsUrl: string);
 var
   Rest, HostPort, Scheme, Path, Token: string;
@@ -116,23 +112,31 @@ begin
       EMiMobileWebSocketClient.Port := 80;
   end;
 
+  console.log('WS: connecting to ' + AWsUrl);
+
   EMiMobileWebSocketClient.UseSSL := (Scheme = 'wss');
   EMiMobileWebSocketClient.Active := True;
+
+  console.log('WS: Active set to true');
 end;
 
 procedure TdmWebsocket.DispatchMessage(const AMessage: string);
 var
   obj: TJSObject;
   requestId: string;
+  messageType: string;
+  messageText: string;
 begin
   if AMessage = '' then
     Exit;
 
   asm
-    try {
-      obj = JSON.parse(AMessage);
-    } catch(e) {
-      obj = null;
+    {
+      try {
+        obj = JSON.parse(AMessage);
+      } catch(e) {
+        obj = null;
+      }
     }
   end;
 
@@ -142,8 +146,20 @@ begin
     Exit;
   end;
 
+  messageType := string(obj['message']);
+
+  if SameText(messageType, 'test_message') then
+  begin
+    messageText := string(obj['text']);
+    window.alert(messageText);
+    Exit;
+  end;
+
   requestId := string(obj['RequestId']);
 
+  if requestId <> '' then
+    console.log('WS: received ' + requestId);
+
   if SameText(requestId, 'BADGE_COUNTS') then
   begin
     if Assigned(FOnBadgeCounts) then FOnBadgeCounts(obj);
@@ -175,8 +191,16 @@ begin
 end;
 
 procedure TdmWebsocket.EMiMobileWebSocketClientConnect(Sender: TObject);
+var
+  msg: TJSObject;
 begin
   console.log('WS: connected');
+
+  msg := TJSObject.new;
+  msg['message'] := 'identify';
+  msg['userId'] := JS.toString(AuthService.TokenPayload.Properties['user_name']);
+
+  EMiMobileWebSocketClient.Send(TJSJSON.stringify(msg));
 end;
 
 procedure TdmWebsocket.EMiMobileWebSocketClientDataReceived(Sender: TObject;
@@ -196,4 +220,18 @@ begin
   DispatchMessage(AMessage);
 end;
 
+procedure TdmWebsocket.WebDataModuleCreate(Sender: TObject);
+begin
+  console.log('WS: datamodule created');
+
+  EMiMobileWebSocketClient.OnConnect := EMiMobileWebSocketClientConnect;
+  EMiMobileWebSocketClient.OnDisconnect := EMiMobileWebSocketClientDisconnect;
+  EMiMobileWebSocketClient.OnMessageReceived := EMiMobileWebSocketClientMessageReceived;
+end;
+
+procedure TdmWebsocket.WebDataModuleDestroy(Sender: TObject);
+begin
+
+end;
+
 end.

webEMIMobile/View.Main.dfm

@@ -238,13 +238,4 @@ object FViewMain: TFViewMain
     Left = 42
     Top = 434
   end
-  object wsClient: TWebSocketClient
-    Port = 8091
-    HostName = '127.0.0.1'
-    OnConnect = wsClientConnect
-    OnDisconnect = wsClientDisconnect
-    OnDataReceived = wsClientDataReceived
-    Left = 62
-    Top = 654
-  end
 end

webEMIMobile/View.Main.pas

-unit View.Main;
+unit View.Main;
 
 interface
 

webEMIMobile/config/config.json

@@ -2,5 +2,5 @@
   "AuthUrl" : "http://localhost:2009/emimobile/auth/",
   "ApiUrl" : "http://localhost:2009/emimobile/api/",
   "AppUrl" : "http://localhost:2009/emimobile/app/",
-  "WsUrl"  : "ws://localhost:2009/emiMobile/ws/emimobile"
+  "WsUrl": "ws://localhost:8091/"
 }