Commit 070b7b50 by Michael Brachmann

pull in main branch changes

parents 886d9a67 9cdc7cfd
...@@ -26,5 +26,8 @@ object ApiServerModule: TApiServerModule ...@@ -26,5 +26,8 @@ object ApiServerModule: TApiServerModule
object XDataServer1JWT: TSparkleJwtMiddleware object XDataServer1JWT: TSparkleJwtMiddleware
OnGetSecret = XDataServer1JWTGetSecret OnGetSecret = XDataServer1JWTGetSecret
end end
object XDataServer1Forward: TSparkleForwardMiddleware
OnAcceptProxy = XDataServer1ForwardAcceptProxy
end
end end
end end
...@@ -13,7 +13,7 @@ uses ...@@ -13,7 +13,7 @@ uses
Sparkle.HttpServer.Module, Sparkle.HttpServer.Context, Sparkle.HttpServer.Module, Sparkle.HttpServer.Context,
Sparkle.Comp.CompressMiddleware, Sparkle.Comp.CorsMiddleware, Sparkle.Comp.CompressMiddleware, Sparkle.Comp.CorsMiddleware,
Sparkle.Comp.GenericMiddleware, Aurelius.Drivers.UniDac, UniProvider, Sparkle.Comp.GenericMiddleware, Aurelius.Drivers.UniDac, UniProvider,
Data.DB, DBAccess, Uni; Data.DB, DBAccess, Uni, Sparkle.Comp.ForwardMiddleware;
type type
TApiServerModule = class(TDataModule) TApiServerModule = class(TDataModule)
...@@ -23,9 +23,12 @@ type ...@@ -23,9 +23,12 @@ type
XDataServer1CORS: TSparkleCorsMiddleware; XDataServer1CORS: TSparkleCorsMiddleware;
XDataServer1Compress: TSparkleCompressMiddleware; XDataServer1Compress: TSparkleCompressMiddleware;
XDataServer1JWT: TSparkleJwtMiddleware; XDataServer1JWT: TSparkleJwtMiddleware;
XDataServer1Forward: TSparkleForwardMiddleware;
procedure XDataServer1LoggingMiddlewareCreate(Sender: TObject; procedure XDataServer1LoggingMiddlewareCreate(Sender: TObject;
var Middleware: IHttpServerMiddleware); var Middleware: IHttpServerMiddleware);
procedure XDataServer1JWTGetSecret(Sender: TObject; var Secret: string); procedure XDataServer1JWTGetSecret(Sender: TObject; var Secret: string);
procedure XDataServer1ForwardAcceptProxy(Sender: TObject;
const Value: string; var Accept: Boolean);
private private
{ Private declarations } { Private declarations }
public public
...@@ -89,6 +92,12 @@ begin ...@@ -89,6 +92,12 @@ begin
Middleware := TLoggingMiddleware.Create(Logger); Middleware := TLoggingMiddleware.Create(Logger);
end; end;
procedure TApiServerModule.XDataServer1ForwardAcceptProxy(Sender: TObject;
const Value: string; var Accept: Boolean);
begin
Accept := True;
end;
procedure TApiServerModule.XDataServer1JWTGetSecret(Sender: TObject; procedure TApiServerModule.XDataServer1JWTGetSecret(Sender: TObject;
var Secret: string); var Secret: string);
begin begin
......
...@@ -1063,7 +1063,8 @@ var ...@@ -1063,7 +1063,8 @@ var
iniFile: TIniFile; iniFile: TIniFile;
webClientVersion: string; webClientVersion: string;
begin begin
Logger.Log(3, 'AuthService.VerifyVersion called'); Logger.Log(1, Format(
'Client version check started: client="%s"', [ClientVersion]));
Result := TJSONObject.Create; Result := TJSONObject.Create;
TXDataOperationContext.Current.Handler.ManagedObjects.Add(Result); TXDataOperationContext.Current.Handler.ManagedObjects.Add(Result);
...@@ -1075,20 +1076,26 @@ begin ...@@ -1075,20 +1076,26 @@ begin
if webClientVersion = '' then if webClientVersion = '' then
begin begin
Logger.Log(2, 'AuthService.VerifyVersion: webClientVersion not configured'); Logger.Log(2, Format(
'Client version check failed: client="%s", required version is not configured',
[ClientVersion]));
Result.AddPair('error', 'webClientVersion is not configured.'); Result.AddPair('error', 'webClientVersion is not configured.');
Exit; Exit;
end; end;
if clientVersion <> webClientVersion then if clientVersion <> webClientVersion then
begin begin
Logger.Log(2, 'AuthService.VerifyVersion: client version mismatch'); Logger.Log(2, Format(
'Client version check failed: client="%s", required="%s"',
[ClientVersion, webClientVersion]));
Result.AddPair('error', Result.AddPair('error',
'Your browser is running an old version of the app.' + sLineBreak + 'Your browser is running an old version of the app.' + sLineBreak +
'Please click below to reload.'); 'Please click below to reload.');
end end
else else
Logger.Log(3, 'AuthService.VerifyVersion: version check passed'); Logger.Log(1, Format(
'Client version check succeeded: client="%s", required="%s"',
[ClientVersion, webClientVersion]));
finally finally
iniFile.Free; iniFile.Free;
end; end;
......
...@@ -97,7 +97,7 @@ begin ...@@ -97,7 +97,7 @@ begin
FDatabaseServer := iniFile.ReadString('Database', 'Server', ''); FDatabaseServer := iniFile.ReadString('Database', 'Server', '');
FDatabaseServerFromIni := iniFile.ValueExists('Database', 'Server'); FDatabaseServerFromIni := iniFile.ValueExists('Database', 'Server');
FDatabasePort := iniFile.ReadInteger('Database', 'Port', 5433); FDatabasePort := iniFile.ReadInteger('Database', 'Port', 5432);
FDatabasePortFromIni := iniFile.ValueExists('Database', 'Port'); FDatabasePortFromIni := iniFile.ValueExists('Database', 'Port');
FDatabaseName := iniFile.ReadString('Database', 'Database', 'lems_wcso'); FDatabaseName := iniFile.ReadString('Database', 'Database', 'lems_wcso');
......
...@@ -68,6 +68,13 @@ object FMain: TFMain ...@@ -68,6 +68,13 @@ object FMain: TFMain
end end
item item
Expanded = False Expanded = False
FieldName = 'ClientVersion'
Title.Caption = 'Version'
Width = 80
Visible = True
end
item
Expanded = False
FieldName = 'ConnectedAt' FieldName = 'ConnectedAt'
Width = 150 Width = 150
Visible = True Visible = True
...@@ -87,7 +94,7 @@ object FMain: TFMain ...@@ -87,7 +94,7 @@ object FMain: TFMain
Top = 18 Top = 18
Width = 141 Width = 141
Height = 25 Height = 25
Caption = 'Disconnect Selected Client' Caption = 'Refresh Client'
TabOrder = 0 TabOrder = 0
OnClick = btnDisconnectClientClick OnClick = btnDisconnectClientClick
end end
...@@ -162,6 +169,11 @@ object FMain: TFMain ...@@ -162,6 +169,11 @@ object FMain: TFMain
Size = 30 Size = 30
end end
item item
Name = 'ClientVersion'
DataType = ftString
Size = 20
end
item
Name = 'ConnectedAt' Name = 'ConnectedAt'
DataType = ftDateTime DataType = ftDateTime
end> end>
......
...@@ -181,6 +181,14 @@ begin ...@@ -181,6 +181,14 @@ begin
Logger.Log(1, LogValue('--Settings->LogFileNum', IniEntries.LogFileNum.ToString, IniEntries.LogFileNumFromIni)); Logger.Log(1, LogValue('--Settings->LogFileNum', IniEntries.LogFileNum.ToString, IniEntries.LogFileNumFromIni));
Logger.Log(1, LogValue('--Settings->webClientVersion', IniEntries.WebClientVersion, IniEntries.WebClientVersionFromIni)); Logger.Log(1, LogValue('--Settings->webClientVersion', IniEntries.WebClientVersion, IniEntries.WebClientVersionFromIni));
Logger.Log(1, '--- Database ---');
Logger.Log(1, LogValue('--Database->Server', IniEntries.DatabaseServer, IniEntries.DatabaseServerFromIni));
Logger.Log(1, LogValue('--Database->Port', IniEntries.DatabasePort.ToString, IniEntries.DatabasePortFromIni));
Logger.Log(1, LogValue('--Database->Name', IniEntries.DatabaseName, IniEntries.DatabaseNameFromIni));
Logger.Log(1, LogValue('--Database->Username', IniEntries.DataBaseUsername, IniEntries.DatabaseUsernameFromIni));
Logger.Log(1, LogValue('--Database->Password', IniEntries.DatabasePassword, IniEntries.DatabasePasswordFromIni));
Logger.Log(1, '');
Logger.Log(1, ''); Logger.Log(1, '');
Logger.Log(1, '--- URLs ---'); Logger.Log(1, '--- URLs ---');
...@@ -233,6 +241,7 @@ begin ...@@ -233,6 +241,7 @@ begin
tblConnectedClients.Append; tblConnectedClients.Append;
tblConnectedClients.FieldByName('ConnectionId').AsString := client.ConnectionId; tblConnectedClients.FieldByName('ConnectionId').AsString := client.ConnectionId;
tblConnectedClients.FieldByName('UserId').AsString := client.UserId; tblConnectedClients.FieldByName('UserId').AsString := client.UserId;
tblConnectedClients.FieldByName('ClientVersion').AsString := client.ClientVersion;
tblConnectedClients.FieldByName('ConnectedAt').AsDateTime := client.ConnectedAt; tblConnectedClients.FieldByName('ConnectedAt').AsDateTime := client.ConnectedAt;
tblConnectedClients.Post; tblConnectedClients.Post;
end; end;
......
[Settings] [Settings]
LogFileNum=153 LogFileNum=107
webClientVersion=0.9.4.1 webClientVersion=0.9.4.3
[Database] [Database]
Server=192.168.91.136 --Server=192.168.91.129
--Server=192.168.102.10 Server=192.168.102.10
--Server=192.168.56.129 --Server=192.168.56.129
--Port=5432 --Port=5432
--Port=5433 --Port=5433
Database=lems_wcso Database=lems_wcso
Username=postgres Username=postgres
Password=postgreSQL --Password=postgreSQL
--Password=emsys01 Password=emsys01
--Postgre!SQL --Postgre!SQL
...@@ -114,9 +114,9 @@ begin ...@@ -114,9 +114,9 @@ begin
iniFile := TIniFile.Create( ChangeFileExt(Application.ExeName, '.ini') ); iniFile := TIniFile.Create( ChangeFileExt(Application.ExeName, '.ini') );
try try
fileNum := iniFile.ReadInteger( 'Settings', 'LogFileNum', 0 ); fileNum := iniFile.ReadInteger( 'Settings', 'LogFileNum', 0 ) + 1;
FFilename := AFilename + Format( '%.4d', [fileNum] ); FFilename := AFilename + Format( '%.4d', [fileNum] );
iniFile.WriteInteger( 'Settings', 'LogFileNum', fileNum + 1 ); iniFile.WriteInteger( 'Settings', 'LogFileNum', fileNum );
finally finally
iniFile.Free; iniFile.Free;
end; end;
......
...@@ -108,9 +108,9 @@ ...@@ -108,9 +108,9 @@
<VerInfo_MajorVer>0</VerInfo_MajorVer> <VerInfo_MajorVer>0</VerInfo_MajorVer>
<VerInfo_MinorVer>9</VerInfo_MinorVer> <VerInfo_MinorVer>9</VerInfo_MinorVer>
<VerInfo_Release>4</VerInfo_Release> <VerInfo_Release>4</VerInfo_Release>
<VerInfo_Keys>CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=0.9.4.1;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=0.9.2.0;Comments=</VerInfo_Keys> <VerInfo_Keys>CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=0.9.4.3;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=0.9.2.0;Comments=</VerInfo_Keys>
<DCC_UnitSearchPath>C:\RADTOOLS\FastMM4;$(DCC_UnitSearchPath)</DCC_UnitSearchPath> <DCC_UnitSearchPath>C:\RADTOOLS\FastMM4;$(DCC_UnitSearchPath)</DCC_UnitSearchPath>
<VerInfo_Build>1</VerInfo_Build> <VerInfo_Build>3</VerInfo_Build>
</PropertyGroup> </PropertyGroup>
<PropertyGroup Condition="'$(Cfg_1_Win64)'!=''"> <PropertyGroup Condition="'$(Cfg_1_Win64)'!=''">
<AppDPIAwarenessMode>PerMonitorV2</AppDPIAwarenessMode> <AppDPIAwarenessMode>PerMonitorV2</AppDPIAwarenessMode>
......
...@@ -21,7 +21,7 @@ type ...@@ -21,7 +21,7 @@ type
procedure VerifyVersion(SuccessProc: TSuccessProc); procedure VerifyVersion(SuccessProc: TSuccessProc);
public public
property WsUrl: string read FWsUrl; property WsUrl: string read FWsUrl;
const clientVersion = '0.9.4.1'; const clientVersion = '0.9.4.3';
procedure InitApp(SuccessProc: TSuccessProc; procedure InitApp(SuccessProc: TSuccessProc;
UnauthorizedAccessProc: TUnauthorizedAccessProc); UnauthorizedAccessProc: TUnauthorizedAccessProc);
end; end;
...@@ -110,7 +110,9 @@ begin ...@@ -110,7 +110,9 @@ begin
error := ''; error := '';
if error <> '' then if error <> '' then
TFViewErrorPage.Display(error) TFViewErrorPage.Display(
error + sLineBreak + sLineBreak +
'Current client version: v' + clientVersion)
else else
SuccessProc; SuccessProc;
end, end,
......
...@@ -39,6 +39,8 @@ type ...@@ -39,6 +39,8 @@ type
FSelectProc: TSelectProc; FSelectProc: TSelectProc;
FLoading: Boolean; FLoading: Boolean;
FFirstLoad: Boolean; FFirstLoad: Boolean;
FRefreshPending: Boolean;
FPendingWsData: TJSObject;
[async] procedure GetComplaints; [async] procedure GetComplaints;
procedure HandleListClick(e: TJSMouseEvent); procedure HandleListClick(e: TJSMouseEvent);
procedure ShowHideBusinessRows; procedure ShowHideBusinessRows;
...@@ -59,6 +61,8 @@ procedure TFViewComplaints.WebFormCreate(Sender: TObject); ...@@ -59,6 +61,8 @@ procedure TFViewComplaints.WebFormCreate(Sender: TObject);
begin begin
Document.addEventListener('click', @HandleListClick); Document.addEventListener('click', @HandleListClick);
FFirstLoad := True; FFirstLoad := True;
FRefreshPending := False;
FPendingWsData := nil;
GetComplaints; GetComplaints;
asm asm
if (!window.showComplaintDetails) { if (!window.showComplaintDetails) {
...@@ -178,12 +182,32 @@ begin ...@@ -178,12 +182,32 @@ begin
HideSpinner('spinner'); HideSpinner('spinner');
FFirstLoad := False; FFirstLoad := False;
end; end;
if Assigned(FPendingWsData) then
begin
respObj := FPendingWsData;
FPendingWsData := nil;
ApplyWsData(respObj);
end;
if FRefreshPending then
begin
FRefreshPending := False;
GetComplaints;
end;
end; end;
end; end;
procedure TFViewComplaints.RefreshData; procedure TFViewComplaints.RefreshData;
begin begin
Console.Log('Complaints.RefreshData'); Console.Log('Complaints.RefreshData');
if FLoading then
begin
FRefreshPending := True;
Exit;
end;
GetComplaints; GetComplaints;
end; end;
...@@ -192,7 +216,10 @@ var ...@@ -192,7 +216,10 @@ var
complaintsCount: Integer; complaintsCount: Integer;
begin begin
if FLoading then if FLoading then
begin
FPendingWsData := aRespObj;
Exit; Exit;
end;
xdwdsComplaints.Close; xdwdsComplaints.Close;
xdwdsComplaints.SetJsonData(aRespObj['data']); xdwdsComplaints.SetJsonData(aRespObj['data']);
......
...@@ -41,6 +41,18 @@ object FViewLogin: TFViewLogin ...@@ -41,6 +41,18 @@ object FViewLogin: TFViewLogin
TextHint = 'Password' TextHint = 'Password'
WidthPercent = 100.000000000000000000 WidthPercent = 100.000000000000000000
end end
object btnShowPassword: TWebButton
Left = 367
Top = 163
Width = 50
Height = 21
Caption = 'Show'
ElementID = 'view.login.btnshowpassword'
HeightPercent = 100.000000000000000000
TabOrder = 2
WidthPercent = 100.000000000000000000
OnClick = btnShowPasswordClick
end
object btnLogin: TWebButton object btnLogin: TWebButton
Left = 240 Left = 240
Top = 217 Top = 217
...@@ -49,7 +61,7 @@ object FViewLogin: TFViewLogin ...@@ -49,7 +61,7 @@ object FViewLogin: TFViewLogin
Caption = 'Login' Caption = 'Login'
ElementID = 'view.login.btnlogin' ElementID = 'view.login.btnlogin'
HeightPercent = 100.000000000000000000 HeightPercent = 100.000000000000000000
TabOrder = 2 TabOrder = 3
WidthPercent = 100.000000000000000000 WidthPercent = 100.000000000000000000
OnClick = btnLoginClick OnClick = btnLoginClick
end end
...@@ -59,7 +71,7 @@ object FViewLogin: TFViewLogin ...@@ -59,7 +71,7 @@ object FViewLogin: TFViewLogin
Width = 121 Width = 121
Height = 33 Height = 33
ElementID = 'view.login.message' ElementID = 'view.login.message'
TabOrder = 3 TabOrder = 4
object lblMessage: TWebLabel object lblMessage: TWebLabel
Left = 16 Left = 16
Top = 11 Top = 11
......
...@@ -13,6 +13,7 @@ type ...@@ -13,6 +13,7 @@ type
WebLabel1: TWebLabel; WebLabel1: TWebLabel;
edtUsername: TWebEdit; edtUsername: TWebEdit;
edtPassword: TWebEdit; edtPassword: TWebEdit;
btnShowPassword: TWebButton;
btnLogin: TWebButton; btnLogin: TWebButton;
pnlMessage: TWebPanel; pnlMessage: TWebPanel;
lblMessage: TWebLabel; lblMessage: TWebLabel;
...@@ -20,6 +21,7 @@ type ...@@ -20,6 +21,7 @@ type
XDataWebClient: TXDataWebClient; XDataWebClient: TXDataWebClient;
lucbAgency: TWebLookupComboBox; lucbAgency: TWebLookupComboBox;
procedure btnLoginClick(Sender: TObject); procedure btnLoginClick(Sender: TObject);
procedure btnShowPasswordClick(Sender: TObject);
procedure btnCloseNotificationClick(Sender: TObject); procedure btnCloseNotificationClick(Sender: TObject);
procedure WebFormCreate(Sender: TObject); procedure WebFormCreate(Sender: TObject);
private private
...@@ -351,6 +353,23 @@ begin ...@@ -351,6 +353,23 @@ begin
end; end;
end; end;
procedure TFViewLogin.btnShowPasswordClick(Sender: TObject);
begin
if edtPassword.PasswordChar = #0 then
begin
edtPassword.PasswordChar := '*';
edtPassword.ElementHandle.setAttribute('type', 'password');
btnShowPassword.Caption := 'Show';
end
else
begin
edtPassword.PasswordChar := #0;
edtPassword.ElementHandle.setAttribute('type', 'text');
btnShowPassword.Caption := 'Hide';
end;
end;
procedure TFViewLogin.GetAgencyConfigList; procedure TFViewLogin.GetAgencyConfigList;
procedure OnLoad(Response: TXDataClientResponse); procedure OnLoad(Response: TXDataClientResponse);
...@@ -391,13 +410,13 @@ begin ...@@ -391,13 +410,13 @@ begin
if Notification <> '' then if Notification <> '' then
begin begin
lblMessage.Caption := Notification; lblMessage.Caption := Notification;
pnlMessage.ElementHandle.hidden := False; pnlMessage.ElementHandle.classList.remove('d-none');
end; end;
end; end;
procedure TFViewLogin.HideNotification; procedure TFViewLogin.HideNotification;
begin begin
pnlMessage.ElementHandle.hidden := True; pnlMessage.ElementHandle.classList.add('d-none');
end; end;
procedure TFViewLogin.btnCloseNotificationClick(Sender: TObject); procedure TFViewLogin.btnCloseNotificationClick(Sender: TObject);
......
...@@ -11,13 +11,32 @@ ...@@ -11,13 +11,32 @@
<span id="lbl_main_title" class="navbar-brand text-light mb-0 ms-1"></span> <span id="lbl_main_title" class="navbar-brand text-light mb-0 ms-1"></span>
</div> </div>
<!-- Right: Connection / Logout --> <!-- Right: Connection / Menu -->
<div class="d-flex align-items-center gap-2 ms-auto"> <div class="d-flex align-items-center gap-2 ms-auto">
<span id="view.main.lblconnection" class="navbar-text text-light small"></span> <span id="view.main.lblconnection"
class="connection-status connection-status-connecting"
role="status"
aria-live="polite"
aria-atomic="true"
aria-label="Live updates: Connecting"
title="Live updates: Connecting">
<span class="connection-status-dot" aria-hidden="true"></span>
<span id="view.main.lblconnectiontext" class="connection-status-text">Connecting</span>
</span>
<div class="dropdown">
<button type="button"
class="btn btn-outline-light btn-sm"
data-bs-toggle="dropdown"
aria-expanded="false"
aria-label="Menu">
<i class="fas fa-bars" aria-hidden="true"></i>
</button>
<ul class="dropdown-menu dropdown-menu-end">
<li><button id="btn_logout" type="button" class="dropdown-item">Logout</button></li>
</ul>
</div>
<button id="btn_devices" type="button" class="btn btn-outline-light btn-sm d-none">Devices</button> <button id="btn_devices" type="button" class="btn btn-outline-light btn-sm d-none">Devices</button>
<span id="view.main.version" class="navbar-text text-light small opacity-75"></span>
<button id="btn_logout" type="button" class="btn btn-outline-light btn-sm">Logout</button>
</div> </div>
</div> </div>
</nav> </nav>
......
...@@ -56,7 +56,11 @@ type ...@@ -56,7 +56,11 @@ type
FDetailsForm: TWebForm; FDetailsForm: TWebForm;
FArchiveForm: TWebForm; FArchiveForm: TWebForm;
FLogoutProc: TLogoutProc; FLogoutProc: TLogoutProc;
FBadgeRefreshInProgress: Boolean;
FBadgeRefreshPending: Boolean;
FPendingWsBadgeCounts: TJSObject;
[async] procedure RefreshBadgesAsync; [async] procedure RefreshBadgesAsync;
procedure ApplyBadgeCounts(aData: TJSObject);
procedure ShowUnitDetails(UnitId: string); procedure ShowUnitDetails(UnitId: string);
procedure SetHeaderTitle(const title: string); procedure SetHeaderTitle(const title: string);
procedure HideDetailsModal; procedure HideDetailsModal;
...@@ -70,6 +74,10 @@ type ...@@ -70,6 +74,10 @@ type
procedure HandleWsComplaintMap(aData: TJSObject); procedure HandleWsComplaintMap(aData: TJSObject);
procedure HandleWsUnitList(aData: TJSObject); procedure HandleWsUnitList(aData: TJSObject);
procedure HandleWsComplaintList(aData: TJSObject); procedure HandleWsComplaintList(aData: TJSObject);
procedure HandleWsConnectionState(AState: TWsConnectionState);
procedure HandleWsRecoveryRequired;
procedure HandleWsAuthenticationExpired;
procedure ResyncLiveData;
type TActivePanel = (apNone, apMap, apUnits, apComplaints); type TActivePanel = (apNone, apMap, apUnits, apComplaints);
var var
...@@ -86,6 +94,7 @@ type ...@@ -86,6 +94,7 @@ type
public public
{ Public declarations } { Public declarations }
destructor Destroy; override;
class procedure Display(LogoutProc: TLogoutProc); class procedure Display(LogoutProc: TLogoutProc);
procedure ShowForm( AFormClass: TWebFormClass ); procedure ShowForm( AFormClass: TWebFormClass );
procedure ShowComplaintDetails(ComplaintId: string); procedure ShowComplaintDetails(ComplaintId: string);
...@@ -124,15 +133,10 @@ const ...@@ -124,15 +133,10 @@ const
procedure TFViewMain.WebFormCreate(Sender: TObject); procedure TFViewMain.WebFormCreate(Sender: TObject);
var var
userName: string; userName: string;
el: TJSElement;
begin begin
userName := JS.toString(AuthService.TokenPayload.Properties['user_name']); userName := JS.toString(AuthService.TokenPayload.Properties['user_name']);
lblUsername.Caption := ' ' + userName.ToLower + ' '; lblUsername.Caption := ' ' + userName.ToLower + ' ';
el := Document.getElementById('view.main.version');
if Assigned(el) then
TJSHtmlElement(el).innerText := 'v' + TDMConnection.clientVersion;
FChildForm := nil; FChildForm := nil;
FDetailsForm := nil; FDetailsForm := nil;
FArchiveForm := nil; FArchiveForm := nil;
...@@ -142,6 +146,9 @@ begin ...@@ -142,6 +146,9 @@ begin
FMapRefreshTick := 0; FMapRefreshTick := 0;
FUnitsRefreshTick := 0; FUnitsRefreshTick := 0;
FComplaintsRefreshTick := 0; FComplaintsRefreshTick := 0;
FBadgeRefreshInProgress := False;
FBadgeRefreshPending := False;
FPendingWsBadgeCounts := nil;
if JS.toBoolean(AuthService.TokenPayload.Properties['user_admin']) then if JS.toBoolean(AuthService.TokenPayload.Properties['user_admin']) then
begin begin
...@@ -187,9 +194,27 @@ begin ...@@ -187,9 +194,27 @@ begin
dmWebsocket.OnComplaintMap := HandleWsComplaintMap; dmWebsocket.OnComplaintMap := HandleWsComplaintMap;
dmWebsocket.OnUnitList := HandleWsUnitList; dmWebsocket.OnUnitList := HandleWsUnitList;
dmWebsocket.OnComplaintList := HandleWsComplaintList; dmWebsocket.OnComplaintList := HandleWsComplaintList;
dmWebsocket.OnStateChanged := HandleWsConnectionState;
dmWebsocket.OnRecoveryRequired := HandleWsRecoveryRequired;
dmWebsocket.OnAuthenticationExpired := HandleWsAuthenticationExpired;
dmWebsocket.Connect(DMConnection.WsUrl); dmWebsocket.Connect(DMConnection.WsUrl);
end; end;
destructor TFViewMain.Destroy;
begin
if Assigned(dmWebsocket) and (dmWebsocket.Owner = Self) then
begin
dmWebsocket.Stop;
dmWebsocket.Free;
dmWebsocket := nil;
end;
if FViewMain = Self then
FViewMain := nil;
inherited;
end;
procedure TFViewMain.SetActivePanel(panel: TActivePanel); procedure TFViewMain.SetActivePanel(panel: TActivePanel);
begin begin
FActivePanel := panel; FActivePanel := panel;
...@@ -485,10 +510,13 @@ end; ...@@ -485,10 +510,13 @@ end;
// WebSocket push handlers // WebSocket push handlers
// --------------------------------------------------------------------------- // ---------------------------------------------------------------------------
procedure TFViewMain.HandleWsBadgeCounts(aData: TJSObject); procedure TFViewMain.ApplyBadgeCounts(aData: TJSObject);
var var
el: TJSElement; el: TJSElement;
begin begin
if not Assigned(aData) then
Exit;
el := Document.getElementById('view.main.badgecomplaints'); el := Document.getElementById('view.main.badgecomplaints');
if Assigned(el) then if Assigned(el) then
TJSHtmlElement(el).innerText := string(aData['BadgeComplaints']); TJSHtmlElement(el).innerText := string(aData['BadgeComplaints']);
...@@ -498,6 +526,17 @@ begin ...@@ -498,6 +526,17 @@ begin
TJSHtmlElement(el).innerText := string(aData['BadgeUnits']); TJSHtmlElement(el).innerText := string(aData['BadgeUnits']);
end; end;
procedure TFViewMain.HandleWsBadgeCounts(aData: TJSObject);
begin
if FBadgeRefreshInProgress then
begin
FPendingWsBadgeCounts := aData;
Exit;
end;
ApplyBadgeCounts(aData);
end;
procedure TFViewMain.HandleWsUnitMap(aData: TJSObject); procedure TFViewMain.HandleWsUnitMap(aData: TJSObject);
begin begin
if Assigned(FMapForm) then if Assigned(FMapForm) then
...@@ -522,6 +561,83 @@ begin ...@@ -522,6 +561,83 @@ begin
FComplaintsForm.ApplyWsData(aData); FComplaintsForm.ApplyWsData(aData);
end; end;
procedure TFViewMain.HandleWsConnectionState(AState: TWsConnectionState);
var
statusElement: TJSHTMLElement;
textElement: TJSHTMLElement;
statusText: string;
statusClass: string;
begin
case AState of
wcsConnecting:
begin
statusText := 'Connecting';
statusClass := 'connecting';
end;
wcsConnected:
begin
statusText := 'Connected';
statusClass := 'connected';
end;
wcsReconnecting:
begin
statusText := 'Reconnecting';
statusClass := 'reconnecting';
end;
wcsOffline:
begin
statusText := 'Offline';
statusClass := 'offline';
end;
else
begin
statusText := 'Disconnected';
statusClass := 'stopped';
end;
end;
statusElement := TJSHTMLElement(Document.getElementById('view.main.lblconnection'));
if Assigned(statusElement) then
begin
statusElement.setAttribute('class', 'connection-status connection-status-' + statusClass);
statusElement.setAttribute('aria-label', 'Live updates: ' + statusText);
statusElement.setAttribute('title', 'Live updates: ' + statusText);
end;
textElement := TJSHTMLElement(Document.getElementById('view.main.lblconnectiontext'));
if Assigned(textElement) then
textElement.innerText := statusText;
end;
procedure TFViewMain.HandleWsRecoveryRequired;
begin
ResyncLiveData;
end;
procedure TFViewMain.HandleWsAuthenticationExpired;
begin
if Assigned(dmWebsocket) then
dmWebsocket.Stop;
if Assigned(FLogoutProc) then
FLogoutProc('Your session has expired. Please sign in again.');
end;
procedure TFViewMain.ResyncLiveData;
begin
if (not AuthService.Authenticated) or AuthService.TokenExpired then
begin
HandleWsAuthenticationExpired;
Exit;
end;
Console.Log('WS: resynchronizing live data');
RefreshBadgesAsync;
Inc(FGlobalRefreshTick);
RefreshActivePanelFromTimer;
end;
// --------------------------------------------------------------------------- // ---------------------------------------------------------------------------
procedure TFViewMain.tmrBadgeCountsTimer(Sender: TObject); procedure TFViewMain.tmrBadgeCountsTimer(Sender: TObject);
...@@ -545,27 +661,54 @@ var ...@@ -545,27 +661,54 @@ var
badgeObj: TJSObject; badgeObj: TJSObject;
el: TJSElement; el: TJSElement;
begin begin
if FBadgeRefreshInProgress then
begin
FBadgeRefreshPending := True;
Exit;
end;
FBadgeRefreshInProgress := True;
try
try try
resp := await(xdwcBadgeCounts.RawInvokeAsync('IApiService.GetBadgeCounts', [])); resp := await(xdwcBadgeCounts.RawInvokeAsync('IApiService.GetBadgeCounts', []));
badgeObj := TJSObject(resp.Result); badgeObj := TJSObject(resp.Result);
el := Document.getElementById('view.main.badgecomplaints'); if Assigned(FPendingWsBadgeCounts) then
if Assigned(el) then begin
TJSHtmlElement(el).innerText := string(badgeObj['BadgeComplaints']); ApplyBadgeCounts(FPendingWsBadgeCounts);
FPendingWsBadgeCounts := nil;
el := Document.getElementById('view.main.badgeunits'); end
if Assigned(el) then else
TJSHtmlElement(el).innerText := string(badgeObj['BadgeUnits']); ApplyBadgeCounts(badgeObj);
except except
on E: Exception do on E: Exception do
begin begin
if Assigned(FPendingWsBadgeCounts) then
begin
ApplyBadgeCounts(FPendingWsBadgeCounts);
FPendingWsBadgeCounts := nil;
end
else
begin
el := Document.getElementById('view.main.badgecomplaints'); el := Document.getElementById('view.main.badgecomplaints');
if Assigned(el) then TJSHtmlElement(el).innerText := '�'; if Assigned(el) then TJSHtmlElement(el).innerText := '�';
el := Document.getElementById('view.main.badgeunits'); el := Document.getElementById('view.main.badgeunits');
if Assigned(el) then TJSHtmlElement(el).innerText := '�'; if Assigned(el) then TJSHtmlElement(el).innerText := '�';
end;
Console.Log('Badge refresh error: ' + E.Message); Console.Log('Badge refresh error: ' + E.Message);
end; end;
end; end;
finally
FBadgeRefreshInProgress := False;
if FBadgeRefreshPending then
begin
FBadgeRefreshPending := False;
RefreshBadgesAsync;
end;
end;
end; end;
......
...@@ -62,7 +62,6 @@ object FViewMap: TFViewMap ...@@ -62,7 +62,6 @@ object FViewMap: TFViewMap
end end
object httpReqGeoJson: TWebHttpRequest object httpReqGeoJson: TWebHttpRequest
ResponseType = rtText ResponseType = rtText
URL = 'assets/orleanscounty.geojson'
OnResponse = httpReqGeoJsonResponse OnResponse = httpReqGeoJsonResponse
Left = 116 Left = 116
Top = 698 Top = 698
......
...@@ -52,16 +52,17 @@ ...@@ -52,16 +52,17 @@
<i class="fa fa-crosshairs"></i> <i class="fa fa-crosshairs"></i>
</button> </button>
<!-- Filters (top-right) --> <!-- Filters (bottom-right, above recenter) -->
<button id="btn_map_filters" <button id="btn_map_filters"
type="button" type="button"
class="btn btn-primary position-absolute top-0 end-0 m-2 shadow" class="btn btn-primary position-absolute end-0 me-2 shadow"
style="z-index:1000;" style="z-index:1000; bottom:4.5rem;"
data-bs-toggle="offcanvas" data-bs-toggle="offcanvas"
data-bs-target="#map_filters_offcanvas" data-bs-target="#map_filters_offcanvas"
aria-controls="map_filters_offcanvas"> aria-controls="map_filters_offcanvas"
<i class="fa fa-sliders-h"></i> aria-label="Map filters"
<span class="d-none d-sm-inline">Filters</span> title="Map filters">
<i class="fa fa-sliders-h" aria-hidden="true"></i>
</button> </button>
</div> </div>
</div> </div>
......
...@@ -31,6 +31,7 @@ type ...@@ -31,6 +31,7 @@ type
FUnitsLoaded: Boolean; FUnitsLoaded: Boolean;
FComplaintsLoaded: Boolean; FComplaintsLoaded: Boolean;
FLoadingPoints: Boolean; FLoadingPoints: Boolean;
FRefreshPending: Boolean;
mapFilters: TMapFilters; mapFilters: TMapFilters;
FPendingUnitId: string; FPendingUnitId: string;
FPendingComplaintId: string; FPendingComplaintId: string;
...@@ -293,10 +294,12 @@ begin ...@@ -293,10 +294,12 @@ begin
resp := await(xdwcMap.RawInvokeAsync('IApiService.GetUnitMap', [])); resp := await(xdwcMap.RawInvokeAsync('IApiService.GetUnitMap', []));
root := TJSObject(resp.Result); root := TJSObject(resp.Result);
unitsData := TJSArray(root['data']); unitsData := TJSArray(root['data']);
FUnitsLoaded := True; FUnitsLoaded := Assigned(unitsData);
except except
on E: EXDataClientRequestException do on E: EXDataClientRequestException do
Console.Log('Units XData error: ' + E.ErrorResult.ErrorMessage); Console.Log('Units XData error: ' + E.ErrorResult.ErrorMessage);
on E: Exception do
Console.Log('Units error: ' + E.Message);
end; end;
// --- Fetch Complaints ---------------------------------------------------- // --- Fetch Complaints ----------------------------------------------------
...@@ -304,10 +307,12 @@ begin ...@@ -304,10 +307,12 @@ begin
resp := await(xdwcMap.RawInvokeAsync('IApiService.GetComplaintMap', [])); resp := await(xdwcMap.RawInvokeAsync('IApiService.GetComplaintMap', []));
root := TJSObject(resp.Result); root := TJSObject(resp.Result);
complaintsData := TJSArray(root['data']); complaintsData := TJSArray(root['data']);
FComplaintsLoaded := True; FComplaintsLoaded := Assigned(complaintsData);
except except
on E: EXDataClientRequestException do on E: EXDataClientRequestException do
Console.Log('Complaints XData error: ' + E.ErrorResult.ErrorMessage); Console.Log('Complaints XData error: ' + E.ErrorResult.ErrorMessage);
on E: Exception do
Console.Log('Complaints error: ' + E.Message);
end; end;
// A WebSocket snapshot received while the HTTP requests were in flight is // A WebSocket snapshot received while the HTTP requests were in flight is
...@@ -329,7 +334,9 @@ begin ...@@ -329,7 +334,9 @@ begin
// --- Place markers (BeginUpdate wraps both so the map redraws once) ------ // --- Place markers (BeginUpdate wraps both so the map redraws once) ------
lfMap.BeginUpdate; lfMap.BeginUpdate;
try try
if FUnitsLoaded then
PlaceUnitMarkers(unitsData); PlaceUnitMarkers(unitsData);
if FComplaintsLoaded then
PlaceComplaintMarkers(complaintsData); PlaceComplaintMarkers(complaintsData);
finally finally
lfMap.EndUpdate; lfMap.EndUpdate;
...@@ -344,6 +351,12 @@ begin ...@@ -344,6 +351,12 @@ begin
if showBusy then if showBusy then
HideSpinner('spinner'); HideSpinner('spinner');
FLoadingPoints := False; FLoadingPoints := False;
if FRefreshPending then
begin
FRefreshPending := False;
LoadPointsAsync(False);
end;
end; end;
end; end;
...@@ -716,22 +729,17 @@ begin ...@@ -716,22 +729,17 @@ begin
end; end;
procedure TFViewMap.btnFindLocationClick(Sender: TObject); procedure TFViewMap.btnFindLocationClick(Sender: TObject);
var
coord: TTMSFNCMapsCoordinateRec;
begin begin
if userLocationMarker = nil then tmrLocate.Enabled := False;
Exit; FDoFocusZoom := False;
coord := CreateCoordinate(userLocationMarker.Latitude, userLocationMarker.Longitude);
lfMap.SetCenterCoordinate(coord);
FPendingFocusCoord := coord;
FPendingFocusZoom := 17;
FDoFocusZoom := True;
FPendingFocusMarkerData := ''; FPendingFocusMarkerData := '';
FPendingUnitId := '';
FPendingComplaintId := '';
tmrLocate.Interval := 250; if lfMap.Polygons.Count = 0 then
tmrLocate.Enabled := True; Exit;
lfMap.ZoomToBounds(lfMap.Polygons.ToCoordinateArray);
end; end;
...@@ -855,6 +863,13 @@ end; ...@@ -855,6 +863,13 @@ end;
procedure TFViewMap.RefreshData; procedure TFViewMap.RefreshData;
begin begin
Console.Log('Map.RefreshData'); Console.Log('Map.RefreshData');
if FLoadingPoints then
begin
FRefreshPending := True;
Exit;
end;
LoadPointsAsync(False); LoadPointsAsync(False);
end; end;
......
...@@ -37,6 +37,8 @@ type ...@@ -37,6 +37,8 @@ type
private private
FLoading: Boolean; FLoading: Boolean;
FFirstLoad: Boolean; FFirstLoad: Boolean;
FRefreshPending: Boolean;
FPendingWsData: TJSObject;
[async] procedure GetUnits; [async] procedure GetUnits;
procedure HandleListClick(e: TJSMouseEvent); procedure HandleListClick(e: TJSMouseEvent);
public public
...@@ -57,6 +59,8 @@ begin ...@@ -57,6 +59,8 @@ begin
DMConnection.ApiConnection.Connected := True; DMConnection.ApiConnection.Connected := True;
Document.addEventListener('click', @HandleListClick); Document.addEventListener('click', @HandleListClick);
FFirstLoad := True; FFirstLoad := True;
FRefreshPending := False;
FPendingWsData := nil;
GetUnits; GetUnits;
asm asm
...@@ -158,12 +162,32 @@ begin ...@@ -158,12 +162,32 @@ begin
FFirstLoad := False; FFirstLoad := False;
FLoading := False; FLoading := False;
if Assigned(FPendingWsData) then
begin
respObj := FPendingWsData;
FPendingWsData := nil;
ApplyWsData(respObj);
end;
if FRefreshPending then
begin
FRefreshPending := False;
GetUnits;
end;
end; end;
end; end;
procedure TFViewUnits.RefreshData; procedure TFViewUnits.RefreshData;
begin begin
Console.Log('Units.RefreshData'); Console.Log('Units.RefreshData');
if FLoading then
begin
FRefreshPending := True;
Exit;
end;
GetUnits; GetUnits;
end; end;
...@@ -172,7 +196,10 @@ var ...@@ -172,7 +196,10 @@ var
unitCount: Integer; unitCount: Integer;
begin begin
if FLoading then if FLoading then
begin
FPendingWsData := aRespObj;
Exit; Exit;
end;
xdwdsUnits.Close; xdwdsUnits.Close;
xdwdsUnits.SetJsonData(aRespObj['data']); xdwdsUnits.SetJsonData(aRespObj['data']);
......
...@@ -86,12 +86,76 @@ html, body { ...@@ -86,12 +86,76 @@ html, body {
/*padding-top: 2em !important;*/ /*padding-top: 2em !important;*/
} }
.vh-100 { .vh-100 {
height: 94vh !important; height: 93vh !important;
} }
} }
.tab-hidden { display: none !important; } .tab-hidden { display: none !important; }
.connection-status {
display: inline-flex;
align-items: center;
gap: 0.35rem;
min-height: 1.75rem;
padding: 0.2rem 0.55rem;
border: 1px solid rgba(255, 255, 255, 0.35);
border-radius: 999px;
color: #fff;
font-size: 0.75rem;
font-weight: 600;
line-height: 1;
white-space: nowrap;
}
.connection-status-dot {
width: 0.55rem;
height: 0.55rem;
flex: 0 0 auto;
border-radius: 50%;
background-color: #adb5bd;
}
.connection-status-connected .connection-status-dot {
background-color: #75d995;
box-shadow: 0 0 0 0.14rem rgba(117, 217, 149, 0.2);
}
.connection-status-connecting .connection-status-dot,
.connection-status-reconnecting .connection-status-dot {
background-color: #ffd166;
animation: connection-status-pulse 1.4s ease-in-out infinite;
}
.connection-status-offline .connection-status-dot,
.connection-status-stopped .connection-status-dot {
background-color: #ff8b94;
}
@keyframes connection-status-pulse {
0%, 100% { opacity: 0.45; }
50% { opacity: 1; }
}
@media (max-width: 430px) {
.connection-status {
width: 1.75rem;
justify-content: center;
padding-right: 0;
padding-left: 0;
}
.connection-status-text {
display: none;
}
}
@media (prefers-reduced-motion: reduce) {
.connection-status-connecting .connection-status-dot,
.connection-status-reconnecting .connection-status-dot {
animation: none;
}
}
.summary-chevron-icon { .summary-chevron-icon {
width: 1rem; width: 1rem;
height: 1rem; height: 1rem;
......
program wcEmiMobile; program wcEmiMobile;
{$R *.dres} {$R *.dres}
uses uses
...@@ -109,3 +105,4 @@ begin ...@@ -109,3 +105,4 @@ begin
Application.Run; Application.Run;
DMConnection.InitApp(@StartApplication, @UnauthorizedAccessProc); DMConnection.InitApp(@StartApplication, @UnauthorizedAccessProc);
end. end.
...@@ -91,13 +91,13 @@ ...@@ -91,13 +91,13 @@
<DCC_RemoteDebug>false</DCC_RemoteDebug> <DCC_RemoteDebug>false</DCC_RemoteDebug>
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo> <VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
<VerInfo_Locale>1033</VerInfo_Locale> <VerInfo_Locale>1033</VerInfo_Locale>
<VerInfo_Keys>CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=0.9.4.1;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=0.9.3.0;Comments=;LastCompiledTime=2018/08/27 15:18:29</VerInfo_Keys> <VerInfo_Keys>CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=0.9.4.3;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=0.9.3.0;Comments=;LastCompiledTime=2018/08/27 15:18:29</VerInfo_Keys>
<AppDPIAwarenessMode>PerMonitor</AppDPIAwarenessMode> <AppDPIAwarenessMode>PerMonitor</AppDPIAwarenessMode>
<VerInfo_MinorVer>9</VerInfo_MinorVer> <VerInfo_MinorVer>9</VerInfo_MinorVer>
<VerInfo_MajorVer>0</VerInfo_MajorVer> <VerInfo_MajorVer>0</VerInfo_MajorVer>
<VerInfo_Release>4</VerInfo_Release> <VerInfo_Release>4</VerInfo_Release>
<VerInfo_Build>3</VerInfo_Build>
<TMSWebSingleInstance>1</TMSWebSingleInstance> <TMSWebSingleInstance>1</TMSWebSingleInstance>
<VerInfo_Build>1</VerInfo_Build>
<TMSWebBrowser>1</TMSWebBrowser> <TMSWebBrowser>1</TMSWebBrowser>
<TMSWebOutputPath>..\emiMobileServer\bin\static</TMSWebOutputPath> <TMSWebOutputPath>..\emiMobileServer\bin\static</TMSWebOutputPath>
<TMSUseJSDebugger>2</TMSUseJSDebugger> <TMSUseJSDebugger>2</TMSUseJSDebugger>
......
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