Skip to content

E
emiMobile
Commit 69fafe4a by Mac Stephens
Options

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

parent 575b7310
Showing with 505 additions and 197 deletions
emiMobile.groupproj deleted 100644 → 0
<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
if Assigned(WsServerModule) then
WsServerModule.OnClientsChanged := nil;
ServerConfig.Free;
IniEntries.Free;
AuthServerModule.Free;
ApiServerModule.Free;
AppServerModule.Free;
WsServerModule.Free;
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;
......@@ -238,3 +219,28 @@ var
clients: TArray<TConnectedClientSnapshot>;
client: TConnectedClientSnapshot;
begin
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,24 +112,32 @@ 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;
}
}
end;
if obj = nil then
......@@ -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/"
}
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment