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
7d5a024b
Commit
7d5a024b
authored
Jul 16, 2026
by
Mac Stephens
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Update exception handling and memory management
parent
d17bf35c
Hide whitespace changes
Inline
Side-by-side
Showing
3 changed files
with
186 additions
and
123 deletions
+186
-123
Api.ServiceImpl.pas
emiMobileServer/Source/Api.ServiceImpl.pas
+145
-107
Auth.ServiceImpl.pas
emiMobileServer/Source/Auth.ServiceImpl.pas
+40
-15
emiMobileServer.ini
emiMobileServer/bin/emiMobileServer.ini
+1
-1
No files found.
emiMobileServer/Source/Api.ServiceImpl.pas
View file @
7d5a024b
...
...
@@ -16,7 +16,6 @@ type
private
procedure
AfterConstruction
;
override
;
procedure
BeforeDestruction
;
override
;
function
GetComplaintMemos
(
const
CfsId
:
string
):
TJSONObject
;
public
function
GetBadgeCounts
:
TJSONObject
;
function
GetComplaintList
:
TJSONObject
;
...
...
@@ -30,6 +29,7 @@ type
function
GetComplaintWarnings
(
const
ComplaintId
:
string
):
TJSONObject
;
function
GetUnitDetails
(
const
UnitId
:
string
):
TJSONObject
;
function
GetUnitLogs
(
const
UnitId
:
string
):
TJSONObject
;
function
GetComplaintMemos
(
const
CfsId
:
string
):
TJSONObject
;
end
;
implementation
...
...
@@ -73,7 +73,7 @@ begin
except
on
E
:
Exception
do
begin
Logger
.
Log
(
2
,
'---TApiService.GetBadgeCounts
End (error)
: '
+
E
.
Message
);
Logger
.
Log
(
2
,
'---TApiService.GetBadgeCounts
error: '
+
E
.
ClassName
+
'
: '
+
E
.
Message
);
raise
EXDataHttpException
.
Create
(
500
,
'Failed to load badge counts'
);
end
;
end
;
...
...
@@ -86,109 +86,134 @@ var
data
:
TJSONArray
;
emitted
:
Integer
;
item
:
TJSONObject
;
UnitsByComplaintMap
:
TObjectDictionary
<
string
,
TJSONArray
>;
UnitsByComplaintMap
:
TObjectDictionary
<
string
,
TJSONArray
>;
complaintId
:
string
;
unitArray
:
TJSONArray
;
unitStatus
:
string
;
latestUpdate
:
TDateTime
;
unitObj
:
TJSONObject
;
begin
Logger
.
Log
(
3
,
'---TApiService.GetComplaintMap initiated'
);
Logger
.
Log
(
3
,
'---TApiService.GetComplaintMap initiated'
);
Result
:=
TJSONObject
.
Create
;
Result
:=
TJSONObject
.
Create
;
TXDataOperationContext
.
Current
.
Handler
.
ManagedObjects
.
Add
(
Result
);
data
:=
TJSONArray
.
Create
;
UnitsByComplaintMap
:=
TObjectDictionary
<
string
,
TJSONArray
>.
Create
([
doOwnsValues
]
);
data
:=
TJSONArray
.
Create
;
Result
.
AddPair
(
'data'
,
data
);
UnitsByComplaintMap
:=
TObjectDictionary
<
string
,
TJSONArray
>.
Create
([
doOwnsValues
]);
try
ApiDB
.
uqMapComplaintUnitsList
.
Open
;
while
not
ApiDB
.
uqMapComplaintUnitsList
.
Eof
do
begin
complaintId
:=
ApiDB
.
uqMapComplaintUnitsListCOMPLAINTID
.
AsString
;
if
not
UnitsByComplaintMap
.
TryGetValue
(
complaintId
,
unitArray
)
then
begin
unitArray
:=
TJSONArray
.
Create
;
UnitsByComplaintMap
.
Add
(
complaintId
,
unitArray
);
end
;
try
ApiDB
.
uqMapComplaintUnitsList
.
Close
;
ApiDB
.
uqMapComplaintUnitsList
.
Open
;
try
while
not
ApiDB
.
uqMapComplaintUnitsList
.
Eof
do
begin
complaintId
:=
ApiDB
.
uqMapComplaintUnitsListCOMPLAINTID
.
AsString
;
unitStatus
:=
'Dispatched'
;
if
not
ApiDB
.
uqMapComplaintUnitsListDATECLEARED
.
IsNull
then
unitStatus
:=
'Cleared'
else
if
not
ApiDB
.
uqMapComplaintUnitsListDATEARRIVED
.
IsNull
then
unitStatus
:=
'On Scene'
else
if
not
ApiDB
.
uqMapComplaintUnitsListDATERESPONDED
.
IsNull
then
unitStatus
:=
'Enroute'
;
latestUpdate
:=
0
;
if
not
ApiDB
.
uqMapComplaintUnitsListDATEDISPATCHED
.
IsNull
then
latestUpdate
:=
ApiDB
.
uqMapComplaintUnitsListDATEDISPATCHED
.
AsDateTime
;
if
(
not
ApiDB
.
uqMapComplaintUnitsListDATERESPONDED
.
IsNull
)
and
(
ApiDB
.
uqMapComplaintUnitsListDATERESPONDED
.
AsDateTime
>
latestUpdate
)
then
latestUpdate
:=
ApiDB
.
uqMapComplaintUnitsListDATERESPONDED
.
AsDateTime
;
if
(
not
ApiDB
.
uqMapComplaintUnitsListDATEARRIVED
.
IsNull
)
and
(
ApiDB
.
uqMapComplaintUnitsListDATEARRIVED
.
AsDateTime
>
latestUpdate
)
then
latestUpdate
:=
ApiDB
.
uqMapComplaintUnitsListDATEARRIVED
.
AsDateTime
;
if
(
not
ApiDB
.
uqMapComplaintUnitsListDATECLEARED
.
IsNull
)
and
(
ApiDB
.
uqMapComplaintUnitsListDATECLEARED
.
AsDateTime
>
latestUpdate
)
then
latestUpdate
:=
ApiDB
.
uqMapComplaintUnitsListDATECLEARED
.
AsDateTime
;
unitObj
:=
TJSONObject
.
Create
;
unitObj
.
AddPair
(
'Unit'
,
ApiDB
.
uqMapComplaintUnitsListUNITNAME
.
AsString
);
unitObj
.
AddPair
(
'Status'
,
unitStatus
);
if
latestUpdate
<>
0
then
unitObj
.
AddPair
(
'Updated'
,
FormatDateTime
(
'yyyy-mm-dd hh:nn:ss'
,
latestUpdate
))
else
unitObj
.
AddPair
(
'Updated'
,
''
);
if
not
UnitsByComplaintMap
.
TryGetValue
(
complaintId
,
unitArray
)
then
begin
unitArray
:=
TJSONArray
.
Create
;
UnitsByComplaintMap
.
Add
(
complaintId
,
unitArray
);
end
;
unitArray
.
AddElement
(
unitObj
);
ApiDB
.
uqMapComplaintUnitsList
.
Next
;
end
;
unitStatus
:=
'Dispatched'
;
try
emitted
:=
0
;
if
not
ApiDB
.
uqMapComplaintUnitsListDATECLEARED
.
IsNull
then
unitStatus
:=
'Cleared'
else
if
not
ApiDB
.
uqMapComplaintUnitsListDATEARRIVED
.
IsNull
then
unitStatus
:=
'On Scene'
else
if
not
ApiDB
.
uqMapComplaintUnitsListDATERESPONDED
.
IsNull
then
unitStatus
:=
'Enroute'
;
latestUpdate
:=
0
;
if
not
ApiDB
.
uqMapComplaintUnitsListDATEDISPATCHED
.
IsNull
then
latestUpdate
:=
ApiDB
.
uqMapComplaintUnitsListDATEDISPATCHED
.
AsDateTime
;
if
(
not
ApiDB
.
uqMapComplaintUnitsListDATERESPONDED
.
IsNull
)
and
(
ApiDB
.
uqMapComplaintUnitsListDATERESPONDED
.
AsDateTime
>
latestUpdate
)
then
latestUpdate
:=
ApiDB
.
uqMapComplaintUnitsListDATERESPONDED
.
AsDateTime
;
if
(
not
ApiDB
.
uqMapComplaintUnitsListDATEARRIVED
.
IsNull
)
and
(
ApiDB
.
uqMapComplaintUnitsListDATEARRIVED
.
AsDateTime
>
latestUpdate
)
then
latestUpdate
:=
ApiDB
.
uqMapComplaintUnitsListDATEARRIVED
.
AsDateTime
;
if
(
not
ApiDB
.
uqMapComplaintUnitsListDATECLEARED
.
IsNull
)
and
(
ApiDB
.
uqMapComplaintUnitsListDATECLEARED
.
AsDateTime
>
latestUpdate
)
then
latestUpdate
:=
ApiDB
.
uqMapComplaintUnitsListDATECLEARED
.
AsDateTime
;
unitObj
:=
TJSONObject
.
Create
;
unitArray
.
AddElement
(
unitObj
);
unitObj
.
AddPair
(
'Unit'
,
ApiDB
.
uqMapComplaintUnitsListUNITNAME
.
AsString
);
unitObj
.
AddPair
(
'Status'
,
unitStatus
);
if
latestUpdate
<>
0
then
unitObj
.
AddPair
(
'Updated'
,
FormatDateTime
(
'yyyy-mm-dd hh:nn:ss'
,
latestUpdate
))
else
unitObj
.
AddPair
(
'Updated'
,
''
);
ApiDB
.
uqMapComplaintUnitsList
.
Next
;
end
;
finally
ApiDB
.
uqMapComplaintUnitsList
.
Close
;
end
;
emitted
:=
0
;
ApiDB
.
uqMapComplaints
.
Close
;
ApiDB
.
uqMapComplaints
.
Open
;
while
not
ApiDB
.
uqMapComplaints
.
Eof
do
begin
item
:=
TJSONObject
.
Create
;
item
.
AddPair
(
'ComplaintId'
,
ApiDB
.
uqMapComplaintsCOMPLAINTID
.
AsString
);
item
.
AddPair
(
'DispatchDistrict'
,
ApiDB
.
uqMapComplaintsDISPATCHDISTRICT
.
AsString
);
item
.
AddPair
(
'Agency'
,
ApiDB
.
uqMapComplaintsAGENCY
.
AsString
);
item
.
AddPair
(
'AgencyName'
,
ApiDB
.
uqMapComplaintsAGENCY_NAME
.
AsString
);
item
.
AddPair
(
'DispatchCodeDesc'
,
ApiDB
.
uqMapComplaintsDISPATCH_CODE_DESC
.
AsString
);
item
.
AddPair
(
'DispatchCodeCategory'
,
ApiDB
.
uqMapComplaintsDISPATCHCODECATEGORY
.
AsString
);
item
.
AddPair
(
'Priority'
,
ApiDB
.
uqMapComplaintsPRIORITY
.
AsString
);
item
.
AddPair
(
'PriorityBadge'
,
ApiDB
.
uqMapComplaintspriorityBadge
.
AsString
);
item
.
AddPair
(
'ComplaintStatusKey'
,
ApiDB
.
uqMapComplaintscomplaintStatusKey
.
AsString
);
item
.
AddPair
(
'pngName'
,
ApiDB
.
uqMapComplaintspngName
.
AsString
);
item
.
AddPair
(
'Address'
,
ApiDB
.
uqMapComplaintsADDRESS
.
AsString
);
item
.
AddPair
(
'Business'
,
ApiDB
.
uqMapComplaintsBUSINESS
.
AsString
);
complaintId
:=
ApiDB
.
uqMapComplaintsCOMPLAINTID
.
AsString
;
if
UnitsByComplaintMap
.
TryGetValue
(
complaintId
,
unitArray
)
then
item
.
AddPair
(
'Units'
,
TJSONArray
(
unitArray
.
Clone
))
else
item
.
AddPair
(
'Units'
,
TJSONArray
.
Create
);
try
while
not
ApiDB
.
uqMapComplaints
.
Eof
do
begin
item
:=
TJSONObject
.
Create
;
data
.
AddElement
(
item
);
item
.
AddPair
(
'Lat'
,
TJSONNumber
.
Create
(
ApiDB
.
uqMapComplaintsLAT
.
AsFloat
));
item
.
AddPair
(
'Lng'
,
TJSONNumber
.
Create
(
ApiDB
.
uqMapComplaintsLNG
.
AsFloat
));
item
.
AddPair
(
'ComplaintId'
,
ApiDB
.
uqMapComplaintsCOMPLAINTID
.
AsString
);
item
.
AddPair
(
'DispatchDistrict'
,
ApiDB
.
uqMapComplaintsDISPATCHDISTRICT
.
AsString
);
item
.
AddPair
(
'Agency'
,
ApiDB
.
uqMapComplaintsAGENCY
.
AsString
);
item
.
AddPair
(
'AgencyName'
,
ApiDB
.
uqMapComplaintsAGENCY_NAME
.
AsString
);
item
.
AddPair
(
'DispatchCodeDesc'
,
ApiDB
.
uqMapComplaintsDISPATCH_CODE_DESC
.
AsString
);
item
.
AddPair
(
'DispatchCodeCategory'
,
ApiDB
.
uqMapComplaintsDISPATCHCODECATEGORY
.
AsString
);
item
.
AddPair
(
'Priority'
,
ApiDB
.
uqMapComplaintsPRIORITY
.
AsString
);
item
.
AddPair
(
'PriorityBadge'
,
ApiDB
.
uqMapComplaintspriorityBadge
.
AsString
);
item
.
AddPair
(
'ComplaintStatusKey'
,
ApiDB
.
uqMapComplaintscomplaintStatusKey
.
AsString
);
item
.
AddPair
(
'pngName'
,
ApiDB
.
uqMapComplaintspngName
.
AsString
);
item
.
AddPair
(
'Address'
,
ApiDB
.
uqMapComplaintsADDRESS
.
AsString
);
item
.
AddPair
(
'Business'
,
ApiDB
.
uqMapComplaintsBUSINESS
.
AsString
);
complaintId
:=
ApiDB
.
uqMapComplaintsCOMPLAINTID
.
AsString
;
if
UnitsByComplaintMap
.
TryGetValue
(
complaintId
,
unitArray
)
then
item
.
AddPair
(
'Units'
,
TJSONArray
(
unitArray
.
Clone
))
else
item
.
AddPair
(
'Units'
,
TJSONArray
.
Create
);
data
.
AddElement
(
item
);
Inc
(
emitted
);
ApiDB
.
uqMapComplaints
.
Next
;
item
.
AddPair
(
'Lat'
,
TJSONNumber
.
Create
(
ApiDB
.
uqMapComplaintsLAT
.
AsFloat
));
item
.
AddPair
(
'Lng'
,
TJSONNumber
.
Create
(
ApiDB
.
uqMapComplaintsLNG
.
AsFloat
));
Inc
(
emitted
);
ApiDB
.
uqMapComplaints
.
Next
;
end
;
finally
ApiDB
.
uqMapComplaints
.
Close
;
end
;
Result
.
AddPair
(
'count'
,
TJSONNumber
.
Create
(
data
.
Count
));
Result
.
AddPair
(
'returned'
,
TJSONNumber
.
Create
(
emitted
));
Result
.
AddPair
(
'data'
,
data
);
Logger
.
Log
(
3
,
'---TApiService.GetComplaintMap End (returned='
+
emitted
.
ToString
+
')'
);
Result
.
AddPair
(
'count'
,
TJSONNumber
.
Create
(
data
.
Count
));
Result
.
AddPair
(
'returned'
,
TJSONNumber
.
Create
(
emitted
));
Logger
.
Log
(
3
,
'---TApiService.GetComplaintMap End (returned='
+
IntToStr
(
emitted
)
+
')'
);
except
on
E
:
EXDataHttpException
do
begin
Logger
.
Log
(
2
,
'---TApiService.GetComplaintMap http error: '
+
E
.
ClassName
+
': '
+
E
.
Message
);
raise
;
end
;
on
E
:
Exception
do
begin
FreeAndNil
(
data
);
Logger
.
Log
(
2
,
'GetComplaintMap error: '
+
E
.
Message
);
raise
EXDataHttpException
.
Create
(
500
,
'Failed to load complaint map'
);
Logger
.
Log
(
2
,
'---TApiService.GetComplaintMap error: '
+
E
.
ClassName
+
': '
+
E
.
Message
);
raise
EXDataHttpException
.
Create
(
500
,
'Failed to load complaint map'
);
end
;
end
;
finally
...
...
@@ -206,17 +231,16 @@ var
begin
Logger
.
Log
(
4
,
'---TApiService.GetUnitMap initiated'
);
// Note: GetUnitMap is AVL-anchored (shows all AVL units).
// Note: DIS_UNITID is null when the unit is not dispatch-active; client should disable/hide Details in that case.
// Note: To restrict map to dispatch-active only, change uqMapUnits join to DIS_UNIT_ACTIVE from LEFT JOIN to INNER JOIN.
Result
:=
TJSONObject
.
Create
;
TXDataOperationContext
.
Current
.
Handler
.
ManagedObjects
.
Add
(
Result
);
data
:=
TJSONArray
.
Create
;
Result
.
AddPair
(
'data'
,
data
);
try
with
ApiDB
.
uqMapUnits
do
begin
Close
;
Open
;
try
First
;
...
...
@@ -225,6 +249,7 @@ begin
if
(
not
ApiDB
.
uqMapUnitsGPS_LATITUDE
.
IsNull
)
and
(
not
ApiDB
.
uqMapUnitsGPS_LONGITUDE
.
IsNull
)
then
begin
item
:=
TJSONObject
.
Create
;
data
.
AddElement
(
item
);
item
.
AddPair
(
'UnitId'
,
ApiDB
.
uqMapUnitsUNITID
.
AsString
);
item
.
AddPair
(
'UnitName'
,
ApiDB
.
uqMapUnitsUNITNAME
.
AsString
);
...
...
@@ -259,7 +284,6 @@ begin
item
.
AddPair
(
'CanShowDetails'
,
TJSONBool
.
Create
(
not
ApiDB
.
uqMapUnitsDIS_UNITID
.
IsNull
));
data
.
AddElement
(
item
);
end
;
Next
;
...
...
@@ -271,13 +295,18 @@ begin
Result
.
AddPair
(
'count'
,
TJSONNumber
.
Create
(
data
.
Count
));
Result
.
AddPair
(
'returned'
,
TJSONNumber
.
Create
(
data
.
Count
));
Result
.
AddPair
(
'data'
,
data
);
except
data
.
Free
;
Logger
.
Log
(
2
,
'---TApiService.GetUnitMap error'
);
raise
EXDataHttpException
.
Create
(
500
,
'Failed to load unit map'
);
on
E
:
EXDataHttpException
do
begin
Logger
.
Log
(
2
,
'---TApiService.GetUnitMap http error: '
+
E
.
ClassName
+
': '
+
E
.
Message
);
raise
;
end
;
on
E
:
Exception
do
begin
Logger
.
Log
(
2
,
'---TApiService.GetUnitMap error: '
+
E
.
ClassName
+
': '
+
E
.
Message
);
raise
EXDataHttpException
.
Create
(
500
,
'Failed to load unit map'
);
end
;
end
;
Logger
.
Log
(
4
,
'---TApiService.GetUnitMap End'
);
end
;
...
...
@@ -668,6 +697,8 @@ begin
TXDataOperationContext
.
Current
.
Handler
.
ManagedObjects
.
Add
(
Result
);
data
:=
TJSONArray
.
Create
;
Result
.
AddPair
(
'data'
,
data
);
try
with
ApiDB
.
uqCFSMemos
do
begin
...
...
@@ -678,6 +709,7 @@ begin
while
not
Eof
do
begin
item
:=
TJSONObject
.
Create
;
data
.
AddElement
(
item
);
item
.
AddPair
(
'MemoId'
,
ApiDB
.
uqCFSMemosMEMO_ID
.
AsString
);
item
.
AddPair
(
'CFSId'
,
ApiDB
.
uqCFSMemosCFSID
.
AsString
);
...
...
@@ -692,7 +724,6 @@ begin
item
.
AddPair
(
'BadgeNumber'
,
ApiDB
.
uqCFSMemosBADGE_NUMBER
.
AsString
);
item
.
AddPair
(
'Remarks'
,
ApiDB
.
uqCFSMemosREMARKS
.
AsString
);
data
.
AddElement
(
item
);
Next
;
end
;
finally
...
...
@@ -702,13 +733,18 @@ begin
Result
.
AddPair
(
'count'
,
TJSONNumber
.
Create
(
data
.
Count
));
Result
.
AddPair
(
'returned'
,
TJSONNumber
.
Create
(
data
.
Count
));
Result
.
AddPair
(
'data'
,
data
);
except
data
.
Free
;
Logger
.
Log
(
3
,
'---TApiService.GetComplaintMemos End (error)'
);
raise
EXDataHttpException
.
Create
(
500
,
'Failed to load complaint memos'
);
on
E
:
EXDataHttpException
do
begin
Logger
.
Log
(
2
,
'---TApiService.GetComplaintMemos http error: '
+
E
.
ClassName
+
': '
+
E
.
Message
);
raise
;
end
;
on
E
:
Exception
do
begin
Logger
.
Log
(
2
,
'---TApiService.GetComplaintMemos error: '
+
E
.
ClassName
+
': '
+
E
.
Message
);
raise
EXDataHttpException
.
Create
(
500
,
'Failed to load complaint memos'
);
end
;
end
;
Logger
.
Log
(
3
,
'---TApiService.GetComplaintMemos End'
);
end
;
...
...
@@ -775,7 +811,7 @@ begin
end
;
on
E
:
Exception
do
begin
Logger
.
Log
(
2
,
'---TApiService.GetComplaintHistory error: '
+
E
.
Message
);
Logger
.
Log
(
2
,
'---TApiService.GetComplaintHistory error: '
+
E
.
ClassName
+
': '
+
E
.
Message
);
raise
EXDataHttpException
.
Create
(
500
,
'Failed to load complaint history'
);
end
;
end
;
...
...
@@ -833,7 +869,7 @@ begin
end
;
on
E
:
Exception
do
begin
Logger
.
Log
(
2
,
'---TApiService.GetComplaintContacts error: '
+
E
.
Message
);
Logger
.
Log
(
2
,
'---TApiService.GetComplaintContacts error: '
+
E
.
ClassName
+
': '
+
E
.
Message
);
raise
EXDataHttpException
.
Create
(
500
,
'Failed to load complaint contacts'
);
end
;
end
;
...
...
@@ -914,7 +950,7 @@ begin
end
;
on
E
:
Exception
do
begin
Logger
.
Log
(
2
,
'---TApiService.GetComplaintWarnings error: '
+
E
.
Message
);
Logger
.
Log
(
2
,
'---TApiService.GetComplaintWarnings error: '
+
E
.
ClassName
+
': '
+
E
.
Message
);
raise
EXDataHttpException
.
Create
(
500
,
'Failed to load complaint warnings'
);
end
;
end
;
...
...
@@ -934,6 +970,8 @@ begin
TXDataOperationContext
.
Current
.
Handler
.
ManagedObjects
.
Add
(
Result
);
dataArr
:=
TJSONArray
.
Create
;
Result
.
AddPair
(
'data'
,
dataArr
);
returnedCount
:=
0
;
try
...
...
@@ -967,7 +1005,6 @@ begin
Result
.
AddPair
(
'count'
,
TJSONNumber
.
Create
(
returnedCount
));
Result
.
AddPair
(
'returned'
,
TJSONNumber
.
Create
(
returnedCount
));
Result
.
AddPair
(
'data'
,
dataArr
);
Logger
.
Log
(
4
,
'---TApiService.GetUnitLogs End (returned='
+
IntToStr
(
returnedCount
)
+
')'
);
except
...
...
@@ -978,7 +1015,7 @@ begin
end
;
on
E
:
Exception
do
begin
Logger
.
Log
(
2
,
'---TApiService.GetUnitLogs error: '
+
E
.
Message
);
Logger
.
Log
(
2
,
'---TApiService.GetUnitLogs error: '
+
E
.
ClassName
+
': '
+
E
.
Message
);
raise
EXDataHttpException
.
Create
(
500
,
'Failed to load unit logs'
);
end
;
end
;
...
...
@@ -1000,6 +1037,7 @@ begin
try
with
ApiDB
.
uqUnitDetails
do
begin
Close
;
ParamByName
(
'UNITID'
).
AsString
:=
UnitId
;
Open
;
try
...
...
@@ -1007,6 +1045,7 @@ begin
raise
EXDataHttpException
.
Create
(
404
,
'Unit not found'
);
obj
:=
TJSONObject
.
Create
;
Result
.
AddPair
(
'data'
,
obj
);
obj
.
AddPair
(
'UnitId'
,
ApiDB
.
uqUnitDetailsUNITID
.
AsString
);
obj
.
AddPair
(
'UnitName'
,
ApiDB
.
uqUnitDetailsUNITNAME
.
AsString
);
...
...
@@ -1032,7 +1071,6 @@ begin
updateTimeText
:=
FormatDateTime
(
'yyyy-mm-dd hh:nn:ss'
,
ApiDB
.
uqUnitDetailsUPDATE_TIME
.
AsDateTime
);
obj
.
AddPair
(
'UpdateTime'
,
updateTimeText
);
Result
.
AddPair
(
'data'
,
obj
);
finally
Close
;
end
;
...
...
@@ -1040,12 +1078,12 @@ begin
except
on
E
:
EXDataHttpException
do
begin
Logger
.
Log
(
2
,
'---TApiService.GetUnitDetails http error: '
+
E
.
Message
);
Logger
.
Log
(
2
,
'---TApiService.GetUnitDetails http error: '
+
E
.
ClassName
+
': '
+
E
.
Message
);
raise
;
end
;
on
E
:
Exception
do
begin
Logger
.
Log
(
2
,
'---TApiService.GetUnitDetails error: '
+
E
.
Message
);
Logger
.
Log
(
2
,
'---TApiService.GetUnitDetails error: '
+
E
.
ClassName
+
': '
+
E
.
Message
);
raise
EXDataHttpException
.
Create
(
500
,
'Failed to load unit details'
);
end
;
end
;
...
...
emiMobileServer/Source/Auth.ServiceImpl.pas
View file @
7d5a024b
...
...
@@ -14,7 +14,6 @@ type
TAuthService
=
class
(
TInterfacedObject
,
IAuthService
)
strict
private
authDB
:
TAuthDatabase
;
function
GetQuery
:
TUniQuery
;
private
userName
:
string
;
userFullName
:
string
;
...
...
@@ -25,7 +24,6 @@ type
procedure
AfterConstruction
;
override
;
procedure
BeforeDestruction
;
override
;
function
VerifyVersion
(
ClientVersion
:
string
):
TJSONObject
;
property
Query
:
TUniQuery
read
GetQuery
;
function
CheckUser
(
const
User
,
Password
,
Agency
:
string
):
Integer
;
function
Decrypt
(
inStr
,
keyStr
:
AnsiString
):
AnsiString
;
public
...
...
@@ -52,17 +50,14 @@ procedure TAuthService.AfterConstruction;
begin
inherited
;
authDB
:=
TAuthDatabase
.
Create
(
nil
);
Logger
.
Log
(
3
,
'AuthDatabase created'
);
end
;
procedure
TAuthService
.
BeforeDestruction
;
begin
authDB
.
Free
;
inherited
;
end
;
function
TAuthService
.
GetQuery
:
TUniQuery
;
begin
Result
:=
authDB
.
uqAuth
;
Logger
.
Log
(
3
,
'AuthDatabase destroyed'
);
end
;
function
TAuthService
.
GetAgenciesList
:
TAgenciesList
;
...
...
@@ -82,6 +77,8 @@ begin
authDB
.
uqAuth
.
Open
;
Result
:=
TAgenciesList
.
Create
;
TXDataOperationContext
.
Current
.
Handler
.
ManagedObjects
.
Add
(
Result
);
Result
.
data
:=
TList
<
TAgencyItem
>.
Create
;
TXDataOperationContext
.
Current
.
Handler
.
ManagedObjects
.
Add
(
Result
.
data
);
...
...
@@ -104,7 +101,7 @@ begin
else
begin
Logger
.
Log
(
2
,
'TAuthService.GetAgenciesList - Error: connecting to auth database!'
);
raise
EXDataHttpException
.
Create
(
'Error connecting to auth database!
'
);
raise
EXDataHttpException
.
Create
(
500
,
'Failed to load agencies
'
);
end
;
end
;
...
...
@@ -126,6 +123,8 @@ begin
authDB
.
uqAuth
.
Open
;
Result
:=
TAgencyConfigList
.
Create
;
TXDataOperationContext
.
Current
.
Handler
.
ManagedObjects
.
Add
(
Result
);
Result
.
data
:=
TList
<
TAgencyConfigItem
>.
Create
;
TXDataOperationContext
.
Current
.
Handler
.
ManagedObjects
.
Add
(
Result
.
data
);
...
...
@@ -197,10 +196,27 @@ begin
Logger
.
Log
(
1
,
Format
(
'AuthService.Login - User: "%s" Agency: "%s"'
,
[
User
,
Agency
]));
userState
:=
CheckUser
(
User
,
Password
,
Agency
);
try
userState
:=
CheckUser
(
User
,
Password
,
Agency
);
except
on
E
:
Exception
do
begin
Logger
.
Log
(
2
,
'AuthService.Login - CheckUser error: '
+
E
.
ClassName
+
': '
+
E
.
Message
);
raise
EXDataHttpException
.
Create
(
500
,
'Login failed'
);
end
;
end
;
if
userState
=
0
then
begin
Logger
.
Log
(
2
,
Format
(
'AuthService.Login - invalid login for User: "%s" Agency: "%s"'
,
[
User
,
Agency
]));
raise
EXDataHttpUnauthorized
.
Create
(
'Invalid user or password'
);
end
;
if
userState
=
1
then
raise
EXDataHttpUnauthorized
.
Create
(
'User not active!'
);
begin
Logger
.
Log
(
2
,
Format
(
'AuthService.Login - inactive user: "%s" Agency: "%s"'
,
[
User
,
Agency
]));
raise
EXDataHttpUnauthorized
.
Create
(
'User not active'
);
end
;
JWT
:=
TJWT
.
Create
;
try
...
...
@@ -222,19 +238,22 @@ end;
function
TAuthService
.
CheckUser
(
const
User
,
Password
,
Agency
:
string
):
Integer
;
var
userStr
:
string
;
sqlStr
:
string
;
decryptedPassword
:
AnsiString
;
passwordKey
:
AnsiString
;
begin
Logger
.
Log
(
3
,
Format
(
'LoginService.CheckUser - User: "%s" Agency: "%s"'
,
[
User
,
Agency
]));
passwordKey
:=
'wx3cFo$kIf2jrk(gOmvi7uvPfk*iorE8@kfm+nvR6jfh=swDqalpokSjf'
;
sqlStr
:=
'select u.* from lems.users u '
;
sqlStr
:=
sqlStr
+
'where upper(user_name) = '
+
QuotedStr
(
UpperCase
(
Trim
(
User
)))
+
' '
;
sqlStr
:=
sqlStr
+
'and u.dept = '
+
QuotedStr
(
UpperCase
(
Trim
(
Agency
)));
authDB
.
uqAuth
.
Close
;
authDB
.
uqAuth
.
SQL
.
Text
:=
sqlStr
;
Logger
.
Log
(
4
,
Format
(
'LoginService.CheckUser - Query: "%s"'
,
[
sqlStr
]));
authDB
.
uqAuth
.
SQL
.
Text
:=
'select u.* from lems.users u '
+
'where upper(user_name) = :USER_NAME '
+
'and u.dept = :AGENCY'
;
authDB
.
uqAuth
.
ParamByName
(
'USER_NAME'
).
AsString
:=
UpperCase
(
Trim
(
User
));
authDB
.
uqAuth
.
ParamByName
(
'AGENCY'
).
AsString
:=
UpperCase
(
Trim
(
Agency
));
Logger
.
Log
(
4
,
'LoginService.CheckUser - opening user lookup query'
);
authDB
.
uqAuth
.
Open
;
try
if
authDB
.
uqAuth
.
IsEmpty
then
...
...
@@ -279,6 +298,12 @@ var
k
,
i
:
integer
;
tempKeyStr
:
AnsiString
;
begin
if
inStr
=
''
then
Exit
(
''
);
if
keyStr
=
''
then
Exit
(
''
);
k
:=
Integer
(
inStr
[
1
]);
tempKeyStr
:=
keyStr
;
while
Length
(
tempKeyStr
)
<
256
do
...
...
emiMobileServer/bin/emiMobileServer.ini
View file @
7d5a024b
[Settings]
LogFileNum
=
72
2
LogFileNum
=
72
3
webClientVersion
=
0.1.0
[Database]
...
...
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