websocket progress

emiMobileServer/Source/Ws.Server.Module.pas

@@ -5,7 +5,8 @@ interface
 uses
   System.SysUtils, System.Classes,
   IdContext,
-  WebSocketServer;
+  WebSocketServer,
+  Ws.DataModel;
 
 type
   TWsServerModule = class(TDataModule)
@@ -13,6 +14,7 @@ type
     procedure DataModuleDestroy(Sender: TObject);
   private
     FServer: TWebSocketServer;
+    FDataModel: TWsDataModel;
     procedure DoConnect(AContext: TIdContext);
     procedure DoDisconnect(AContext: TIdContext);
     procedure DoExecute(AContext: TIdContext);
@@ -55,6 +57,9 @@ end;
 
 procedure TWsServerModule.DataModuleDestroy(Sender: TObject);
 begin
+  FDataModel.Free;
+  FDataModel := nil;
+
   if Assigned(FServer) then
   begin
     FServer.Active := False;
@@ -97,6 +102,15 @@ begin
   FServer.DefaultPort := WS_PORT;
   FServer.Active := True;
   Logger.Log(1, Format('WebSocket server listening on ws://0.0.0.0:%d/', [WS_PORT]));
+
+  FDataModel := TWsDataModel.Create(
+    procedure(const AMessage: string)
+    begin
+      Broadcast(AMessage);
+    end,
+    30000  // broadcast interval in ms
+  );
+  Logger.Log(1, 'WsDataModel started (30 s broadcast interval)');
 end;
 
 procedure TWsServerModule.Broadcast(const AMessage: string);

emiMobileServer/Source/shared/WsMessages.pas

+unit WsMessages;
+
+// WebSocket push message types.
+// Each constant is the value of RequestId that identifies the message kind.
+// Server builds and broadcasts; client dispatches on RequestId.
+
+interface
+
+uses
+  BaseRequest, Pkg.Json.DTO, REST.Json.Types;
+
+{$M+}
+
+const
+  WS_MSG_BADGE_COUNTS   = 'BADGE_COUNTS';
+  WS_MSG_UNIT_MAP       = 'UNIT_MAP';
+  WS_MSG_COMPLAINT_MAP  = 'COMPLAINT_MAP';
+  WS_MSG_UNIT_LIST      = 'UNIT_LIST';
+  WS_MSG_COMPLAINT_LIST = 'COMPLAINT_LIST';
+
+type
+  // Simple typed DTO — serialized directly via AsJson for broadcast.
+  TWsBadgeCountsMessage = class(TRequest)
+  private
+    FBadgeComplaints: Integer;
+    FBadgeUnits: Integer;
+  published
+    property BadgeComplaints: Integer read FBadgeComplaints write FBadgeComplaints;
+    property BadgeUnits: Integer read FBadgeUnits write FBadgeUnits;
+  public
+    constructor Create;
+  end;
+
+  // Array-payload messages: server adds RequestId to the existing TJSONObject
+  // produced by the DB query methods, then broadcasts as a plain JSON string.
+  // These classes exist for requestId-based type identification and future
+  // client→server use (cast a received TRequest to the appropriate type).
+  TWsUnitMapMessage     = class(TRequest) public constructor Create; end;
+  TWsComplaintMapMessage = class(TRequest) public constructor Create; end;
+  TWsUnitListMessage    = class(TRequest) public constructor Create; end;
+  TWsComplaintListMessage = class(TRequest) public constructor Create; end;
+
+implementation
+
+constructor TWsBadgeCountsMessage.Create;
+begin
+  inherited;
+  RequestId := WS_MSG_BADGE_COUNTS;
+end;
+
+constructor TWsUnitMapMessage.Create;
+begin
+  inherited;
+  RequestId := WS_MSG_UNIT_MAP;
+end;
+
+constructor TWsComplaintMapMessage.Create;
+begin
+  inherited;
+  RequestId := WS_MSG_COMPLAINT_MAP;
+end;
+
+constructor TWsUnitListMessage.Create;
+begin
+  inherited;
+  RequestId := WS_MSG_UNIT_LIST;
+end;
+
+constructor TWsComplaintListMessage.Create;
+begin
+  inherited;
+  RequestId := WS_MSG_COMPLAINT_LIST;
+end;
+
+end.

webEMIMobile/Module.Websocket.pas

@@ -4,9 +4,12 @@ interface
 
 uses
   System.SysUtils, System.Classes, WEBLib.WebSocketClient, Web, WEBLib.Controls, WEBLib.Modules,
-  Auth.Service;
+  Auth.Service, JS;
 
 type
+  // Handler signature: receives the fully parsed JSON object for one push message.
+  TWsDataHandler = procedure(aData: TJSObject) of object;
+
   TdmWebsocket = class(TWebDataModule)
 
   private
@@ -19,11 +22,26 @@ type
     procedure EMiMobileWebSocketClientBinaryDataReceived(Sender: TObject;
       AData: TBytes);
 
+    procedure DispatchMessage(const AMessage: string);
+
+    FOnBadgeCounts:   TWsDataHandler;
+    FOnUnitMap:       TWsDataHandler;
+    FOnComplaintMap:  TWsDataHandler;
+    FOnUnitList:      TWsDataHandler;
+    FOnComplaintList: TWsDataHandler;
+
   public
     EMiMobileWebSocketClient: TWebSocketClient;
     procedure DataModuleCreate(Sender: TObject);
     procedure Connect(const AWsUrl: string);
 
+    // Assign these before calling Connect so that pushes are routed immediately.
+    property OnBadgeCounts:   TWsDataHandler read FOnBadgeCounts   write FOnBadgeCounts;
+    property OnUnitMap:       TWsDataHandler read FOnUnitMap       write FOnUnitMap;
+    property OnComplaintMap:  TWsDataHandler read FOnComplaintMap  write FOnComplaintMap;
+    property OnUnitList:      TWsDataHandler read FOnUnitList      write FOnUnitList;
+    property OnComplaintList: TWsDataHandler read FOnComplaintList write FOnComplaintList;
+
   end;
 
 var
@@ -102,32 +120,80 @@ begin
   EMiMobileWebSocketClient.Active := True;
 end;
 
+procedure TdmWebsocket.DispatchMessage(const AMessage: string);
+var
+  obj: TJSObject;
+  requestId: string;
+begin
+  if AMessage = '' then
+    Exit;
+
+  asm
+    try {
+      obj = JSON.parse(AMessage);
+    } catch(e) {
+      obj = null;
+    }
+  end;
+
+  if obj = nil then
+  begin
+    console.log('WS: could not parse message');
+    Exit;
+  end;
+
+  requestId := string(obj['RequestId']);
+
+  if SameText(requestId, 'BADGE_COUNTS') then
+  begin
+    if Assigned(FOnBadgeCounts) then FOnBadgeCounts(obj);
+  end
+  else if SameText(requestId, 'UNIT_MAP') then
+  begin
+    if Assigned(FOnUnitMap) then FOnUnitMap(obj);
+  end
+  else if SameText(requestId, 'COMPLAINT_MAP') then
+  begin
+    if Assigned(FOnComplaintMap) then FOnComplaintMap(obj);
+  end
+  else if SameText(requestId, 'UNIT_LIST') then
+  begin
+    if Assigned(FOnUnitList) then FOnUnitList(obj);
+  end
+  else if SameText(requestId, 'COMPLAINT_LIST') then
+  begin
+    if Assigned(FOnComplaintList) then FOnComplaintList(obj);
+  end
+  else
+    console.log('WS: unknown RequestId: ' + requestId);
+end;
+
 procedure TdmWebsocket.EMiMobileWebSocketClientBinaryDataReceived(
   Sender: TObject; AData: TBytes);
 begin
-  console.log('EMiMobileWebSocketClientBinaryDataReceived');
+  console.log('WS: binary data received (ignored)');
 end;
 
 procedure TdmWebsocket.EMiMobileWebSocketClientConnect(Sender: TObject);
 begin
-  console.log('EMiMobileWebSocketClientConnect');
+  console.log('WS: connected');
 end;
 
 procedure TdmWebsocket.EMiMobileWebSocketClientDataReceived(Sender: TObject;
   Origin: string; SocketData: TJSObjectRecord);
 begin
-  console.log('EMiMobileWebSocketClientDataReceived');
+  // Text messages arrive via EMiMobileWebSocketClientMessageReceived.
 end;
 
 procedure TdmWebsocket.EMiMobileWebSocketClientDisconnect(Sender: TObject);
 begin
-  console.log('EMiMobileWebSocketClientDisconnect');
+  console.log('WS: disconnected');
 end;
 
 procedure TdmWebsocket.EMiMobileWebSocketClientMessageReceived(Sender: TObject;
   AMessage: string);
 begin
-  console.log('EMiMobileWebSocketClientMessageReceived');
+  DispatchMessage(AMessage);
 end;
 
 end.

webEMIMobile/View.Complaints.pas

@@ -45,6 +45,7 @@ type
   public
     property OnShowDetails: TSelectProc read FSelectProc write FSelectProc;
     procedure RefreshData;
+    procedure ApplyWsData(aRespObj: TJSObject);
   end;
 
 var
@@ -186,5 +187,22 @@ begin
   GetComplaints;
 end;
 
+procedure TFViewComplaints.ApplyWsData(aRespObj: TJSObject);
+var
+  complaintsCount: Integer;
+begin
+  if FLoading then
+    Exit;
+
+  xdwdsComplaints.Close;
+  xdwdsComplaints.SetJsonData(aRespObj['data']);
+  xdwdsComplaints.Open;
+
+  ShowHideBusinessRows;
+
+  complaintsCount := Integer(aRespObj['count']);
+  lblEntries.Caption := Format('%d active complaints', [complaintsCount]);
+end;
+
 end.
 

webEMIMobile/View.Main.pas

@@ -55,7 +55,6 @@ type
     FDetailsForm: TWebForm;
     FArchiveForm: TWebForm;
     FLogoutProc: TLogoutProc;
-    //WebSocketModule: Module.Websocket;
     [async] procedure RefreshBadgesAsync;
     procedure ShowUnitDetails(UnitId: string);
     procedure SetHeaderTitle(const title: string);
@@ -64,6 +63,13 @@ type
     procedure HideArchiveModal;
     procedure ShowArchiveModal(const titleText: string);
 
+    // WebSocket push handlers — called by Module.Websocket when the server broadcasts
+    procedure HandleWsBadgeCounts(aData: TJSObject);
+    procedure HandleWsUnitMap(aData: TJSObject);
+    procedure HandleWsComplaintMap(aData: TJSObject);
+    procedure HandleWsUnitList(aData: TJSObject);
+    procedure HandleWsComplaintList(aData: TJSObject);
+
     type TActivePanel = (apNone, apMap, apUnits, apComplaints);
     var
       FActivePanel: TActivePanel;
@@ -151,9 +157,19 @@ begin
   SetActiveNavButton('view.main.btnmap');
   SetActivePanel(apMap);
 
+  // Initial badge counts still loaded via HTTP so the UI is populated immediately.
   RefreshBadgesAsync;
 
+  // Polling timers are replaced by WebSocket server-push broadcasts.
+  tmrBadgeCounts.Enabled := False;
+  tmrGlobalRefresh.Enabled := False;
+
   dmWebsocket := TdmWebsocket.Create(Self);
+  dmWebsocket.OnBadgeCounts   := HandleWsBadgeCounts;
+  dmWebsocket.OnUnitMap       := HandleWsUnitMap;
+  dmWebsocket.OnComplaintMap  := HandleWsComplaintMap;
+  dmWebsocket.OnUnitList      := HandleWsUnitList;
+  dmWebsocket.OnComplaintList := HandleWsComplaintList;
   dmWebsocket.Connect(DMConnection.WsUrl);
 end;
 
@@ -444,6 +460,49 @@ begin
 end;
 
 
+// ---------------------------------------------------------------------------
+// WebSocket push handlers
+// ---------------------------------------------------------------------------
+
+procedure TFViewMain.HandleWsBadgeCounts(aData: TJSObject);
+var
+  el: TJSElement;
+begin
+  el := Document.getElementById('view.main.badgecomplaints');
+  if Assigned(el) then
+    TJSHtmlElement(el).innerText := string(aData['BadgeComplaints']);
+
+  el := Document.getElementById('view.main.badgeunits');
+  if Assigned(el) then
+    TJSHtmlElement(el).innerText := string(aData['BadgeUnits']);
+end;
+
+procedure TFViewMain.HandleWsUnitMap(aData: TJSObject);
+begin
+  if Assigned(FMapForm) then
+    FMapForm.ApplyWsUnitMapData(TJSArray(aData['data']));
+end;
+
+procedure TFViewMain.HandleWsComplaintMap(aData: TJSObject);
+begin
+  if Assigned(FMapForm) then
+    FMapForm.ApplyWsComplaintMapData(TJSArray(aData['data']));
+end;
+
+procedure TFViewMain.HandleWsUnitList(aData: TJSObject);
+begin
+  if Assigned(FUnitsForm) then
+    FUnitsForm.ApplyWsData(aData);
+end;
+
+procedure TFViewMain.HandleWsComplaintList(aData: TJSObject);
+begin
+  if Assigned(FComplaintsForm) then
+    FComplaintsForm.ApplyWsData(aData);
+end;
+
+// ---------------------------------------------------------------------------
+
 procedure TFViewMain.tmrBadgeCountsTimer(Sender: TObject);
 begin
   console.log('Badges Refreshed');

webEMIMobile/View.Units.pas

@@ -41,6 +41,7 @@ type
     procedure HandleListClick(e: TJSMouseEvent);
   public
     procedure RefreshData;
+    procedure ApplyWsData(aRespObj: TJSObject);
   end;
 
 var
@@ -166,5 +167,19 @@ begin
   GetUnits;
 end;
 
+procedure TFViewUnits.ApplyWsData(aRespObj: TJSObject);
+var
+  unitCount: Integer;
+begin
+  if FLoading then
+    Exit;
+
+  xdwdsUnits.Close;
+  xdwdsUnits.SetJsonData(aRespObj['data']);
+  xdwdsUnits.Open;
+
+  unitCount := Integer(aRespObj['count']);
+  lblEntries.Caption := Format('%d units', [unitCount]);
+end;
 
 end.