Commit 8ef6fb7a by Mac Stephens

New branch for Wyoming update, initial functionality finished

parent 00229b28
...@@ -225,7 +225,8 @@ begin ...@@ -225,7 +225,8 @@ begin
item.AddPair('UnitId', ApiDB.uqMapUnitsUNITID.AsString); item.AddPair('UnitId', ApiDB.uqMapUnitsUNITID.AsString);
item.AddPair('UnitName', ApiDB.uqMapUnitsUNITNAME.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('Lat', TJSONNumber.Create(ApiDB.uqMapUnitsGPS_LATITUDE.AsFloat));
item.AddPair('Lng', TJSONNumber.Create(ApiDB.uqMapUnitsGPS_LONGITUDE.AsFloat)); item.AddPair('Lng', TJSONNumber.Create(ApiDB.uqMapUnitsGPS_LONGITUDE.AsFloat));
......
...@@ -3,78 +3,35 @@ object AuthDatabase: TAuthDatabase ...@@ -3,78 +3,35 @@ object AuthDatabase: TAuthDatabase
OnDestroy = DataModuleDestroy OnDestroy = DataModuleDestroy
Height = 249 Height = 249
Width = 433 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 object uqMisc: TUniQuery
FetchRows = 100 FetchRows = 100
Left = 249 Left = 237
Top = 45 Top = 53
end end
object OracleUniProvider1: TOracleUniProvider object ucLemsOCSO: TUniConnection
Left = 94 ProviderName = 'PostgreSQL'
Top = 152 Database = 'lems_ocso'
end Username = 'postgres'
object ucBooking: TUniConnection Server = '192.168.102.10'
ProviderName = 'Oracle'
Database = 'EMBOOKING'
Username = 'emBooking'
Server = 'EMBOOK-CPS'
LoginPrompt = False LoginPrompt = False
Left = 339 Left = 221
Top = 75 Top = 145
EncryptedPassword = '9AFF92FF9DFF90FF90FF94FFCFFFCEFF' EncryptedPassword = '9AFF92FF8CFF86FF8CFFCFFFCEFF'
end end
object uqUserPref: TUniQuery object uqUserPref: TUniQuery
Connection = ucBooking Connection = ucLemsOCSO
SQL.Strings = ( SQL.Strings = (
'SELECT * FROM USER_PREFERENCES') 'SELECT * FROM USER_PREFERENCES')
Left = 204 Left = 160
Top = 114 Top = 52
end end
object uqBooking: TUniQuery object uqAuth: TUniQuery
Connection = ucBooking Connection = ucLemsOCSO
Left = 88 Left = 88
Top = 48 Top = 48
end end
object PostgreSQLUniProvider1: TPostgreSQLUniProvider
Left = 90
Top = 148
end
end end
...@@ -3,26 +3,16 @@ unit Auth.Database; ...@@ -3,26 +3,16 @@ unit Auth.Database;
interface interface
uses uses
System.SysUtils, System.Classes, IniFiles, Vcl.Forms, MemDS, System.SysUtils, System.Classes, MemDS,
Data.DB, DBAccess, Uni, UniProvider, PostgreSQLUniProvider, OracleUniProvider; Data.DB, DBAccess, Uni, UniProvider, PostgreSQLUniProvider;
type type
TAuthDatabase = class(TDataModule) TAuthDatabase = class(TDataModule)
uq: TUniQuery;
uqMisc: TUniQuery; uqMisc: TUniQuery;
uquser_id: TLargeintField; ucLemsOCSO: TUniConnection;
uqusername: TStringField;
uqpassword: TMemoField;
uqdate_created: TStringField;
uqadmin: TBooleanField;
uqemail: TMemoField;
uqphone_number: TStringField;
uqfull_name: TStringField;
uqactive: TBooleanField;
OracleUniProvider1: TOracleUniProvider;
ucBooking: TUniConnection;
uqUserPref: TUniQuery; uqUserPref: TUniQuery;
uqBooking: TUniQuery; uqAuth: TUniQuery;
PostgreSQLUniProvider1: TPostgreSQLUniProvider;
procedure DataModuleCreate(Sender: TObject); procedure DataModuleCreate(Sender: TObject);
procedure DataModuleDestroy(Sender: TObject); procedure DataModuleDestroy(Sender: TObject);
private private
...@@ -41,6 +31,7 @@ uses ...@@ -41,6 +31,7 @@ uses
System.JSON, System.JSON,
Common.Config, Common.Config,
Common.Logging, Common.Logging,
Common.Ini,
uLibrary; uLibrary;
{%CLASSGROUP 'Vcl.Controls.TControl'} {%CLASSGROUP 'Vcl.Controls.TControl'}
...@@ -48,50 +39,45 @@ uses ...@@ -48,50 +39,45 @@ uses
{$R *.dfm} {$R *.dfm}
procedure TAuthDatabase.DataModuleCreate(Sender: TObject); procedure TAuthDatabase.DataModuleCreate(Sender: TObject);
var
iniFile: TIniFile;
begin begin
iniFile := TIniFile.Create(ChangeFileExt(Application.ExeName, '.ini')); 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 try
ucBooking.Server := IniFile.ReadString('EMB Database', 'Server', 'EMBOOKING'); Logger.Log(2, '');
ucBooking.Username := IniFile.ReadString('EMB Database', 'Username', 'emBooking'); Logger.Log(2, 'Connecting to PostgreSQL auth database...');
ucBooking.Password := IniFile.ReadString('EMB Database', 'Password', 'embook01'); if not ucLemsOCSO.Connected then
ucLemsOCSO.Connect;
try except
Logger.Log(2, ''); on E: Exception do
Logger.Log(2, 'Connecting to emBooking Database...'); begin
if not ucBooking.Connected then Logger.Log(2, Format('Failed to connect to auth database: %s', [E.Message]));
ucBooking.Connect; raise;
except
on E: Exception do
begin
Logger.Log(2, Format('Failed to connect to database: %s', [E.Message]));
end;
end; end;
finally
iniFile.Free;
end; end;
end; end;
procedure TAuthDatabase.DataModuleDestroy(Sender: TObject); procedure TAuthDatabase.DataModuleDestroy(Sender: TObject);
begin begin
ucBooking.Connected := false; if ucLemsOCSO.Connected then
ucLemsOCSO.Disconnect;
end; end;
procedure TAuthDatabase.SetLoginAuditEntry( userStr: string ); procedure TAuthDatabase.SetLoginAuditEntry( userStr: string );
var var
auditMasterId: string; auditMasterId: string;
userInfo: TStringList; userInfo: TStringList;
entry: string;
username: string; username: string;
fullname: string; fullname: string;
agency: string; agency: string;
userid: string; userid: string;
personnelid: string; personnelid: string;
admin: boolean;
i: Integer;
begin begin
Logger.Log( 3, 'TAuthDatabase.SetLoginAuditEntry - start' ); Logger.Log( 3, 'TAuthDatabase.SetLoginAuditEntry - start' );
...@@ -108,8 +94,8 @@ begin ...@@ -108,8 +94,8 @@ begin
if ServerConfig.auditEnabled then if ServerConfig.auditEnabled then
begin begin
auditMasterId := GetNextSeqVal( uqMisc, 'SEQ_AUDIT_MASTERID' ); auditMasterId := GetNextSeqVal(uqMisc, 'SEQ_AUDIT_MASTERID');
SetMasterAuditEntry( uq, auditMasterId, 'BKG', '', agency, personnelid, fullname, 'Login', '', 'webCharms' ); SetMasterAuditEntry(uqMisc, auditMasterId, 'AUTH', '', agency, personnelid, fullname, 'Login', '', 'emiMobile');
end end
else else
begin begin
......
...@@ -27,7 +27,7 @@ type ...@@ -27,7 +27,7 @@ type
TAgencyConfigItem = class TAgencyConfigItem = class
public public
id: integer; id: string;
agency: String; agency: String;
name: String; name: String;
end; end;
......
...@@ -62,7 +62,7 @@ end; ...@@ -62,7 +62,7 @@ end;
function TAuthService.GetQuery: TUniQuery; function TAuthService.GetQuery: TUniQuery;
begin begin
Result := authDB.uq; Result := authDB.uqAuth;
end; end;
function TAuthService.GetAgenciesList: TAgenciesList; function TAuthService.GetAgenciesList: TAgenciesList;
...@@ -71,31 +71,40 @@ var ...@@ -71,31 +71,40 @@ var
begin begin
Logger.Log(2, 'TAuthService.GetAgenciesList - call'); Logger.Log(2, 'TAuthService.GetAgenciesList - call');
if authDB.ucBooking.Connected then if authDB.ucLemsOCSO.Connected then
begin begin
authDB.uqBooking.Close; authDB.uqAuth.Close;
authDB.uqBooking.SQL.Text := 'select * from agencies order by agency'; authDB.uqAuth.SQL.Text :=
authDB.uqBooking.Open; 'select agencyid as agency ' +
'from lems.agency ' +
'where agencytype = ''POL'' ' +
'order by agencyid';
authDB.uqAuth.Open;
Result := TAgenciesList.Create; Result := TAgenciesList.Create;
Result.data := TList<TAgencyItem>.Create; Result.data := TList<TAgencyItem>.Create;
TXDataOperationContext.Current.Handler.ManagedObjects.Add(Result.data); TXDataOperationContext.Current.Handler.ManagedObjects.Add(Result.data);
while not authDB.uqBooking.Eof do
begin try
agency := TAgencyItem.Create(authDB.uqBooking.FieldByName('agency').AsString); while not authDB.uqAuth.Eof do
TXDataOperationContext.Current.Handler.ManagedObjects.Add(agency); begin
Result.Data.Add(agency); agency := TAgencyItem.Create(authDB.uqAuth.FieldByName('agency').AsString);
authDB.uqBooking.Next; TXDataOperationContext.Current.Handler.ManagedObjects.Add(agency);
Result.Data.Add(agency);
authDB.uqAuth.Next;
end;
finally
authDB.uqAuth.Close;
end; end;
authDB.uqBooking.Close;
Result.count := Result.data.count; Result.count := Result.data.count;
Result.returned := 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 end
else else
begin begin
Logger.Log( 2, 'TAuthService.GetAgenciesList - Error: connecting to CPS database!' ); Logger.Log(2, 'TAuthService.GetAgenciesList - Error: connecting to auth database!');
raise EXDataHttpException.Create('Error connecting to CPS database!'); raise EXDataHttpException.Create('Error connecting to auth database!');
end; end;
end; end;
...@@ -106,26 +115,36 @@ var ...@@ -106,26 +115,36 @@ var
begin begin
Logger.Log(2, 'AuthService.GetAgencyConfigList - call'); Logger.Log(2, 'AuthService.GetAgencyConfigList - call');
authDB.uqBooking.Close; authDB.uqAuth.Close;
sql := 'select agency_id, agency, agency_name from agencyconfig ' +
'where active = ''Y'' order by agency'; sql := 'select agencyid, agencyname ' +
authDB.uqBooking.SQL.Text := sql; 'from lems.agency ' +
authDB.uqBooking.Open; 'where agencytype = ''POL'' ' +
'order by agencyname';
authDB.uqAuth.SQL.Text := sql;
authDB.uqAuth.Open;
Result := TAgencyConfigList.Create; Result := TAgencyConfigList.Create;
Result.data := TList<TAgencyConfigItem>.Create; Result.data := TList<TAgencyConfigItem>.Create;
TXDataOperationContext.Current.Handler.ManagedObjects.Add(Result.data); TXDataOperationContext.Current.Handler.ManagedObjects.Add(Result.data);
while not authDB.uqBooking.Eof do
begin try
agencyConfig := TAgencyConfigItem.Create; while not authDB.uqAuth.Eof do
TXDataOperationContext.Current.Handler.ManagedObjects.Add(agencyConfig); begin
Result.data.Add(agencyConfig); agencyConfig := TAgencyConfigItem.Create;
agencyConfig.id := authDB.uqBooking.FieldByName('agency_id').AsInteger; TXDataOperationContext.Current.Handler.ManagedObjects.Add(agencyConfig);
agencyConfig.agency := authDB.uqBooking.FieldByName('agency').AsString; Result.data.Add(agencyConfig);
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; end;
authDB.uqBooking.Close;
Result.count := Result.data.Count; Result.count := Result.data.Count;
Result.returned := Result.data.Count; Result.returned := Result.data.Count;
...@@ -210,43 +229,47 @@ begin ...@@ -210,43 +229,47 @@ begin
Logger.Log(3, Format('LoginService.CheckUser - User: "%s" Agency: "%s"', [User, Agency])); Logger.Log(3, Format('LoginService.CheckUser - User: "%s" Agency: "%s"', [User, Agency]));
passwordKey := 'wx3cFo$kIf2jrk(gOmvi7uvPfk*iorE8@kfm+nvR6jfh=swDqalpokSjf'; 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 + 'where upper(user_name) = ' + QuotedStr(UpperCase(Trim(User))) + ' ';
sqlStr := sqlStr + 'and u.dept = ' + QuotedStr(UpperCase(Trim(Agency))); 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])); Logger.Log(4, Format('LoginService.CheckUser - Query: "%s"', [sqlStr]));
authDB.uqBooking.Open; authDB.uqAuth.Open;
try
if authDB.uqBooking.IsEmpty then if authDB.uqAuth.IsEmpty then
Result := 0 Result := 0
else
begin
if authDB.uqBooking.FieldByName('active').AsString = 'F' then
Result := 1
else else
begin begin
decryptedPassword := Uppercase(Trim(Decrypt(authDB.uqBooking.FieldByName('password').AsString, passwordKey))); if authDB.uqAuth.FieldByName('active').AsString = 'F' then
if decryptedPassword = Uppercase(Trim(Password)) then Result := 1
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;
userStr := '?username=' + userName;
userStr := userStr + '&fullname=' + userFullName;
userStr := userStr + '&agency=' + userAgency;
userStr := userStr + '&userid=' + userId;
userStr := userStr + '&personnelid=' + userPersonnelId;
authDB.SetLoginAuditEntry(userStr);
Result := 2;
end
else else
Result := 0; begin
decryptedPassword := Uppercase(Trim(Decrypt(authDB.uqAuth.FieldByName('password').AsString, passwordKey)));
if decryptedPassword = Uppercase(Trim(Password)) then
begin
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;
userStr := userStr + '&agency=' + userAgency;
userStr := userStr + '&userid=' + userId;
userStr := userStr + '&personnelid=' + userPersonnelId;
authDB.SetLoginAuditEntry(userStr);
Result := 2;
end
else
Result := 0;
end;
end; end;
finally
authDB.uqAuth.Close;
end; end;
end; end;
......
...@@ -19,6 +19,16 @@ type ...@@ -19,6 +19,16 @@ type
FWebClientVersionFromIni: Boolean; FWebClientVersionFromIni: Boolean;
// [Database] // [Database]
FDatabaseServer: string;
FDatabaseServerFromIni: Boolean;
FDatabasePort: Integer;
FDatabasePortFromIni: Boolean;
FDatabaseName: string;
FDatabaseNameFromIni: Boolean;
FDatabaseUsername: string;
FDatabaseUsernameFromIni: Boolean;
FDatabasePassword: string;
FDatabasePasswordFromIni: Boolean;
public public
constructor Create; constructor Create;
...@@ -35,6 +45,16 @@ type ...@@ -35,6 +45,16 @@ type
property WebClientVersionFromIni: Boolean read FWebClientVersionFromIni; property WebClientVersionFromIni: Boolean read FWebClientVersionFromIni;
// [Database] // [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; end;
...@@ -74,6 +94,20 @@ begin ...@@ -74,6 +94,20 @@ begin
FWebClientVersionFromIni := iniFile.ValueExists('Settings', 'webClientVersion'); FWebClientVersionFromIni := iniFile.ValueExists('Settings', 'webClientVersion');
// [Database] // [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 finally
iniFile.Free; iniFile.Free;
...@@ -81,4 +115,3 @@ begin ...@@ -81,4 +115,3 @@ begin
end; end;
end. end.
...@@ -23,8 +23,6 @@ object FMain: TFMain ...@@ -23,8 +23,6 @@ object FMain: TFMain
Anchors = [akLeft, akTop, akRight, akBottom] Anchors = [akLeft, akTop, akRight, akBottom]
ReadOnly = True ReadOnly = True
TabOrder = 0 TabOrder = 0
ExplicitWidth = 744
ExplicitHeight = 549
end end
object btnApiSwaggerUI: TButton object btnApiSwaggerUI: TButton
Left = 141 Left = 141
......
...@@ -26,6 +26,8 @@ type ...@@ -26,6 +26,8 @@ type
strict private strict private
procedure StartServers; procedure StartServers;
function LogValue(const LabelName: string; const Value: string; FromIni: Boolean): string; function LogValue(const LabelName: string; const Value: string; FromIni: Boolean): string;
private
function LocalBrowserUrl(const Url: string): string;
end; end;
var var
...@@ -50,14 +52,25 @@ begin ...@@ -50,14 +52,25 @@ begin
Close; Close;
end; end;
function TFMain.LocalBrowserUrl(const Url: string): string;
begin
Result := StringReplace(Url, '://0.0.0.0:', '://localhost:', [rfIgnoreCase]);
end;
procedure TFMain.btnApiSwaggerUIClick(Sender: TObject); procedure TFMain.btnApiSwaggerUIClick(Sender: TObject);
var
url: string;
begin 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; end;
procedure TFMain.btnAuthSwaggerUIClick(Sender: TObject); procedure TFMain.btnAuthSwaggerUIClick(Sender: TObject);
var
url: string;
begin 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; end;
procedure TFMain.ContactFormData(AText: String); procedure TFMain.ContactFormData(AText: String);
......
...@@ -39,7 +39,7 @@ var ...@@ -39,7 +39,7 @@ var
sql: string; sql: string;
serverDateTime: TDateTime; serverDateTime: TDateTime;
begin begin
sql := 'select sysdate as currentdatetime from dual'; sql := 'select current_timestamp as currentdatetime';
DoQuery( uq, sql ); DoQuery( uq, sql );
serverDateTime := uq.FieldByName('CURRENTDATETIME').AsDateTime; serverDateTime := uq.FieldByName('CURRENTDATETIME').AsDateTime;
...@@ -86,7 +86,7 @@ function GetNextSeqVal(uq: TUniQuery; sequence: string ): string; ...@@ -86,7 +86,7 @@ function GetNextSeqVal(uq: TUniQuery; sequence: string ): string;
var var
sql: string; sql: string;
begin begin
sql := 'select ' + sequence + '.NEXTVAL as nextseqval from dual'; sql := 'select nextval(' + QuotedStr(sequence) + ') as nextseqval';
uq.Close; uq.Close;
uq.SQL.Text := sql; uq.SQL.Text := sql;
uq.Open; uq.Open;
......
[Settings] [Settings]
LogFileNum=666 LogFileNum=695
webClientVersion=0.1.0 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 ...@@ -62,10 +62,10 @@ object FViewMap: TFViewMap
end end
object httpReqGeoJson: TWebHttpRequest object httpReqGeoJson: TWebHttpRequest
ResponseType = rtText ResponseType = rtText
URL = 'assets/bpddistricts-updated.geojson' URL = 'assets/orleanscounty.geojson'
OnResponse = httpReqGeoJsonResponse OnResponse = httpReqGeoJsonResponse
Left = 114 Left = 116
Top = 696 Top = 698
end end
object xdwcMap: TXDataWebClient object xdwcMap: TXDataWebClient
Connection = DMConnection.ApiConnection Connection = DMConnection.ApiConnection
......
...@@ -38,13 +38,16 @@ type ...@@ -38,13 +38,16 @@ type
FPendingFocusCoord: TTMSFNCMapsCoordinateRec; FPendingFocusCoord: TTMSFNCMapsCoordinateRec;
FPendingFocusZoom: Integer; FPendingFocusZoom: Integer;
FDoFocusZoom: Boolean; FDoFocusZoom: Boolean;
FGeoJsonLoadStep: Integer;
[async] procedure LoadPointsAsync(showBusy: Boolean); [async] procedure LoadPointsAsync(showBusy: Boolean);
function CarIconForDistrict(const DistrictCode: string): string; function CarIconForAgency(const AgencyId: string): string;
procedure UpdateDeviceLocation(lat, lng: Double); procedure UpdateDeviceLocation(lat, lng: Double);
procedure StartDeviceLocation; procedure StartDeviceLocation;
procedure ApplyPendingUnitFocus; procedure ApplyPendingUnitFocus;
procedure ApplyPendingComplaintFocus; procedure ApplyPendingComplaintFocus;
procedure StartGeoJsonLoad;
procedure LoadGeoJsonLayer(const AResponse, ALayerName: string; FitLayer: Boolean);
public public
procedure FocusUnit(const unitId: string); procedure FocusUnit(const unitId: string);
procedure FocusComplaint(const complaintId: string); procedure FocusComplaint(const complaintId: string);
...@@ -66,7 +69,7 @@ begin ...@@ -66,7 +69,7 @@ begin
ShowSpinner('spinner'); ShowSpinner('spinner');
FUnitsLoaded := False; FUnitsLoaded := False;
FComplaintsLoaded := False; FComplaintsLoaded := False;
httpReqGeoJson.Execute; StartGeoJsonLoad;
asm asm
window.showComplaintDetails = function (id) { window.showComplaintDetails = function (id) {
try { try {
...@@ -140,58 +143,85 @@ begin ...@@ -140,58 +143,85 @@ begin
end; end;
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 var
startIndex: Integer;
i: Integer; i: Integer;
P: TTMSFNCMapsPolygon; P: TTMSFNCMapsPolygon;
begin begin
startIndex := lfMap.Polygons.Count;
lfMap.BeginUpdate; lfMap.BeginUpdate;
try try
lfMap.Polygons.Clear; lfMap.LoadGeoJSONFromText(AResponse, True, FitLayer);
lfMap.LoadGeoJSONFromText(AResponse, True, Trim(FPendingUnitId) = '');
for i := 0 to lfMap.Polygons.Count - 1 do for i := startIndex to lfMap.Polygons.Count - 1 do
begin begin
P := lfMap.Polygons[i]; P := lfMap.Polygons[i];
case i of if SameText(ALayerName, 'Towns') then
0: begin begin
P.DisplayName := 'District A'; P.FillColor := HTMLToColor('#ffffff');
P.FillColor := HTMLToColor('#d3ffbe'); // light green P.FillOpacity := 0.05;
P.StrokeColor := HTMLToColor('#6ea85c'); // darker green P.StrokeColor := HTMLToColor('#000000');
end; P.StrokeOpacity := 1.0;
1: begin P.StrokeWidth := 2;
P.DisplayName := 'District B'; end
P.FillColor := HTMLToColor('#ffbebe'); // light red else if SameText(ALayerName, 'Villages') then
P.StrokeColor := HTMLToColor('#b34a4a'); // darker red begin
end; P.FillColor := HTMLToColor('#0d6efd');
2: begin P.FillOpacity := 0.20;
P.DisplayName := 'District C'; P.StrokeColor := HTMLToColor('#0d6efd');
P.FillColor := HTMLToColor('#ffd37f'); // light orange P.StrokeOpacity := 1.0;
P.StrokeColor := HTMLToColor('#b36e00'); // darker orange P.StrokeWidth := 2;
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; end;
P.FillOpacity := 0.60;
P.StrokeOpacity := 1.0;
P.StrokeWidth := 2;
end; end;
finally finally
lfMap.EndUpdate; lfMap.EndUpdate;
end; 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)); await(LoadPointsAsync(True));
...@@ -202,23 +232,9 @@ begin ...@@ -202,23 +232,9 @@ begin
end; end;
end; end;
function TFViewMap.CarIconForDistrict(const DistrictCode: string): string; function TFViewMap.CarIconForAgency(const AgencyId: string): string;
var
U: string;
L: Char;
begin begin
U := UpperCase(Trim(DistrictCode)); Result := 'assets/markers/car_default.png';
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; end;
...@@ -230,9 +246,9 @@ var ...@@ -230,9 +246,9 @@ var
i, ui: Integer; i, ui: Integer;
m: TTMSFNCMapsMarker; m: TTMSFNCMapsMarker;
lat, lng: Double; lat, lng: Double;
uName, dist: string; uName, agency: string;
unitId, callType, priorityText, statusText: string; unitId, callType, priorityText, statusText: string;
complaintId, codeDesc, dispatchDist, priority, business: string; complaintId, codeDesc, priority, business: string;
pngName, iconUrl, rowsHtml: string; pngName, iconUrl, rowsHtml: string;
officer1Lname, officer1Fname, officer1Empnum: string; officer1Lname, officer1Fname, officer1Empnum: string;
officer2Lname, officer2Fname, officer2Empnum: string; officer2Lname, officer2Fname, officer2Empnum: string;
...@@ -301,7 +317,10 @@ begin ...@@ -301,7 +317,10 @@ begin
lat := Double(item['Lat']); lat := Double(item['Lat']);
lng := Double(item['Lng']); lng := Double(item['Lng']);
uName := string(item['UnitName']); uName := string(item['UnitName']);
dist := string(item['District']); agency := string(item['AgencyName']);
if Trim(agency) = '' then
agency := string(item['Agency']);
unitId := string(item['UnitId']); unitId := string(item['UnitId']);
callType := string(item['CallType']); callType := string(item['CallType']);
priorityText := string(item['Priority']); priorityText := string(item['Priority']);
...@@ -361,8 +380,8 @@ begin ...@@ -361,8 +380,8 @@ begin
'<div class="fw-semibold small">' + '<div class="fw-semibold small">' +
'<span class="fw-bold">Unit:</span> ' + uName + '<span class="fw-bold">Unit:</span> ' + uName +
'</div>' + '</div>' +
IfThen(dist <> '', IfThen(agency <> '',
'<div class="small"><span class="fw-bold">District:</span> ' + dist + '</div>', '<div class="small"><span class="fw-bold">Agency:</span> ' + agency + '</div>',
'' ''
) + ) +
IfThen(Trim(callType) <> '', IfThen(Trim(callType) <> '',
...@@ -396,7 +415,7 @@ begin ...@@ -396,7 +415,7 @@ begin
'</div>'; '</div>';
m.DataString := 'unit|' + unitId; m.DataString := 'unit|' + unitId;
m.IconURL := CarIconForDistrict(dist); m.IconURL := CarIconForAgency(agency);
end; end;
end; end;
...@@ -409,7 +428,9 @@ begin ...@@ -409,7 +428,9 @@ begin
complaintId := string(item['ComplaintId']); complaintId := string(item['ComplaintId']);
codeDesc := string(item['DispatchCodeDesc']); codeDesc := string(item['DispatchCodeDesc']);
dispatchDist := string(item['DispatchDistrict']); agency := string(item['AgencyName']);
if Trim(agency) = '' then
agency := string(item['Agency']);
priority := string(item['Priority']); priority := string(item['Priority']);
business := string(item['Business']); business := string(item['Business']);
...@@ -464,7 +485,7 @@ begin ...@@ -464,7 +485,7 @@ begin
'<span class="fw-bold">Dispatch Code:</span> ' + codeDesc + '<span class="fw-bold">Dispatch Code:</span> ' + codeDesc +
'</div>' + '</div>' +
'<div class="small">' + '<div class="small">' +
'<span class="fw-bold">Dispatch District:</span> ' + dispatchDist + '<span class="fw-bold">Agency:</span> ' + agency +
'</div>' + '</div>' +
IfThen(Trim(business) <> '', IfThen(Trim(business) <> '',
'<div class="small">' + '<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