Commit 8ef6fb7a by Mac Stephens

New branch for Wyoming update, initial functionality finished

parent 00229b28
......@@ -225,7 +225,8 @@ begin
item.AddPair('UnitId', ApiDB.uqMapUnitsUNITID.AsString);
item.AddPair('UnitName', ApiDB.uqMapUnitsUNITNAME.AsString);
item.AddPair('District', ApiDB.uqMapUnitsUNIT_DISTRICT.AsString);
item.AddPair('Agency', ApiDB.uqMapUnitsAGENCY.AsString);
item.AddPair('AgencyName', ApiDB.uqMapUnitsAGENCY_NAME.AsString);
item.AddPair('Lat', TJSONNumber.Create(ApiDB.uqMapUnitsGPS_LATITUDE.AsFloat));
item.AddPair('Lng', TJSONNumber.Create(ApiDB.uqMapUnitsGPS_LONGITUDE.AsFloat));
......
......@@ -3,78 +3,35 @@ object AuthDatabase: TAuthDatabase
OnDestroy = DataModuleDestroy
Height = 249
Width = 433
object uq: TUniQuery
SQL.Strings = (
'select * from users')
FetchRows = 100
Left = 162
Top = 45
object uquser_id: TLargeintField
FieldName = 'user_id'
end
object uqusername: TStringField
FieldName = 'username'
Required = True
Size = 64
end
object uqpassword: TMemoField
FieldName = 'password'
Required = True
BlobType = ftMemo
end
object uqdate_created: TStringField
FieldName = 'date_created'
Required = True
Size = 21
end
object uqadmin: TBooleanField
FieldName = 'admin'
end
object uqemail: TMemoField
FieldName = 'email'
BlobType = ftMemo
end
object uqphone_number: TStringField
FieldName = 'phone_number'
Size = 14
end
object uqfull_name: TStringField
FieldName = 'full_name'
Size = 30
end
object uqactive: TBooleanField
FieldName = 'active'
end
end
object uqMisc: TUniQuery
FetchRows = 100
Left = 249
Top = 45
end
object OracleUniProvider1: TOracleUniProvider
Left = 94
Top = 152
end
object ucBooking: TUniConnection
ProviderName = 'Oracle'
Database = 'EMBOOKING'
Username = 'emBooking'
Server = 'EMBOOK-CPS'
Left = 237
Top = 53
end
object ucLemsOCSO: TUniConnection
ProviderName = 'PostgreSQL'
Database = 'lems_ocso'
Username = 'postgres'
Server = '192.168.102.10'
LoginPrompt = False
Left = 339
Top = 75
EncryptedPassword = '9AFF92FF9DFF90FF90FF94FFCFFFCEFF'
Left = 221
Top = 145
EncryptedPassword = '9AFF92FF8CFF86FF8CFFCFFFCEFF'
end
object uqUserPref: TUniQuery
Connection = ucBooking
Connection = ucLemsOCSO
SQL.Strings = (
'SELECT * FROM USER_PREFERENCES')
Left = 204
Top = 114
Left = 160
Top = 52
end
object uqBooking: TUniQuery
Connection = ucBooking
object uqAuth: TUniQuery
Connection = ucLemsOCSO
Left = 88
Top = 48
end
object PostgreSQLUniProvider1: TPostgreSQLUniProvider
Left = 90
Top = 148
end
end
......@@ -3,26 +3,16 @@ unit Auth.Database;
interface
uses
System.SysUtils, System.Classes, IniFiles, Vcl.Forms, MemDS,
Data.DB, DBAccess, Uni, UniProvider, PostgreSQLUniProvider, OracleUniProvider;
System.SysUtils, System.Classes, MemDS,
Data.DB, DBAccess, Uni, UniProvider, PostgreSQLUniProvider;
type
TAuthDatabase = class(TDataModule)
uq: TUniQuery;
uqMisc: TUniQuery;
uquser_id: TLargeintField;
uqusername: TStringField;
uqpassword: TMemoField;
uqdate_created: TStringField;
uqadmin: TBooleanField;
uqemail: TMemoField;
uqphone_number: TStringField;
uqfull_name: TStringField;
uqactive: TBooleanField;
OracleUniProvider1: TOracleUniProvider;
ucBooking: TUniConnection;
ucLemsOCSO: TUniConnection;
uqUserPref: TUniQuery;
uqBooking: TUniQuery;
uqAuth: TUniQuery;
PostgreSQLUniProvider1: TPostgreSQLUniProvider;
procedure DataModuleCreate(Sender: TObject);
procedure DataModuleDestroy(Sender: TObject);
private
......@@ -41,6 +31,7 @@ uses
System.JSON,
Common.Config,
Common.Logging,
Common.Ini,
uLibrary;
{%CLASSGROUP 'Vcl.Controls.TControl'}
......@@ -48,50 +39,45 @@ uses
{$R *.dfm}
procedure TAuthDatabase.DataModuleCreate(Sender: TObject);
var
iniFile: TIniFile;
begin
iniFile := TIniFile.Create(ChangeFileExt(Application.ExeName, '.ini'));
try
ucBooking.Server := IniFile.ReadString('EMB Database', 'Server', 'EMBOOKING');
ucBooking.Username := IniFile.ReadString('EMB Database', 'Username', 'emBooking');
ucBooking.Password := IniFile.ReadString('EMB Database', 'Password', 'embook01');
ucLemsOCSO.ProviderName := 'PostgreSQL';
ucLemsOCSO.Server := IniEntries.DatabaseServer;
ucLemsOCSO.Port := IniEntries.DatabasePort;
ucLemsOCSO.Database := IniEntries.DatabaseName;
ucLemsOCSO.Username := IniEntries.DatabaseUsername;
ucLemsOCSO.Password := IniEntries.DatabasePassword;
ucLemsOCSO.LoginPrompt := False;
try
Logger.Log(2, '');
Logger.Log(2, 'Connecting to emBooking Database...');
if not ucBooking.Connected then
ucBooking.Connect;
Logger.Log(2, 'Connecting to PostgreSQL auth database...');
if not ucLemsOCSO.Connected then
ucLemsOCSO.Connect;
except
on E: Exception do
begin
Logger.Log(2, Format('Failed to connect to database: %s', [E.Message]));
end;
Logger.Log(2, Format('Failed to connect to auth database: %s', [E.Message]));
raise;
end;
finally
iniFile.Free;
end;
end;
procedure TAuthDatabase.DataModuleDestroy(Sender: TObject);
begin
ucBooking.Connected := false;
if ucLemsOCSO.Connected then
ucLemsOCSO.Disconnect;
end;
procedure TAuthDatabase.SetLoginAuditEntry( userStr: string );
var
auditMasterId: string;
userInfo: TStringList;
entry: string;
username: string;
fullname: string;
agency: string;
userid: string;
personnelid: string;
admin: boolean;
i: Integer;
begin
Logger.Log( 3, 'TAuthDatabase.SetLoginAuditEntry - start' );
......@@ -108,8 +94,8 @@ begin
if ServerConfig.auditEnabled then
begin
auditMasterId := GetNextSeqVal( uqMisc, 'SEQ_AUDIT_MASTERID' );
SetMasterAuditEntry( uq, auditMasterId, 'BKG', '', agency, personnelid, fullname, 'Login', '', 'webCharms' );
auditMasterId := GetNextSeqVal(uqMisc, 'SEQ_AUDIT_MASTERID');
SetMasterAuditEntry(uqMisc, auditMasterId, 'AUTH', '', agency, personnelid, fullname, 'Login', '', 'emiMobile');
end
else
begin
......
......@@ -27,7 +27,7 @@ type
TAgencyConfigItem = class
public
id: integer;
id: string;
agency: String;
name: String;
end;
......
......@@ -62,7 +62,7 @@ end;
function TAuthService.GetQuery: TUniQuery;
begin
Result := authDB.uq;
Result := authDB.uqAuth;
end;
function TAuthService.GetAgenciesList: TAgenciesList;
......@@ -71,31 +71,40 @@ var
begin
Logger.Log(2, 'TAuthService.GetAgenciesList - call');
if authDB.ucBooking.Connected then
if authDB.ucLemsOCSO.Connected then
begin
authDB.uqBooking.Close;
authDB.uqBooking.SQL.Text := 'select * from agencies order by agency';
authDB.uqBooking.Open;
authDB.uqAuth.Close;
authDB.uqAuth.SQL.Text :=
'select agencyid as agency ' +
'from lems.agency ' +
'where agencytype = ''POL'' ' +
'order by agencyid';
authDB.uqAuth.Open;
Result := TAgenciesList.Create;
Result.data := TList<TAgencyItem>.Create;
TXDataOperationContext.Current.Handler.ManagedObjects.Add(Result.data);
while not authDB.uqBooking.Eof do
try
while not authDB.uqAuth.Eof do
begin
agency := TAgencyItem.Create(authDB.uqBooking.FieldByName('agency').AsString);
agency := TAgencyItem.Create(authDB.uqAuth.FieldByName('agency').AsString);
TXDataOperationContext.Current.Handler.ManagedObjects.Add(agency);
Result.Data.Add(agency);
authDB.uqBooking.Next;
authDB.uqAuth.Next;
end;
authDB.uqBooking.Close;
finally
authDB.uqAuth.Close;
end;
Result.count := Result.data.count;
Result.returned := Result.data.count;
Logger.Log( 2, 'GetAgenciesList - Count: ' + IntToStr(Result.Count) + ' Returned: ' + IntToStr(Result.Returned) );
Logger.Log(2, 'GetAgenciesList - Count: ' + IntToStr(Result.Count) + ' Returned: ' + IntToStr(Result.Returned));
end
else
begin
Logger.Log( 2, 'TAuthService.GetAgenciesList - Error: connecting to CPS database!' );
raise EXDataHttpException.Create('Error connecting to CPS database!');
Logger.Log(2, 'TAuthService.GetAgenciesList - Error: connecting to auth database!');
raise EXDataHttpException.Create('Error connecting to auth database!');
end;
end;
......@@ -106,26 +115,36 @@ var
begin
Logger.Log(2, 'AuthService.GetAgencyConfigList - call');
authDB.uqBooking.Close;
sql := 'select agency_id, agency, agency_name from agencyconfig ' +
'where active = ''Y'' order by agency';
authDB.uqBooking.SQL.Text := sql;
authDB.uqBooking.Open;
authDB.uqAuth.Close;
sql := 'select agencyid, agencyname ' +
'from lems.agency ' +
'where agencytype = ''POL'' ' +
'order by agencyname';
authDB.uqAuth.SQL.Text := sql;
authDB.uqAuth.Open;
Result := TAgencyConfigList.Create;
Result.data := TList<TAgencyConfigItem>.Create;
TXDataOperationContext.Current.Handler.ManagedObjects.Add(Result.data);
while not authDB.uqBooking.Eof do
try
while not authDB.uqAuth.Eof do
begin
agencyConfig := TAgencyConfigItem.Create;
TXDataOperationContext.Current.Handler.ManagedObjects.Add(agencyConfig);
Result.data.Add(agencyConfig);
agencyConfig.id := authDB.uqBooking.FieldByName('agency_id').AsInteger;
agencyConfig.agency := authDB.uqBooking.FieldByName('agency').AsString;
agencyConfig.name := authDB.uqBooking.FieldByName('agency_name').AsString;
authDB.uqBooking.Next;
agencyConfig.id := authDB.uqAuth.FieldByName('agencyid').AsString;
agencyConfig.agency := authDB.uqAuth.FieldByName('agencyid').AsString;
agencyConfig.name := authDB.uqAuth.FieldByName('agencyname').AsString;
authDB.uqAuth.Next;
end;
finally
authDB.uqAuth.Close;
end;
authDB.uqBooking.Close;
Result.count := Result.data.Count;
Result.returned := Result.data.Count;
......@@ -210,30 +229,31 @@ 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 users@cps_link u ';
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.uqBooking.SQL.Text := sqlStr;
authDB.uqAuth.Close;
authDB.uqAuth.SQL.Text := sqlStr;
Logger.Log(4, Format('LoginService.CheckUser - Query: "%s"', [sqlStr]));
authDB.uqBooking.Open;
if authDB.uqBooking.IsEmpty then
authDB.uqAuth.Open;
try
if authDB.uqAuth.IsEmpty then
Result := 0
else
begin
if authDB.uqBooking.FieldByName('active').AsString = 'F' then
if authDB.uqAuth.FieldByName('active').AsString = 'F' then
Result := 1
else
begin
decryptedPassword := Uppercase(Trim(Decrypt(authDB.uqBooking.FieldByName('password').AsString, passwordKey)));
decryptedPassword := Uppercase(Trim(Decrypt(authDB.uqAuth.FieldByName('password').AsString, passwordKey)));
if decryptedPassword = Uppercase(Trim(Password)) then
begin
userName := authDB.uqBooking.FieldByName('user_name').AsString;
userFullName := authDB.uqBooking.FieldByName('firstname').AsString + ' ' + authDB.uqBooking.FieldByName('lastname').AsString;
userAgency := authDB.uqBooking.FieldByName('dept').AsString;
userBadge := authDB.uqBooking.FieldByName('badgenum').AsString;
userId := authDB.uqBooking.FieldByName('userid').AsString;
userPersonnelId := authDB.uqBooking.FieldByName('personnelid').AsString;
userName := authDB.uqAuth.FieldByName('user_name').AsString;
userFullName := authDB.uqAuth.FieldByName('firstname').AsString + ' ' + authDB.uqAuth.FieldByName('lastname').AsString;
userAgency := authDB.uqAuth.FieldByName('dept').AsString;
userBadge := authDB.uqAuth.FieldByName('badgenum').AsString;
userId := authDB.uqAuth.FieldByName('userid').AsString;
userPersonnelId := authDB.uqAuth.FieldByName('personnelid').AsString;
userStr := '?username=' + userName;
userStr := userStr + '&fullname=' + userFullName;
......@@ -248,6 +268,9 @@ begin
Result := 0;
end;
end;
finally
authDB.uqAuth.Close;
end;
end;
function TAuthService.Decrypt(inStr, keyStr: AnsiString): AnsiString;
......
......@@ -19,6 +19,16 @@ type
FWebClientVersionFromIni: Boolean;
// [Database]
FDatabaseServer: string;
FDatabaseServerFromIni: Boolean;
FDatabasePort: Integer;
FDatabasePortFromIni: Boolean;
FDatabaseName: string;
FDatabaseNameFromIni: Boolean;
FDatabaseUsername: string;
FDatabaseUsernameFromIni: Boolean;
FDatabasePassword: string;
FDatabasePasswordFromIni: Boolean;
public
constructor Create;
......@@ -35,6 +45,16 @@ type
property WebClientVersionFromIni: Boolean read FWebClientVersionFromIni;
// [Database]
property DatabaseServer: string read FDatabaseServer;
property DatabaseServerFromIni: Boolean read FDatabaseServerFromIni;
property DatabasePort: Integer read FDatabasePort;
property DatabasePortFromIni: Boolean read FDatabasePortFromIni;
property DatabaseName: string read FDatabaseName;
property DatabaseNameFromIni: Boolean read FDatabaseNameFromIni;
property DatabaseUsername: string read FDatabaseUsername;
property DatabaseUsernameFromIni: Boolean read FDatabaseUsernameFromIni;
property DatabasePassword: string read FDatabasePassword;
property DatabasePasswordFromIni: Boolean read FDatabasePasswordFromIni;
end;
......@@ -74,6 +94,20 @@ begin
FWebClientVersionFromIni := iniFile.ValueExists('Settings', 'webClientVersion');
// [Database]
FDatabaseServer := iniFile.ReadString('Database', 'Server', '192.168.102.10');
FDatabaseServerFromIni := iniFile.ValueExists('Database', 'Server');
FDatabasePort := iniFile.ReadInteger('Database', 'Port', 5432);
FDatabasePortFromIni := iniFile.ValueExists('Database', 'Port');
FDatabaseName := iniFile.ReadString('Database', 'Database', 'lems_wcso');
FDatabaseNameFromIni := iniFile.ValueExists('Database', 'Database');
FDatabaseUsername := iniFile.ReadString('Database', 'Username', 'postgres');
FDatabaseUsernameFromIni := iniFile.ValueExists('Database', 'Username');
FDatabasePassword := iniFile.ReadString('Database', 'Password', '');
FDatabasePasswordFromIni := iniFile.ValueExists('Database', 'Password');
finally
iniFile.Free;
......@@ -81,4 +115,3 @@ begin
end;
end.
......@@ -23,8 +23,6 @@ object FMain: TFMain
Anchors = [akLeft, akTop, akRight, akBottom]
ReadOnly = True
TabOrder = 0
ExplicitWidth = 744
ExplicitHeight = 549
end
object btnApiSwaggerUI: TButton
Left = 141
......
......@@ -26,6 +26,8 @@ type
strict private
procedure StartServers;
function LogValue(const LabelName: string; const Value: string; FromIni: Boolean): string;
private
function LocalBrowserUrl(const Url: string): string;
end;
var
......@@ -50,14 +52,25 @@ begin
Close;
end;
function TFMain.LocalBrowserUrl(const Url: string): string;
begin
Result := StringReplace(Url, '://0.0.0.0:', '://localhost:', [rfIgnoreCase]);
end;
procedure TFMain.btnApiSwaggerUIClick(Sender: TObject);
var
url: string;
begin
ShellExecute(Handle, 'open', PChar(TSparkleUtils.CombineUrlFast(ApiServerModule.XDataServer1.BaseUrl, 'swaggerui')), nil, nil, SW_SHOWNORMAL);
url := TSparkleUtils.CombineUrlFast(ApiServerModule.XDataServer1.BaseUrl, 'swaggerui');
ShellExecute(Handle, 'open', PChar(LocalBrowserUrl(url)), nil, nil, SW_SHOWNORMAL);
end;
procedure TFMain.btnAuthSwaggerUIClick(Sender: TObject);
var
url: string;
begin
ShellExecute(Handle, 'open', PChar(TSparkleUtils.CombineUrlFast(AuthServerModule.XDataServer.BaseUrl, 'swaggerui')), nil, nil, SW_SHOWNORMAL);
url := TSparkleUtils.CombineUrlFast(AuthServerModule.XDataServer.BaseUrl, 'swaggerui');
ShellExecute(Handle, 'open', PChar(LocalBrowserUrl(url)), nil, nil, SW_SHOWNORMAL);
end;
procedure TFMain.ContactFormData(AText: String);
......
......@@ -39,7 +39,7 @@ var
sql: string;
serverDateTime: TDateTime;
begin
sql := 'select sysdate as currentdatetime from dual';
sql := 'select current_timestamp as currentdatetime';
DoQuery( uq, sql );
serverDateTime := uq.FieldByName('CURRENTDATETIME').AsDateTime;
......@@ -86,7 +86,7 @@ function GetNextSeqVal(uq: TUniQuery; sequence: string ): string;
var
sql: string;
begin
sql := 'select ' + sequence + '.NEXTVAL as nextseqval from dual';
sql := 'select nextval(' + QuotedStr(sequence) + ') as nextseqval';
uq.Close;
uq.SQL.Text := sql;
uq.Open;
......
[Settings]
LogFileNum=666
LogFileNum=695
webClientVersion=0.1.0
[Database]
Server=192.168.102.10
Port=5432
Database=lems_wcso
Username=postgres
--Password=postgreSQL
Password=emsys01
--------------------------------2026/6/3 9:19:39--------------------------------
FastMM has detected an attempt to call a virtual method on a freed object. An access violation will now be raised in order to abort the current operation.
Freed object class: System.JSON.TJSONObject
Virtual method: Destroy
Virtual method address: D2DB7C
The allocation number was: 154914
The object was allocated by thread 0x3A78, and the stack trace (return addresses) at the time was:
A3722E [System.pas][System][@GetMem$qqri][5057]
A392D7 [System.pas][System][TObject.NewInstance][18511]
A399DA [System.pas][System][@ClassCreate$qqrpvzc][19841]
D2D9CE [System.JSON.pas][System.JSON][Json.TJSONObject.Create][3021]
10FB558 [MemDS][TMemDataSet.Locate]
13D251F [Api.ServiceImpl.pas][Api.ServiceImpl][Serviceimpl.TApiService.GetComplaintArchiveDetails][546]
AB2D74 [System.Rtti.pas][System.Rtti][Rtti.RawInvoke$qqrpvp23System.Rtti.TParamBlock][8868]
AB3159 [System.Rtti.pas][System.Rtti][Rtti.Invoke$qqrpvx42System.%DynamicArray$18System.Rtti.TValue%24System.Typinfo.TCallConvp24System.Typinfo.TTypeInfooo][9113]
A3D079 [System.pas][System][@FinalizeRecord$qqrpvt1][33521]
A4074B [System.pas][System][@IntfClear$qqrr44System.%DelphiInterface$17System.IInterface%][39340]
F52CDD [XData.Aurelius.Model.pas][XData.Aurelius.Model][Aurelius.Model.TXDataAureliusModel.GetActionInfo][490]
The object was subsequently freed by thread 0x3A78, and the stack trace (return addresses) at the time was:
A392F5 [System.pas][System][TObject.FreeInstance][18520]
A39A25 [System.pas][System][@ClassDestroy$qqrxp14System.TObject][19884]
D2DBE1 [System.JSON.pas][System.JSON][Json.TJSONObject.Destroy][3113]
A393EB [System.pas][System][TObject.Free][18583]
FFD403 [XData.Server.Module.pas][XData.Server.Module][Server.Module.TXDataRequestHandler.DestroyIfNotInManagers][1679]
FFB45B [XData.Server.Module.pas][XData.Server.Module][Server.Module.TXDataRequestHandler.CleanUp][1267]
F9C49C [XData.Module.Base.pas][XData.Module.Base][Module.Base.TXDataBaseRequestHandler.InnerProcessRequest][869]
F9CA62 [XData.Module.Base.pas][XData.Module.Base][Module.Base.TXDataBaseRequestHandler.ProcessRequest][907]
F9AAB0 [XData.Module.Base.pas][XData.Module.Base][Module.Base.TXDataBaseModule.ProcessRequest][330]
F903EE [Sparkle.HttpServer.Module.pas][Sparkle.HttpServer.Module][261]
10AA727 [Sparkle.Middleware.Jwt.pas][Sparkle.Middleware.Jwt][Middleware.Jwt.TJwtMiddleware.ProcessRequest][273]
The current thread ID is 0x3A78, and the stack trace (return addresses) leading to this error is:
D2D859 [System.JSON.pas][System.JSON][Json.TJSONPair.Destroy][2952]
A393EB [System.pas][System][TObject.Free][18583]
D2DBB0 [System.JSON.pas][System.JSON][Json.TJSONObject.Destroy][3108]
A393EB [System.pas][System][TObject.Free][18583]
FFD403 [XData.Server.Module.pas][XData.Server.Module][Server.Module.TXDataRequestHandler.DestroyIfNotInManagers][1679]
FFB45B [XData.Server.Module.pas][XData.Server.Module][Server.Module.TXDataRequestHandler.CleanUp][1267]
F9C49C [XData.Module.Base.pas][XData.Module.Base][Module.Base.TXDataBaseRequestHandler.InnerProcessRequest][869]
F9CA62 [XData.Module.Base.pas][XData.Module.Base][Module.Base.TXDataBaseRequestHandler.ProcessRequest][907]
F9AAB0 [XData.Module.Base.pas][XData.Module.Base][Module.Base.TXDataBaseModule.ProcessRequest][330]
F903EE [Sparkle.HttpServer.Module.pas][Sparkle.HttpServer.Module][261]
10AA727 [Sparkle.Middleware.Jwt.pas][Sparkle.Middleware.Jwt][Middleware.Jwt.TJwtMiddleware.ProcessRequest][273]
Current memory dump of 256 bytes starting at pointer address 7E27B800:
8C CC 53 01 80 80 80 80 80 80 80 80 80 80 80 80 CC 7E B7 6E 80 80 80 80 00 00 00 00 20 7F 27 7E
00 00 00 00 00 00 00 00 78 AD A4 00 00 00 00 00 88 5E 02 00 A6 B1 A4 00 FA 71 A3 00 02 AC AB 00
1B CA A9 00 0A 88 D3 00 AF 7D D3 00 CD 3A EA 00 4E A2 0A 01 2A A8 0A 01 8B A0 0A 01 24 A6 0A 01
DC 3E 00 00 68 21 00 00 4A 72 A3 00 81 B3 A3 00 6E CB 1E 01 22 00 40 01 99 CC 1E 01 76 D1 1C 01
93 D0 1C 01 8C 71 AF 00 F1 7B AF 00 58 55 AF 00 D2 64 AF 00 10 00 00 00 B0 04 02 00 32 9C E6 91
80 D1 40 01 01 00 00 00 CC B0 2D 7E 00 00 00 00 CD 63 19 6E 80 80 80 80 00 00 00 00 20 7F 27 7E
00 00 00 00 00 00 00 00 78 AD A4 00 00 00 00 00 4D 5B 02 00 2E 72 A3 00 5B B2 A3 00 C0 C3 A3 00
67 EC A6 00 64 EB A6 00 12 C9 C8 00 27 9A EA 00 8C B7 EA 00 20 AD EA 00 24 C8 EA 00 F0 9E 00 01
S . ~ n . . . .  ' ~
. . . . . . . . x . . . . . ^ . . . q . . .
. . . . } . : . N . . * . . . . $ . .
> . . h ! . . J r . . n . . " . @ . . . v . .
. . q . { . X U . d . . . . . . . . 2
@ . . . . . - ~ . . . . c . n . . . .  ' ~
. . . . . . . . x . . . . . M [ . . . r . [ . .
g . d . . . ' . . . $ . . .
......@@ -62,10 +62,10 @@ object FViewMap: TFViewMap
end
object httpReqGeoJson: TWebHttpRequest
ResponseType = rtText
URL = 'assets/bpddistricts-updated.geojson'
URL = 'assets/orleanscounty.geojson'
OnResponse = httpReqGeoJsonResponse
Left = 114
Top = 696
Left = 116
Top = 698
end
object xdwcMap: TXDataWebClient
Connection = DMConnection.ApiConnection
......
......@@ -38,13 +38,16 @@ type
FPendingFocusCoord: TTMSFNCMapsCoordinateRec;
FPendingFocusZoom: Integer;
FDoFocusZoom: Boolean;
FGeoJsonLoadStep: Integer;
[async] procedure LoadPointsAsync(showBusy: Boolean);
function CarIconForDistrict(const DistrictCode: string): string;
function CarIconForAgency(const AgencyId: string): string;
procedure UpdateDeviceLocation(lat, lng: Double);
procedure StartDeviceLocation;
procedure ApplyPendingUnitFocus;
procedure ApplyPendingComplaintFocus;
procedure StartGeoJsonLoad;
procedure LoadGeoJsonLayer(const AResponse, ALayerName: string; FitLayer: Boolean);
public
procedure FocusUnit(const unitId: string);
procedure FocusComplaint(const complaintId: string);
......@@ -66,7 +69,7 @@ begin
ShowSpinner('spinner');
FUnitsLoaded := False;
FComplaintsLoaded := False;
httpReqGeoJson.Execute;
StartGeoJsonLoad;
asm
window.showComplaintDetails = function (id) {
try {
......@@ -140,58 +143,85 @@ begin
end;
end;
procedure TFViewMap.StartGeoJsonLoad;
begin
lfMap.BeginUpdate;
try
lfMap.Polygons.Clear;
finally
lfMap.EndUpdate;
end;
[async] procedure TFViewMap.httpReqGeoJsonResponse(Sender: TObject; AResponse: string);
FGeoJsonLoadStep := 1;
httpReqGeoJson.URL := 'assets/wyomingtowns.geojson';
httpReqGeoJson.Execute;
end;
procedure TFViewMap.LoadGeoJsonLayer(const AResponse, ALayerName: string; FitLayer: Boolean);
var
startIndex: Integer;
i: Integer;
P: TTMSFNCMapsPolygon;
begin
startIndex := lfMap.Polygons.Count;
lfMap.BeginUpdate;
try
lfMap.Polygons.Clear;
lfMap.LoadGeoJSONFromText(AResponse, True, Trim(FPendingUnitId) = '');
lfMap.LoadGeoJSONFromText(AResponse, True, FitLayer);
for i := 0 to lfMap.Polygons.Count - 1 do
for i := startIndex to lfMap.Polygons.Count - 1 do
begin
P := lfMap.Polygons[i];
case i of
0: begin
P.DisplayName := 'District A';
P.FillColor := HTMLToColor('#d3ffbe'); // light green
P.StrokeColor := HTMLToColor('#6ea85c'); // darker green
end;
1: begin
P.DisplayName := 'District B';
P.FillColor := HTMLToColor('#ffbebe'); // light red
P.StrokeColor := HTMLToColor('#b34a4a'); // darker red
end;
2: begin
P.DisplayName := 'District C';
P.FillColor := HTMLToColor('#ffd37f'); // light orange
P.StrokeColor := HTMLToColor('#b36e00'); // darker orange
end;
3: begin
P.DisplayName := 'District D';
P.FillColor := HTMLToColor('#bed2ff'); // light blue
P.StrokeColor := HTMLToColor('#3c5ca8'); // darker blue
end;
4: begin
P.DisplayName := 'District E';
P.FillColor := HTMLToColor('#ffffbe'); // light yellow
P.StrokeColor := HTMLToColor('#a8a85c'); // darker yellow/olive
end;
end;
P.FillOpacity := 0.60;
if SameText(ALayerName, 'Towns') then
begin
P.FillColor := HTMLToColor('#ffffff');
P.FillOpacity := 0.05;
P.StrokeColor := HTMLToColor('#000000');
P.StrokeOpacity := 1.0;
P.StrokeWidth := 2;
end
else if SameText(ALayerName, 'Villages') then
begin
P.FillColor := HTMLToColor('#0d6efd');
P.FillOpacity := 0.20;
P.StrokeColor := HTMLToColor('#0d6efd');
P.StrokeOpacity := 1.0;
P.StrokeWidth := 2;
end;
end;
finally
lfMap.EndUpdate;
end;
end;
[async] procedure TFViewMap.httpReqGeoJsonResponse(Sender: TObject; AResponse: string);
var
layerName: string;
fitLayer: Boolean;
begin
if FGeoJsonLoadStep = 1 then
layerName := 'Towns'
else
layerName := 'Villages';
fitLayer :=
(FGeoJsonLoadStep = 1) and
(Trim(FPendingUnitId) = '') and
(Trim(FPendingComplaintId) = '');
LoadGeoJsonLayer(AResponse, layerName, fitLayer);
if FGeoJsonLoadStep = 1 then
begin
FGeoJsonLoadStep := 2;
httpReqGeoJson.URL := 'assets/wyomingvillages.geojson';
httpReqGeoJson.Execute;
Exit;
end;
FGeoJsonLoadStep := 0;
await(LoadPointsAsync(True));
......@@ -202,23 +232,9 @@ begin
end;
end;
function TFViewMap.CarIconForDistrict(const DistrictCode: string): string;
var
U: string;
L: Char;
function TFViewMap.CarIconForAgency(const AgencyId: string): string;
begin
U := UpperCase(Trim(DistrictCode));
if U = '' then
Exit('assets/markers/car_default.png');
L := U[1];
case L of
'A','B','C','D','E','X':
Result := 'assets/markers/car_' + L + '.png';
else
Result := 'assets/markers/car_default.png';
end;
end;
......@@ -230,9 +246,9 @@ var
i, ui: Integer;
m: TTMSFNCMapsMarker;
lat, lng: Double;
uName, dist: string;
uName, agency: string;
unitId, callType, priorityText, statusText: string;
complaintId, codeDesc, dispatchDist, priority, business: string;
complaintId, codeDesc, priority, business: string;
pngName, iconUrl, rowsHtml: string;
officer1Lname, officer1Fname, officer1Empnum: string;
officer2Lname, officer2Fname, officer2Empnum: string;
......@@ -301,7 +317,10 @@ begin
lat := Double(item['Lat']);
lng := Double(item['Lng']);
uName := string(item['UnitName']);
dist := string(item['District']);
agency := string(item['AgencyName']);
if Trim(agency) = '' then
agency := string(item['Agency']);
unitId := string(item['UnitId']);
callType := string(item['CallType']);
priorityText := string(item['Priority']);
......@@ -361,8 +380,8 @@ begin
'<div class="fw-semibold small">' +
'<span class="fw-bold">Unit:</span> ' + uName +
'</div>' +
IfThen(dist <> '',
'<div class="small"><span class="fw-bold">District:</span> ' + dist + '</div>',
IfThen(agency <> '',
'<div class="small"><span class="fw-bold">Agency:</span> ' + agency + '</div>',
''
) +
IfThen(Trim(callType) <> '',
......@@ -396,7 +415,7 @@ begin
'</div>';
m.DataString := 'unit|' + unitId;
m.IconURL := CarIconForDistrict(dist);
m.IconURL := CarIconForAgency(agency);
end;
end;
......@@ -409,7 +428,9 @@ begin
complaintId := string(item['ComplaintId']);
codeDesc := string(item['DispatchCodeDesc']);
dispatchDist := string(item['DispatchDistrict']);
agency := string(item['AgencyName']);
if Trim(agency) = '' then
agency := string(item['Agency']);
priority := string(item['Priority']);
business := string(item['Business']);
......@@ -464,7 +485,7 @@ begin
'<span class="fw-bold">Dispatch Code:</span> ' + codeDesc +
'</div>' +
'<div class="small">' +
'<span class="fw-bold">Dispatch District:</span> ' + dispatchDist +
'<span class="fw-bold">Agency:</span> ' + agency +
'</div>' +
IfThen(Trim(business) <> '',
'<div class="small">' +
......
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