Skip to content
Projects
Groups
Snippets
Help
This project
Loading...
Sign in / Register
Toggle navigation
E
emiMobile
Overview
Overview
Details
Activity
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
0
Issues
0
List
Board
Labels
Milestones
Merge Requests
0
Merge Requests
0
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Charts
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
Mac Stephens
emiMobile
Commits
070b7b50
Commit
070b7b50
authored
Sep 10, 2026
by
Michael Brachmann
Browse files
Options
Browse Files
Download
Plain Diff
pull in main branch changes
parents
886d9a67
9cdc7cfd
Expand all
Show whitespace changes
Inline
Side-by-side
Showing
24 changed files
with
434 additions
and
69 deletions
+434
-69
Api.Server.Module.dfm
emiMobileServer/Source/Api.Server.Module.dfm
+3
-0
Api.Server.Module.pas
emiMobileServer/Source/Api.Server.Module.pas
+10
-1
Auth.ServiceImpl.pas
emiMobileServer/Source/Auth.ServiceImpl.pas
+11
-4
Common.Ini.pas
emiMobileServer/Source/Common.Ini.pas
+1
-1
Main.dfm
emiMobileServer/Source/Main.dfm
+13
-1
Main.pas
emiMobileServer/Source/Main.pas
+9
-0
WebSocket.Manager.pas
emiMobileServer/Source/WebSocket.Manager.pas
+0
-0
emiMobileServer.ini
emiMobileServer/bin/emiMobileServer.ini
+6
-6
emiMobileServer.dpr
emiMobileServer/emiMobileServer.dpr
+2
-2
emiMobileServer.dproj
emiMobileServer/emiMobileServer.dproj
+2
-2
ConnectionModule.pas
webEMIMobile/ConnectionModule.pas
+4
-2
Module.Websocket.pas
webEMIMobile/Module.Websocket.pas
+0
-0
View.Complaints.pas
webEMIMobile/View.Complaints.pas
+27
-0
View.Login.dfm
webEMIMobile/View.Login.dfm
+14
-2
View.Login.pas
webEMIMobile/View.Login.pas
+21
-2
View.Main.html
webEMIMobile/View.Main.html
+23
-4
View.Main.pas
webEMIMobile/View.Main.pas
+156
-13
View.Map.dfm
webEMIMobile/View.Map.dfm
+0
-1
View.Map.html
webEMIMobile/View.Map.html
+7
-6
View.Map.pas
webEMIMobile/View.Map.pas
+30
-15
View.Units.pas
webEMIMobile/View.Units.pas
+27
-0
app.css
webEMIMobile/css/app.css
+65
-1
wcEmiMobile.dpr
webEMIMobile/wcEmiMobile.dpr
+1
-4
wcEmiMobile.dproj
webEMIMobile/wcEmiMobile.dproj
+2
-2
No files found.
emiMobileServer/Source/Api.Server.Module.dfm
View file @
070b7b50
...
...
@@ -26,5 +26,8 @@ object ApiServerModule: TApiServerModule
object XDataServer1JWT: TSparkleJwtMiddleware
OnGetSecret = XDataServer1JWTGetSecret
end
object XDataServer1Forward: TSparkleForwardMiddleware
OnAcceptProxy = XDataServer1ForwardAcceptProxy
end
end
end
emiMobileServer/Source/Api.Server.Module.pas
View file @
070b7b50
...
...
@@ -13,7 +13,7 @@ uses
Sparkle
.
HttpServer
.
Module
,
Sparkle
.
HttpServer
.
Context
,
Sparkle
.
Comp
.
CompressMiddleware
,
Sparkle
.
Comp
.
CorsMiddleware
,
Sparkle
.
Comp
.
GenericMiddleware
,
Aurelius
.
Drivers
.
UniDac
,
UniProvider
,
Data
.
DB
,
DBAccess
,
Uni
;
Data
.
DB
,
DBAccess
,
Uni
,
Sparkle
.
Comp
.
ForwardMiddleware
;
type
TApiServerModule
=
class
(
TDataModule
)
...
...
@@ -23,9 +23,12 @@ type
XDataServer1CORS
:
TSparkleCorsMiddleware
;
XDataServer1Compress
:
TSparkleCompressMiddleware
;
XDataServer1JWT
:
TSparkleJwtMiddleware
;
XDataServer1Forward
:
TSparkleForwardMiddleware
;
procedure
XDataServer1LoggingMiddlewareCreate
(
Sender
:
TObject
;
var
Middleware
:
IHttpServerMiddleware
);
procedure
XDataServer1JWTGetSecret
(
Sender
:
TObject
;
var
Secret
:
string
);
procedure
XDataServer1ForwardAcceptProxy
(
Sender
:
TObject
;
const
Value
:
string
;
var
Accept
:
Boolean
);
private
{ Private declarations }
public
...
...
@@ -89,6 +92,12 @@ begin
Middleware
:=
TLoggingMiddleware
.
Create
(
Logger
);
end
;
procedure
TApiServerModule
.
XDataServer1ForwardAcceptProxy
(
Sender
:
TObject
;
const
Value
:
string
;
var
Accept
:
Boolean
);
begin
Accept
:=
True
;
end
;
procedure
TApiServerModule
.
XDataServer1JWTGetSecret
(
Sender
:
TObject
;
var
Secret
:
string
);
begin
...
...
emiMobileServer/Source/Auth.ServiceImpl.pas
View file @
070b7b50
...
...
@@ -1063,7 +1063,8 @@ var
iniFile
:
TIniFile
;
webClientVersion
:
string
;
begin
Logger
.
Log
(
3
,
'AuthService.VerifyVersion called'
);
Logger
.
Log
(
1
,
Format
(
'Client version check started: client="%s"'
,
[
ClientVersion
]));
Result
:=
TJSONObject
.
Create
;
TXDataOperationContext
.
Current
.
Handler
.
ManagedObjects
.
Add
(
Result
);
...
...
@@ -1075,20 +1076,26 @@ begin
if
webClientVersion
=
''
then
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.'
);
Exit
;
end
;
if
clientVersion
<>
webClientVersion
then
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'
,
'Your browser is running an old version of the app.'
+
sLineBreak
+
'Please click below to reload.'
);
end
else
Logger
.
Log
(
3
,
'AuthService.VerifyVersion: version check passed'
);
Logger
.
Log
(
1
,
Format
(
'Client version check succeeded: client="%s", required="%s"'
,
[
ClientVersion
,
webClientVersion
]));
finally
iniFile
.
Free
;
end
;
...
...
emiMobileServer/Source/Common.Ini.pas
View file @
070b7b50
...
...
@@ -97,7 +97,7 @@ begin
FDatabaseServer
:=
iniFile
.
ReadString
(
'Database'
,
'Server'
,
''
);
FDatabaseServerFromIni
:=
iniFile
.
ValueExists
(
'Database'
,
'Server'
);
FDatabasePort
:=
iniFile
.
ReadInteger
(
'Database'
,
'Port'
,
543
3
);
FDatabasePort
:=
iniFile
.
ReadInteger
(
'Database'
,
'Port'
,
543
2
);
FDatabasePortFromIni
:=
iniFile
.
ValueExists
(
'Database'
,
'Port'
);
FDatabaseName
:=
iniFile
.
ReadString
(
'Database'
,
'Database'
,
'lems_wcso'
);
...
...
emiMobileServer/Source/Main.dfm
View file @
070b7b50
...
...
@@ -68,6 +68,13 @@ object FMain: TFMain
end
item
Expanded = False
FieldName = 'ClientVersion'
Title.Caption = 'Version'
Width = 80
Visible = True
end
item
Expanded = False
FieldName = 'ConnectedAt'
Width = 150
Visible = True
...
...
@@ -87,7 +94,7 @@ object FMain: TFMain
Top = 18
Width = 141
Height = 25
Caption = '
Disconnect Selected
Client'
Caption = '
Refresh
Client'
TabOrder = 0
OnClick = btnDisconnectClientClick
end
...
...
@@ -162,6 +169,11 @@ object FMain: TFMain
Size = 30
end
item
Name = 'ClientVersion'
DataType = ftString
Size = 20
end
item
Name = 'ConnectedAt'
DataType = ftDateTime
end>
...
...
emiMobileServer/Source/Main.pas
View file @
070b7b50
...
...
@@ -181,6 +181,14 @@ begin
Logger
.
Log
(
1
,
LogValue
(
'--Settings->LogFileNum'
,
IniEntries
.
LogFileNum
.
ToString
,
IniEntries
.
LogFileNumFromIni
));
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
,
'--- URLs ---'
);
...
...
@@ -233,6 +241,7 @@ begin
tblConnectedClients
.
Append
;
tblConnectedClients
.
FieldByName
(
'ConnectionId'
).
AsString
:=
client
.
ConnectionId
;
tblConnectedClients
.
FieldByName
(
'UserId'
).
AsString
:=
client
.
UserId
;
tblConnectedClients
.
FieldByName
(
'ClientVersion'
).
AsString
:=
client
.
ClientVersion
;
tblConnectedClients
.
FieldByName
(
'ConnectedAt'
).
AsDateTime
:=
client
.
ConnectedAt
;
tblConnectedClients
.
Post
;
end
;
...
...
emiMobileServer/Source/WebSocket.Manager.pas
View file @
070b7b50
This diff is collapsed.
Click to expand it.
emiMobileServer/bin/emiMobileServer.ini
View file @
070b7b50
[Settings]
LogFileNum
=
1
53
webClientVersion
=
0.9.4.
1
LogFileNum
=
1
07
webClientVersion
=
0.9.4.
3
[Database]
Server
=
192.168.91.136
--
Server
=
192.168.102.10
--Server
=
192.168.91.129
Server
=
192.168.102.10
--Server
=
192.168.56.129
--Port
=
5432
--Port
=
5433
Database
=
lems_wcso
Username
=
postgres
Password
=
postgreSQL
--
Password
=
emsys01
--
Password
=
postgreSQL
Password
=
emsys01
--Postgre!SQL
emiMobileServer/emiMobileServer.dpr
View file @
070b7b50
...
...
@@ -114,9 +114,9 @@ begin
iniFile := TIniFile.Create( ChangeFileExt(Application.ExeName, '.ini') );
try
fileNum := iniFile.ReadInteger( 'Settings', 'LogFileNum', 0 );
fileNum := iniFile.ReadInteger( 'Settings', 'LogFileNum', 0 )
+ 1
;
FFilename := AFilename + Format( '%.4d', [fileNum] );
iniFile.WriteInteger( 'Settings', 'LogFileNum', fileNum
+ 1
);
iniFile.WriteInteger( 'Settings', 'LogFileNum', fileNum );
finally
iniFile.Free;
end;
...
...
emiMobileServer/emiMobileServer.dproj
View file @
070b7b50
...
...
@@ -108,9 +108,9 @@
<VerInfo_MajorVer>0</VerInfo_MajorVer>
<VerInfo_MinorVer>9</VerInfo_MinorVer>
<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>
<VerInfo_Build>
1
</VerInfo_Build>
<VerInfo_Build>
3
</VerInfo_Build>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_1_Win64)'!=''">
<AppDPIAwarenessMode>PerMonitorV2</AppDPIAwarenessMode>
...
...
webEMIMobile/ConnectionModule.pas
View file @
070b7b50
...
...
@@ -21,7 +21,7 @@ type
procedure
VerifyVersion
(
SuccessProc
:
TSuccessProc
);
public
property
WsUrl
:
string
read
FWsUrl
;
const
clientVersion
=
'0.9.4.
1
'
;
const
clientVersion
=
'0.9.4.
3
'
;
procedure
InitApp
(
SuccessProc
:
TSuccessProc
;
UnauthorizedAccessProc
:
TUnauthorizedAccessProc
);
end
;
...
...
@@ -110,7 +110,9 @@ begin
error
:=
''
;
if
error
<>
''
then
TFViewErrorPage
.
Display
(
error
)
TFViewErrorPage
.
Display
(
error
+
sLineBreak
+
sLineBreak
+
'Current client version: v'
+
clientVersion
)
else
SuccessProc
;
end
,
...
...
webEMIMobile/Module.Websocket.pas
View file @
070b7b50
This diff is collapsed.
Click to expand it.
webEMIMobile/View.Complaints.pas
View file @
070b7b50
...
...
@@ -39,6 +39,8 @@ type
FSelectProc
:
TSelectProc
;
FLoading
:
Boolean
;
FFirstLoad
:
Boolean
;
FRefreshPending
:
Boolean
;
FPendingWsData
:
TJSObject
;
[
async
]
procedure
GetComplaints
;
procedure
HandleListClick
(
e
:
TJSMouseEvent
);
procedure
ShowHideBusinessRows
;
...
...
@@ -59,6 +61,8 @@ procedure TFViewComplaints.WebFormCreate(Sender: TObject);
begin
Document
.
addEventListener
(
'click'
,
@
HandleListClick
);
FFirstLoad
:=
True
;
FRefreshPending
:=
False
;
FPendingWsData
:=
nil
;
GetComplaints
;
asm
if
(!
window
.
showComplaintDetails
)
{
...
...
@@ -178,12 +182,32 @@ begin
HideSpinner
(
'spinner'
);
FFirstLoad
:=
False
;
end
;
if
Assigned
(
FPendingWsData
)
then
begin
respObj
:=
FPendingWsData
;
FPendingWsData
:=
nil
;
ApplyWsData
(
respObj
);
end
;
if
FRefreshPending
then
begin
FRefreshPending
:=
False
;
GetComplaints
;
end
;
end
;
end
;
procedure
TFViewComplaints
.
RefreshData
;
begin
Console
.
Log
(
'Complaints.RefreshData'
);
if
FLoading
then
begin
FRefreshPending
:=
True
;
Exit
;
end
;
GetComplaints
;
end
;
...
...
@@ -192,7 +216,10 @@ var
complaintsCount
:
Integer
;
begin
if
FLoading
then
begin
FPendingWsData
:=
aRespObj
;
Exit
;
end
;
xdwdsComplaints
.
Close
;
xdwdsComplaints
.
SetJsonData
(
aRespObj
[
'data'
]);
...
...
webEMIMobile/View.Login.dfm
View file @
070b7b50
...
...
@@ -41,6 +41,18 @@ object FViewLogin: TFViewLogin
TextHint = 'Password'
WidthPercent = 100.000000000000000000
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
Left = 240
Top = 217
...
...
@@ -49,7 +61,7 @@ object FViewLogin: TFViewLogin
Caption = 'Login'
ElementID = 'view.login.btnlogin'
HeightPercent = 100.000000000000000000
TabOrder =
2
TabOrder =
3
WidthPercent = 100.000000000000000000
OnClick = btnLoginClick
end
...
...
@@ -59,7 +71,7 @@ object FViewLogin: TFViewLogin
Width = 121
Height = 33
ElementID = 'view.login.message'
TabOrder =
3
TabOrder =
4
object lblMessage: TWebLabel
Left = 16
Top = 11
...
...
webEMIMobile/View.Login.pas
View file @
070b7b50
...
...
@@ -13,6 +13,7 @@ type
WebLabel1
:
TWebLabel
;
edtUsername
:
TWebEdit
;
edtPassword
:
TWebEdit
;
btnShowPassword
:
TWebButton
;
btnLogin
:
TWebButton
;
pnlMessage
:
TWebPanel
;
lblMessage
:
TWebLabel
;
...
...
@@ -20,6 +21,7 @@ type
XDataWebClient
:
TXDataWebClient
;
lucbAgency
:
TWebLookupComboBox
;
procedure
btnLoginClick
(
Sender
:
TObject
);
procedure
btnShowPasswordClick
(
Sender
:
TObject
);
procedure
btnCloseNotificationClick
(
Sender
:
TObject
);
procedure
WebFormCreate
(
Sender
:
TObject
);
private
...
...
@@ -351,6 +353,23 @@ begin
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
OnLoad
(
Response
:
TXDataClientResponse
);
...
...
@@ -391,13 +410,13 @@ begin
if
Notification
<>
''
then
begin
lblMessage
.
Caption
:=
Notification
;
pnlMessage
.
ElementHandle
.
hidden
:=
False
;
pnlMessage
.
ElementHandle
.
classList
.
remove
(
'd-none'
)
;
end
;
end
;
procedure
TFViewLogin
.
HideNotification
;
begin
pnlMessage
.
ElementHandle
.
hidden
:=
True
;
pnlMessage
.
ElementHandle
.
classList
.
add
(
'd-none'
)
;
end
;
procedure
TFViewLogin
.
btnCloseNotificationClick
(
Sender
:
TObject
);
...
...
webEMIMobile/View.Main.html
View file @
070b7b50
...
...
@@ -11,13 +11,32 @@
<span
id=
"lbl_main_title"
class=
"navbar-brand text-light mb-0 ms-1"
></span>
</div>
<!-- Right: Connection /
Logout
-->
<!-- Right: Connection /
Menu
-->
<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>
<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>
</nav>
...
...
webEMIMobile/View.Main.pas
View file @
070b7b50
...
...
@@ -56,7 +56,11 @@ type
FDetailsForm
:
TWebForm
;
FArchiveForm
:
TWebForm
;
FLogoutProc
:
TLogoutProc
;
FBadgeRefreshInProgress
:
Boolean
;
FBadgeRefreshPending
:
Boolean
;
FPendingWsBadgeCounts
:
TJSObject
;
[
async
]
procedure
RefreshBadgesAsync
;
procedure
ApplyBadgeCounts
(
aData
:
TJSObject
);
procedure
ShowUnitDetails
(
UnitId
:
string
);
procedure
SetHeaderTitle
(
const
title
:
string
);
procedure
HideDetailsModal
;
...
...
@@ -70,6 +74,10 @@ type
procedure
HandleWsComplaintMap
(
aData
:
TJSObject
);
procedure
HandleWsUnitList
(
aData
:
TJSObject
);
procedure
HandleWsComplaintList
(
aData
:
TJSObject
);
procedure
HandleWsConnectionState
(
AState
:
TWsConnectionState
);
procedure
HandleWsRecoveryRequired
;
procedure
HandleWsAuthenticationExpired
;
procedure
ResyncLiveData
;
type
TActivePanel
=
(
apNone
,
apMap
,
apUnits
,
apComplaints
);
var
...
...
@@ -86,6 +94,7 @@ type
public
{ Public declarations }
destructor
Destroy
;
override
;
class
procedure
Display
(
LogoutProc
:
TLogoutProc
);
procedure
ShowForm
(
AFormClass
:
TWebFormClass
);
procedure
ShowComplaintDetails
(
ComplaintId
:
string
);
...
...
@@ -124,15 +133,10 @@ const
procedure
TFViewMain
.
WebFormCreate
(
Sender
:
TObject
);
var
userName
:
string
;
el
:
TJSElement
;
begin
userName
:=
JS
.
toString
(
AuthService
.
TokenPayload
.
Properties
[
'user_name'
]);
lblUsername
.
Caption
:=
' '
+
userName
.
ToLower
+
' '
;
el
:=
Document
.
getElementById
(
'view.main.version'
);
if
Assigned
(
el
)
then
TJSHtmlElement
(
el
).
innerText
:=
'v'
+
TDMConnection
.
clientVersion
;
FChildForm
:=
nil
;
FDetailsForm
:=
nil
;
FArchiveForm
:=
nil
;
...
...
@@ -142,6 +146,9 @@ begin
FMapRefreshTick
:=
0
;
FUnitsRefreshTick
:=
0
;
FComplaintsRefreshTick
:=
0
;
FBadgeRefreshInProgress
:=
False
;
FBadgeRefreshPending
:=
False
;
FPendingWsBadgeCounts
:=
nil
;
if
JS
.
toBoolean
(
AuthService
.
TokenPayload
.
Properties
[
'user_admin'
])
then
begin
...
...
@@ -187,9 +194,27 @@ begin
dmWebsocket
.
OnComplaintMap
:=
HandleWsComplaintMap
;
dmWebsocket
.
OnUnitList
:=
HandleWsUnitList
;
dmWebsocket
.
OnComplaintList
:=
HandleWsComplaintList
;
dmWebsocket
.
OnStateChanged
:=
HandleWsConnectionState
;
dmWebsocket
.
OnRecoveryRequired
:=
HandleWsRecoveryRequired
;
dmWebsocket
.
OnAuthenticationExpired
:=
HandleWsAuthenticationExpired
;
dmWebsocket
.
Connect
(
DMConnection
.
WsUrl
);
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
);
begin
FActivePanel
:=
panel
;
...
...
@@ -485,10 +510,13 @@ end;
// WebSocket push handlers
// ---------------------------------------------------------------------------
procedure
TFViewMain
.
HandleWs
BadgeCounts
(
aData
:
TJSObject
);
procedure
TFViewMain
.
Apply
BadgeCounts
(
aData
:
TJSObject
);
var
el
:
TJSElement
;
begin
if
not
Assigned
(
aData
)
then
Exit
;
el
:=
Document
.
getElementById
(
'view.main.badgecomplaints'
);
if
Assigned
(
el
)
then
TJSHtmlElement
(
el
).
innerText
:=
string
(
aData
[
'BadgeComplaints'
]);
...
...
@@ -498,6 +526,17 @@ begin
TJSHtmlElement
(
el
).
innerText
:=
string
(
aData
[
'BadgeUnits'
]);
end
;
procedure
TFViewMain
.
HandleWsBadgeCounts
(
aData
:
TJSObject
);
begin
if
FBadgeRefreshInProgress
then
begin
FPendingWsBadgeCounts
:=
aData
;
Exit
;
end
;
ApplyBadgeCounts
(
aData
);
end
;
procedure
TFViewMain
.
HandleWsUnitMap
(
aData
:
TJSObject
);
begin
if
Assigned
(
FMapForm
)
then
...
...
@@ -522,6 +561,83 @@ begin
FComplaintsForm
.
ApplyWsData
(
aData
);
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
);
...
...
@@ -545,27 +661,54 @@ var
badgeObj
:
TJSObject
;
el
:
TJSElement
;
begin
if
FBadgeRefreshInProgress
then
begin
FBadgeRefreshPending
:=
True
;
Exit
;
end
;
FBadgeRefreshInProgress
:=
True
;
try
try
resp
:=
await
(
xdwcBadgeCounts
.
RawInvokeAsync
(
'IApiService.GetBadgeCounts'
,
[]));
badgeObj
:=
TJSObject
(
resp
.
Result
);
el
:=
Document
.
getElementById
(
'view.main.badgecomplaints'
);
if
Assigned
(
el
)
the
n
TJSHtmlElement
(
el
).
innerText
:=
string
(
badgeObj
[
'BadgeComplaints'
]
);
el
:=
Document
.
getElementById
(
'view.main.badgeunits'
);
if
Assigned
(
el
)
then
TJSHtmlElement
(
el
).
innerText
:=
string
(
badgeObj
[
'BadgeUnits'
]
);
if
Assigned
(
FPendingWsBadgeCounts
)
then
begi
n
ApplyBadgeCounts
(
FPendingWsBadgeCounts
);
FPendingWsBadgeCounts
:=
nil
;
end
else
ApplyBadgeCounts
(
badgeObj
);
except
on
E
:
Exception
do
begin
if
Assigned
(
FPendingWsBadgeCounts
)
then
begin
ApplyBadgeCounts
(
FPendingWsBadgeCounts
);
FPendingWsBadgeCounts
:=
nil
;
end
else
begin
el
:=
Document
.
getElementById
(
'view.main.badgecomplaints'
);
if
Assigned
(
el
)
then
TJSHtmlElement
(
el
).
innerText
:=
'�'
;
el
:=
Document
.
getElementById
(
'view.main.badgeunits'
);
if
Assigned
(
el
)
then
TJSHtmlElement
(
el
).
innerText
:=
'�'
;
end
;
Console
.
Log
(
'Badge refresh error: '
+
E
.
Message
);
end
;
end
;
finally
FBadgeRefreshInProgress
:=
False
;
if
FBadgeRefreshPending
then
begin
FBadgeRefreshPending
:=
False
;
RefreshBadgesAsync
;
end
;
end
;
end
;
...
...
webEMIMobile/View.Map.dfm
View file @
070b7b50
...
...
@@ -62,7 +62,6 @@ object FViewMap: TFViewMap
end
object httpReqGeoJson: TWebHttpRequest
ResponseType = rtText
URL = 'assets/orleanscounty.geojson'
OnResponse = httpReqGeoJsonResponse
Left = 116
Top = 698
...
...
webEMIMobile/View.Map.html
View file @
070b7b50
...
...
@@ -52,16 +52,17 @@
<i
class=
"fa fa-crosshairs"
></i>
</button>
<!-- Filters (
top-right
) -->
<!-- Filters (
bottom-right, above recenter
) -->
<button
id=
"btn_map_filters"
type=
"button"
class=
"btn btn-primary position-absolute
top-0 end-0 m
-2 shadow"
style=
"z-index:1000;"
class=
"btn btn-primary position-absolute
end-0 me
-2 shadow"
style=
"z-index:1000;
bottom:4.5rem;
"
data-bs-toggle=
"offcanvas"
data-bs-target=
"#map_filters_offcanvas"
aria-controls=
"map_filters_offcanvas"
>
<i
class=
"fa fa-sliders-h"
></i>
<span
class=
"d-none d-sm-inline"
>
Filters
</span>
aria-controls=
"map_filters_offcanvas"
aria-label=
"Map filters"
title=
"Map filters"
>
<i
class=
"fa fa-sliders-h"
aria-hidden=
"true"
></i>
</button>
</div>
</div>
...
...
webEMIMobile/View.Map.pas
View file @
070b7b50
...
...
@@ -31,6 +31,7 @@ type
FUnitsLoaded
:
Boolean
;
FComplaintsLoaded
:
Boolean
;
FLoadingPoints
:
Boolean
;
FRefreshPending
:
Boolean
;
mapFilters
:
TMapFilters
;
FPendingUnitId
:
string
;
FPendingComplaintId
:
string
;
...
...
@@ -293,10 +294,12 @@ begin
resp
:=
await
(
xdwcMap
.
RawInvokeAsync
(
'IApiService.GetUnitMap'
,
[]));
root
:=
TJSObject
(
resp
.
Result
);
unitsData
:=
TJSArray
(
root
[
'data'
]);
FUnitsLoaded
:=
True
;
FUnitsLoaded
:=
Assigned
(
unitsData
)
;
except
on
E
:
EXDataClientRequestException
do
Console
.
Log
(
'Units XData error: '
+
E
.
ErrorResult
.
ErrorMessage
);
on
E
:
Exception
do
Console
.
Log
(
'Units error: '
+
E
.
Message
);
end
;
// --- Fetch Complaints ----------------------------------------------------
...
...
@@ -304,10 +307,12 @@ begin
resp
:=
await
(
xdwcMap
.
RawInvokeAsync
(
'IApiService.GetComplaintMap'
,
[]));
root
:=
TJSObject
(
resp
.
Result
);
complaintsData
:=
TJSArray
(
root
[
'data'
]);
FComplaintsLoaded
:=
True
;
FComplaintsLoaded
:=
Assigned
(
complaintsData
)
;
except
on
E
:
EXDataClientRequestException
do
Console
.
Log
(
'Complaints XData error: '
+
E
.
ErrorResult
.
ErrorMessage
);
on
E
:
Exception
do
Console
.
Log
(
'Complaints error: '
+
E
.
Message
);
end
;
// A WebSocket snapshot received while the HTTP requests were in flight is
...
...
@@ -329,7 +334,9 @@ begin
// --- Place markers (BeginUpdate wraps both so the map redraws once) ------
lfMap
.
BeginUpdate
;
try
if
FUnitsLoaded
then
PlaceUnitMarkers
(
unitsData
);
if
FComplaintsLoaded
then
PlaceComplaintMarkers
(
complaintsData
);
finally
lfMap
.
EndUpdate
;
...
...
@@ -344,6 +351,12 @@ begin
if
showBusy
then
HideSpinner
(
'spinner'
);
FLoadingPoints
:=
False
;
if
FRefreshPending
then
begin
FRefreshPending
:=
False
;
LoadPointsAsync
(
False
);
end
;
end
;
end
;
...
...
@@ -716,22 +729,17 @@ begin
end
;
procedure
TFViewMap
.
btnFindLocationClick
(
Sender
:
TObject
);
var
coord
:
TTMSFNCMapsCoordinateRec
;
begin
if
userLocationMarker
=
nil
then
Exit
;
coord
:=
CreateCoordinate
(
userLocationMarker
.
Latitude
,
userLocationMarker
.
Longitude
);
lfMap
.
SetCenterCoordinate
(
coord
);
FPendingFocusCoord
:=
coord
;
FPendingFocusZoom
:=
17
;
FDoFocusZoom
:=
True
;
tmrLocate
.
Enabled
:=
False
;
FDoFocusZoom
:=
False
;
FPendingFocusMarkerData
:=
''
;
FPendingUnitId
:=
''
;
FPendingComplaintId
:=
''
;
tmrLocate
.
Interval
:=
250
;
tmrLocate
.
Enabled
:=
True
;
if
lfMap
.
Polygons
.
Count
=
0
then
Exit
;
lfMap
.
ZoomToBounds
(
lfMap
.
Polygons
.
ToCoordinateArray
);
end
;
...
...
@@ -855,6 +863,13 @@ end;
procedure
TFViewMap
.
RefreshData
;
begin
Console
.
Log
(
'Map.RefreshData'
);
if
FLoadingPoints
then
begin
FRefreshPending
:=
True
;
Exit
;
end
;
LoadPointsAsync
(
False
);
end
;
...
...
webEMIMobile/View.Units.pas
View file @
070b7b50
...
...
@@ -37,6 +37,8 @@ type
private
FLoading
:
Boolean
;
FFirstLoad
:
Boolean
;
FRefreshPending
:
Boolean
;
FPendingWsData
:
TJSObject
;
[
async
]
procedure
GetUnits
;
procedure
HandleListClick
(
e
:
TJSMouseEvent
);
public
...
...
@@ -57,6 +59,8 @@ begin
DMConnection
.
ApiConnection
.
Connected
:=
True
;
Document
.
addEventListener
(
'click'
,
@
HandleListClick
);
FFirstLoad
:=
True
;
FRefreshPending
:=
False
;
FPendingWsData
:=
nil
;
GetUnits
;
asm
...
...
@@ -158,12 +162,32 @@ begin
FFirstLoad
:=
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
;
procedure
TFViewUnits
.
RefreshData
;
begin
Console
.
Log
(
'Units.RefreshData'
);
if
FLoading
then
begin
FRefreshPending
:=
True
;
Exit
;
end
;
GetUnits
;
end
;
...
...
@@ -172,7 +196,10 @@ var
unitCount
:
Integer
;
begin
if
FLoading
then
begin
FPendingWsData
:=
aRespObj
;
Exit
;
end
;
xdwdsUnits
.
Close
;
xdwdsUnits
.
SetJsonData
(
aRespObj
[
'data'
]);
...
...
webEMIMobile/css/app.css
View file @
070b7b50
...
...
@@ -86,12 +86,76 @@ html, body {
/*padding-top: 2em !important;*/
}
.vh-100
{
height
:
9
4
vh
!important
;
height
:
9
3
vh
!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
{
width
:
1rem
;
height
:
1rem
;
...
...
webEMIMobile/wcEmiMobile.dpr
View file @
070b7b50
program wcEmiMobile;
{$R *.dres}
uses
...
...
@@ -109,3 +105,4 @@ begin
Application.Run;
DMConnection.InitApp(@StartApplication, @UnauthorizedAccessProc);
end.
webEMIMobile/wcEmiMobile.dproj
View file @
070b7b50
...
...
@@ -91,13 +91,13 @@
<DCC_RemoteDebug>false</DCC_RemoteDebug>
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
<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>
<VerInfo_MinorVer>9</VerInfo_MinorVer>
<VerInfo_MajorVer>0</VerInfo_MajorVer>
<VerInfo_Release>4</VerInfo_Release>
<VerInfo_Build>3</VerInfo_Build>
<TMSWebSingleInstance>1</TMSWebSingleInstance>
<VerInfo_Build>1</VerInfo_Build>
<TMSWebBrowser>1</TMSWebBrowser>
<TMSWebOutputPath>..\emiMobileServer\bin\static</TMSWebOutputPath>
<TMSUseJSDebugger>2</TMSUseJSDebugger>
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment