Skip to content

E
emiMobile
Commit 7481bbad by Michael Brachmann
Options

merge master updates into websockets

parents da5ba245 62bc3ab1
Showing with 711 additions and 319 deletions
emiMobileServer/Source/Auth.Database.dfm
......@@ -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
emiMobileServer/Source/Auth.Database.pas
......@@ -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
......
emiMobileServer/Source/Auth.Service.pas
......@@ -27,7 +27,7 @@ type
TAgencyConfigItem = class
public
id: integer;
id: string;
agency: String;
name: String;
end;
......@@ -58,9 +58,3 @@ begin
end;
end.
constructor TAgencyItem.Create(AAgency: String);
begin
agency := AAgency;
end;
end.
emiMobileServer/Source/Auth.ServiceImpl.pas
......@@ -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.uq;
Logger.Log(3, 'AuthDatabase destroyed');
end;
function TAuthService.GetAgenciesList: TAgenciesList;
......@@ -71,31 +66,42 @@ 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 login = ''T'' ' +
'order by agencyid';
authDB.uqAuth.Open;
Result := TAgenciesList.Create;
TXDataOperationContext.Current.Handler.ManagedObjects.Add(Result);
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(500, 'Failed to load agencies');
end;
end;
......@@ -106,26 +112,38 @@ 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 login = ''T'' ' +
'order by agencyname';
authDB.uqAuth.SQL.Text := sql;
authDB.uqAuth.Open;
Result := TAgencyConfigList.Create;
TXDataOperationContext.Current.Handler.ManagedObjects.Add(Result);
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;
......@@ -178,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
......@@ -203,37 +238,41 @@ 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 users@cps_link 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;
Logger.Log(4, Format('LoginService.CheckUser - Query: "%s"', [sqlStr]));
authDB.uqBooking.Open;
authDB.uqAuth.Close;
authDB.uqAuth.SQL.Text :=
'select u.* from lems.users u ' +
'where upper(user_name) = :USER_NAME ' +
'and u.dept = :AGENCY';
if authDB.uqBooking.IsEmpty then
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
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 +287,9 @@ begin
Result := 0;
end;
end;
finally
authDB.uqAuth.Close;
end;
end;
function TAuthService.Decrypt(inStr, keyStr: AnsiString): AnsiString;
......@@ -256,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/Source/Common.Ini.pas
......@@ -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.74.10');
FDatabaseServerFromIni := iniFile.ValueExists('Database', 'Server');
FDatabasePort := iniFile.ReadInteger('Database', 'Port', 5433);
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.
emiMobileServer/Source/Main.dfm
......@@ -2,8 +2,8 @@ object FMain: TFMain
Left = 0
Top = 0
Caption = 'emiMobileServer'
ClientHeight = 597
ClientWidth = 764
ClientHeight = 583
ClientWidth = 761
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
......@@ -12,20 +12,20 @@ object FMain: TFMain
Font.Style = []
OnClose = FormClose
DesignSize = (
764
597)
761
583)
TextHeight = 13
object memoInfo: TMemo
Left = 8
Top = 39
Width = 744
Height = 549
Width = 741
Height = 535
Anchors = [akLeft, akTop, akRight, akBottom]
ReadOnly = True
TabOrder = 0
end
object btnApiSwaggerUI: TButton
Left = 297
Left = 141
Top = 8
Width = 100
Height = 25
......@@ -43,7 +43,7 @@ object FMain: TFMain
OnClick = btnExitClick
end
object btnAuthSwaggerUI: TButton
Left = 169
Left = 31
Top = 8
Width = 100
Height = 25
......
emiMobileServer/Source/Main.pas
......@@ -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);
......
emiMobileServer/Source/uLibrary.pas
......@@ -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;
......
emiMobileServer/bin/emiMobileServer.ini
[Settings]
LogFileNum=677
LogFileNum=723
webClientVersion=0.1.0
[Database]
--Server=192.168.102.10
Server=192.168.74.10
Port=5433
Database=lems_wcso
Username=postgres
--Password=postgreSQL
Password=emsys01
emiMobileServer/emiMobileServer.dproj
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{2A3028D9-BC39-4625-9BA5-0338012E2824}</ProjectGuid>
<ProjectVersion>20.3</ProjectVersion>
<ProjectVersion>20.4</ProjectVersion>
<FrameworkType>VCL</FrameworkType>
<Base>True</Base>
<Config Condition="'$(Config)'==''">Debug</Config>
......@@ -863,6 +863,9 @@
<Platform Name="Win64x">
<Operation>1</Operation>
</Platform>
<Platform Name="WinARM64EC">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectiOSDeviceDebug">
<Platform Name="iOSDevice32">
......@@ -933,6 +936,10 @@
<RemoteDir>Assets</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="WinARM64EC">
<RemoteDir>Assets</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="UWP_DelphiLogo44">
<Platform Name="Win32">
......@@ -943,6 +950,10 @@
<RemoteDir>Assets</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="WinARM64EC">
<RemoteDir>Assets</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iOS_AppStore1024">
<Platform Name="iOSDevice64">
......@@ -1156,6 +1167,7 @@
<ProjectRoot Platform="Win32" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="Win64" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="Win64x" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="WinARM64EC" Name="$(PROJECTNAME)"/>
</Deployment>
<Platforms>
<Platform value="Win32">True</Platform>
......
webEMIMobile/View.ComplaintArchive.dfm
......@@ -110,20 +110,6 @@ object FViewComplaintArchive: TFViewComplaintArchive
WidthPercent = 100.000000000000000000
OnClick = btnCmpArcClick
end
object btnComplaintViewOnMapArc: TWebButton
Left = 342
Top = 259
Width = 96
Height = 25
Caption = 'Map'
ChildOrder = 1
ElementID = 'btn_complaint_view_on_map_arc'
ElementFont = efCSS
HeightStyle = ssAuto
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
OnClick = btnComplaintViewOnMapArcClick
end
object xdwcComplaintArchive: TXDataWebClient
Connection = DMConnection.ApiConnection
Left = 292
......
webEMIMobile/View.ComplaintArchive.html
......@@ -81,11 +81,4 @@
</div>
</div>
<button id="btn_complaint_view_on_map_arc"
type="button"
class="btn btn-primary btn-sm shadow position-fixed"
style="right: 15px; bottom: 25px; z-index: 1040;">
Map
</button>
</div>
webEMIMobile/View.ComplaintArchive.pas
......@@ -26,13 +26,10 @@ type
btnREMArc: TWebButton;
btnE911Arc: TWebButton;
btnCmpArc: TWebButton;
btnComplaintViewOnMapArc: TWebButton;
procedure WebFormCreate(Sender: TObject);
procedure btnCmpArcClick(Sender: TObject);
procedure btnE911ArcClick(Sender: TObject);
procedure btnREMArcClick(Sender: TObject);
procedure btnUntArcClick(Sender: TObject);
procedure btnComplaintViewOnMapArcClick(Sender: TObject);
private
FComplaintId: string;
FCfsId: string;
......@@ -44,6 +41,8 @@ type
FShowREM: Boolean;
FShowUNT: Boolean;
FInitialized: Boolean;
procedure WireUi;
procedure SetTextById(const Id, Value: string);
procedure SetHiddenById(const Id: string; Hidden: Boolean);
......@@ -56,8 +55,13 @@ type
function GetMemoTypeCode(const MemoType: string): string;
function MemoTypeLabel(const MemoType: string): string;
function MemoTypeInList(const memoType: string; const list: array of string): Boolean;
procedure SetRemarksData(dataArr: TJSArray);
function DeriveStatusFromDates(const dateDispatched, dateArrived, dateCleared: string): string;
public
class function CreateForm(const AHostId, AComplaintId: string): TFViewComplaintArchive;
class function CreateForm(const AHostId, AComplaintId: string): TWebForm;
procedure InitializeForm;
end;
implementation
......@@ -67,14 +71,32 @@ uses
{$R *.dfm}
class function TFViewComplaintArchive.CreateForm(const AHostId, AComplaintId: string): TFViewComplaintArchive;
class function TFViewComplaintArchive.CreateForm(const AHostId, AComplaintId: string): TWebForm;
procedure AfterCreate(AForm: TObject);
begin
with TFViewComplaintArchive(AForm) do
begin
FComplaintId := AComplaintId;
InitializeForm;
end;
end;
begin
Result := TFViewComplaintArchive(inherited CreateNew(AHostId));
Result.FComplaintId := AComplaintId;
Application.CreateForm(TFViewComplaintArchive, AHostId, Result, @AfterCreate);
end;
procedure TFViewComplaintArchive.WebFormCreate(Sender: TObject);
procedure TFViewComplaintArchive.InitializeForm;
begin
if FInitialized then
Exit;
FInitialized := True;
xdwcComplaintArchive.Connection := DMConnection.ApiConnection;
xdwdsRemarksArc.Connection := DMConnection.ApiConnection;
FAllMemos := nil;
FShowCMP := True;
......@@ -142,21 +164,27 @@ var
rootObj: TJSObject;
dataObj: TJSObject;
business: string;
dateDispatchedText: string;
dateArrivedText: string;
dateClearedText: string;
statusText: string;
begin
resp := await(xdwcComplaintArchive.RawInvokeAsync('IApiService.GetComplaintArchiveDetails', [FComplaintId]));
rootObj := TJSObject(resp.Result);
dataObj := TJSObject(rootObj['data']);
// Summary title (optional)
SetTextById('lbl_summary_title_arc', 'Summary');
SetTextById('lbl_summary_title_arc', 'Summary for Complaint ' + string(dataObj['Complaint']));
SetTextById('lbl_priority_arc', string(dataObj['Priority']));
SetTextById('lbl_dispatch_code_arc', string(dataObj['DispatchCodeDesc']));
SetTextById('lbl_dispatch_district_arc', string(dataObj['DispatchDistrict']));
SetTextById('lbl_address_arc', string(dataObj['Address']));
business := '';
if dataObj.hasOwnProperty('Business') then
business := string(dataObj['Business']);
if business <> '' then
if Trim(business) <> '' then
begin
SetTextById('lbl_business_arc', business);
SetHiddenById('row_business_arc', False);
......@@ -164,15 +192,30 @@ begin
else
SetHiddenById('row_business_arc', True);
// Status: same logic style as details; simplest is derive from timestamps if you want,
// but archive view can just show blank unless you prefer the full logic.
// If your archive endpoint includes a computed Status, you can display it directly.
dateDispatchedText := '';
dateArrivedText := '';
dateClearedText := '';
if dataObj.hasOwnProperty('DateDispatched') then
dateDispatchedText := string(dataObj['DateDispatched']);
if dataObj.hasOwnProperty('DateArrived') then
dateArrivedText := string(dataObj['DateArrived']);
if dataObj.hasOwnProperty('DateCleared') then
dateClearedText := string(dataObj['DateCleared']);
statusText := '';
if dataObj.hasOwnProperty('Status') then
SetTextById('lbl_status_arc', string(dataObj['Status']))
else
SetTextById('lbl_status_arc', '');
statusText := string(dataObj['Status']);
if Trim(statusText) = '' then
statusText := DeriveStatusFromDates(dateDispatchedText, dateArrivedText, dateClearedText);
// CFSId is needed for memos
SetTextById('lbl_status_arc', statusText);
FCfsId := '';
if dataObj.hasOwnProperty('CFSId') then
FCfsId := string(dataObj['CFSId']);
await(LoadMemosAsync);
......@@ -180,30 +223,41 @@ end;
function TFViewComplaintArchive.MemoTypeLabel(const MemoType: string): string;
var
c: string;
code: string;
begin
c := GetMemoTypeCode(MemoType);
if c = 'CMP' then Exit('CMP');
if c = 'E911' then Exit('E-911');
if c = 'REM' then Exit('REM');
if c = 'UNT' then Exit('UNT');
code := GetMemoTypeCode(MemoType);
if code = 'CMP' then
Exit('CMP');
if code = 'E911' then
Exit('E-911');
if code = 'REM' then
Exit('REM');
if code = 'UNT' then
Exit('UNT');
Result := MemoType;
end;
function TFViewComplaintArchive.GetMemoTypeCode(const MemoType: string): string;
var
mt: string;
memoTypeCode: string;
begin
mt := LowerCase(Trim(MemoType));
memoTypeCode := Trim(MemoType);
if MemoTypeInList(memoTypeCode, ['30', '31', '32', '33', '34']) then
Exit('UNT');
// Match whatever your server returns in GetComplaintMemos:
// Keep these mappings aligned with ComplaintDetails.
if (mt = 'cmp') or (mt = 'complaint') then Exit('CMP');
if (mt = 'e-911') or (mt = 'e911') then Exit('E911');
if (mt = 'rem') or (mt = 'remarks') then Exit('REM');
if (mt = 'unt') or (mt = 'unit') then Exit('UNT');
if MemoTypeInList(memoTypeCode, ['3', '4']) then
Exit('CMP');
Result := UpperCase(mt);
if MemoTypeInList(memoTypeCode, ['2']) then
Exit('E911');
if MemoTypeInList(memoTypeCode, ['1']) then
Exit('REM');
Result := memoTypeCode;
end;
[async] procedure TFViewComplaintArchive.LoadMemosAsync;
......@@ -218,6 +272,9 @@ begin
// Reset dataset
xdwdsRemarksArc.Close;
if Trim(FCfsId) = '' then
Exit;
resp := await(xdwcComplaintArchive.RawInvokeAsync('IApiService.GetComplaintMemos', [FCfsId]));
rootObj := TJSObject(resp.Result);
dataArr := TJSArray(rootObj['data']);
......@@ -265,8 +322,7 @@ begin
filtered.push(memoObj);
end;
xdwdsRemarksArc.SetJsonData(filtered);
xdwdsRemarksArc.Open;
SetRemarksData(filtered);
end;
procedure TFViewComplaintArchive.btnCmpArcClick(Sender: TObject);
......@@ -297,10 +353,36 @@ begin
ApplyMemoFilters;
end;
procedure TFViewComplaintArchive.btnComplaintViewOnMapArcClick(Sender: TObject);
function TFViewComplaintArchive.MemoTypeInList(const memoType: string; const list: array of string): Boolean;
var
i: Integer;
begin
Result := False;
for i := Low(list) to High(list) do
begin
if memoType = list[i] then
Exit(True);
end;
end;
procedure TFViewComplaintArchive.SetRemarksData(dataArr: TJSArray);
begin
xdwdsRemarksArc.Close;
xdwdsRemarksArc.SetJsonData(dataArr);
xdwdsRemarksArc.Open;
end;
function TFViewComplaintArchive.DeriveStatusFromDates(const dateDispatched, dateArrived, dateCleared: string): string;
begin
if Assigned(FViewMain) then
FViewMain.ShowMapFocusComplaint(FComplaintId);
if Trim(dateCleared) <> '' then
Exit('Cleared');
if Trim(dateArrived) <> '' then
Exit('On Scene');
if Trim(dateDispatched) <> '' then
Exit('Dispatched');
Result := 'Pending';
end;
end.
webEMIMobile/View.ComplaintDetails.dfm
......@@ -373,6 +373,20 @@ object FViewComplaintDetails: TFViewComplaintDetails
WidthPercent = 100.000000000000000000
OnClick = btnComplaintViewOnMapClick
end
object btnArchive: TWebButton
Left = 612
Top = 165
Width = 96
Height = 25
Caption = 'Archive Details'
ChildOrder = 14
ElementID = 'btn_archive'
ElementFont = efCSS
HeightStyle = ssAuto
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
OnClick = btnArchiveClick
end
object xdwcComplaintDetails: TXDataWebClient
Connection = DMConnection.ApiConnection
Left = 384
......
webEMIMobile/View.ComplaintDetails.html
......@@ -78,6 +78,11 @@
<button type="button" class="btn btn-success btn-sm px-3 active" id="btn_rem" aria-pressed="true">REM</button>
<button type="button" class="btn btn-success btn-sm px-3 active" id="btn_unt" aria-pressed="true">UNT</button>
</div>
<!-- History action row (only visible on History tab) -->
<div class="d-flex flex-wrap gap-2 justify-content-center mt-2 tab-hidden" id="row_history_actions">
<button type="button" class="btn btn-secondary btn-sm px-3 disabled" id="btn_archive" disabled>Archive</button>
</div>
</div>
</div>
......
webEMIMobile/View.ComplaintDetails.pas
......@@ -55,6 +55,7 @@ type
lstWarnings: TWebDBListControl;
btnComplaintViewOnMap: TWebButton;
xdwdsHistoryComplaintId: TStringField;
btnArchive: TWebButton;
procedure btnRemarksClick(Sender: TObject);
procedure btnHistoryClick(Sender: TObject);
......@@ -65,6 +66,7 @@ type
procedure btnE911Click(Sender: TObject);
procedure btnREMClick(Sender: TObject);
procedure btnUntClick(Sender: TObject);
procedure btnArchiveClick(Sender: TObject);
private
FComplaintId: string;
FCfsId: string;
......@@ -85,6 +87,9 @@ type
FContactsLoaded: Boolean;
FWarningsLoaded: Boolean;
FSelectedArchiveComplaintId: string;
FHistorySelectionBound: Boolean;
procedure WireUi;
procedure CloseClick(Event: TJSEvent);
......@@ -101,6 +106,11 @@ type
procedure UpdateTabButtonCss(const activeTabName: string);
procedure SetButtonEnabledById(const buttonId: string; enabled: Boolean);
procedure BindHistoryRowSelection;
procedure HistoryTableClick(Event: TJSEvent);
procedure ClearHistorySelection;
procedure SelectHistoryRowByIndex(rowIndex: Integer);
procedure ApplyRemarksFilters;
[async] procedure ApplyTabAsync(const tabName: string);
......@@ -163,6 +173,9 @@ begin
FContactsLoaded := False;
FWarningsLoaded := False;
FSelectedArchiveComplaintId := '';
FHistorySelectionBound := False;
WireUi;
LoadComplaintAsync;
end;
......@@ -174,6 +187,8 @@ begin
btnClose := Document.getElementById('btn_close_complaint_details');
if btnClose <> nil then
btnClose.addEventListener('click', @CloseClick);
BindHistoryRowSelection;
end;
procedure TFViewComplaintDetails.CloseClick(Event: TJSEvent);
......@@ -348,16 +363,121 @@ begin
end;
end;
procedure TFViewComplaintDetails.BindHistoryRowSelection;
var
el: TJSElement;
begin
if FHistorySelectionBound then
Exit;
el := Document.getElementById('tbl_history');
if el = nil then
Exit;
el.addEventListener('click', @HistoryTableClick);
FHistorySelectionBound := True;
end;
procedure TFViewComplaintDetails.HistoryTableClick(Event: TJSEvent);
var
rowIndex: Integer;
begin
rowIndex := -1;
asm
var target = Event.target;
var row = target.closest('tbody tr');
if (!row) {
return;
}
var rows = Array.prototype.slice.call(row.parentNode.children);
rows.forEach(function(r) {
r.classList.remove('table-primary');
});
row.classList.add('table-primary');
rowIndex = rows.indexOf(row);
end;
SelectHistoryRowByIndex(rowIndex);
end;
procedure TFViewComplaintDetails.ClearHistorySelection;
begin
FSelectedArchiveComplaintId := '';
SetButtonEnabledById('btn_archive', False);
asm
var host = document.getElementById('tbl_history');
if (host) {
var rows = host.querySelectorAll('tbody tr');
rows.forEach(function(row) {
row.classList.remove('table-primary');
});
}
end;
end;
procedure TFViewComplaintDetails.SelectHistoryRowByIndex(rowIndex: Integer);
var
i: Integer;
begin
FSelectedArchiveComplaintId := '';
if rowIndex < 0 then
begin
SetButtonEnabledById('btn_archive', False);
Exit;
end;
if not xdwdsHistory.Active then
begin
SetButtonEnabledById('btn_archive', False);
Exit;
end;
xdwdsHistory.First;
for i := 0 to rowIndex - 1 do
begin
if xdwdsHistory.Eof then
Break;
xdwdsHistory.Next;
end;
if xdwdsHistory.Eof then
begin
SetButtonEnabledById('btn_archive', False);
Exit;
end;
FSelectedArchiveComplaintId := xdwdsHistory.FieldByName('ComplaintId').AsString;
SetButtonEnabledById('btn_archive', Trim(FSelectedArchiveComplaintId) <> '');
end;
procedure TFViewComplaintDetails.SetActiveTab(const tabName: string);
begin
SetHiddenById('tbl_remarks', tabName <> 'remarks');
SetHiddenById('tbl_history', tabName <> 'history');
if tabName <> 'history' then
ClearHistorySelection;
SetHiddenById('tbl_contacts', tabName <> 'contacts');
SetHiddenById('tbl_warnings', tabName <> 'warnings');
SetHiddenById('lst_warnings', tabName <> 'warnings');
SetHiddenById('row_remarks_toggles', tabName <> 'remarks');
SetHiddenById('row_history_actions', tabName <> 'history');
UpdateTabButtonCss(tabName);
end;
......@@ -497,6 +617,15 @@ begin
ApplyTabAsync('warnings');
end;
procedure TFViewComplaintDetails.btnArchiveClick(Sender: TObject);
begin
if Trim(FSelectedArchiveComplaintId) = '' then
Exit;
if Assigned(FViewMain) then
FViewMain.ShowComplaintArchive(FSelectedArchiveComplaintId);
end;
procedure TFViewComplaintDetails.btnCmpClick(Sender: TObject);
begin
FShowCmp := not FShowCmp;
......@@ -684,6 +813,9 @@ begin
dataArr := TJSArray(rootObj['data']);
SetDataSetJsonData(xdwdsHistory, dataArr);
BindHistoryRowSelection;
ClearHistorySelection;
FHistoryLoaded := True;
end;
......
webEMIMobile/View.Complaints.dfm
......@@ -44,20 +44,18 @@ object FViewComplaints: TFViewComplaints
ItemTemplate =
'<div class="list-section-header small fw-semibold bg-secondary t' +
'ext-white rounded-1 px-2 mb-1">(%DistrictHeader%)</div><div clas' +
's="card border shadow-sm" style="--bs-card-bg:(%PriorityColor%);' +
'--bs-card-color:(%PriorityTextColor%);"><div class="card-body py' +
'-2 px-3 d-flex gap-2"><div class="flex-grow-1"><div class="fw-bo' +
'ld text-uppercase small">(%Priority%): (%DispatchCodeDesc%)</div' +
'><div class="small">(%Address%)</div><div class="small d-none co' +
'mplaint-business" data-business="(%Business%)">(%Business%)</div' +
'><div class="small text-opacity-75">(%Complaint%): (%Status%)&nb' +
'sp;&nbsp;(%DistrictSector%)</div><div class="small text-opacity-' +
'75">(%DateReported%)</div></div><div class="d-flex flex-column j' +
'ustify-content-center gap-1"><button type="button" class="btn bt' +
'n-primary btn-sm complaint-details-btn" data-id="(%ComplaintId%)' +
'">Details</button><button type="button" class="btn btn-primary b' +
'tn-sm btn-complaint-map" data-id="(%ComplaintId%)">Map</button><' +
'/div></div></div>'
's="card border shadow-sm"><div class="card-body py-2 px-3 d-flex' +
' gap-2"><div class="flex-grow-1"><div class="fw-bold text-upperc' +
'ase small">(%Priority%): (%DispatchCodeDesc%)</div><div class="s' +
'mall">(%Address%)</div><div class="small d-none complaint-busine' +
'ss" data-business="(%Business%)">(%Business%)</div><div class="s' +
'mall text-opacity-75">(%Complaint%): (%Status%)&nbsp;&nbsp;(%Age' +
'ncyLine%)</div><div class="small text-opacity-75">(%DateReported' +
'%)</div></div><div class="d-flex flex-column justify-content-cen' +
'ter gap-1"><button type="button" class="btn btn-primary btn-sm c' +
'omplaint-details-btn" data-id="(%ComplaintId%)">Details</button>' +
'<button type="button" class="btn btn-primary btn-sm btn-complain' +
't-map" data-id="(%ComplaintId%)">Map</button></div></div></div>'
ListSource = wdsComplaints
end
object xdwcComplaints: TXDataWebClient
......@@ -111,8 +109,13 @@ object FViewComplaints: TFViewComplaints
object xdwdsComplaintsPriorityTextColor: TStringField
FieldName = 'PriorityTextColor'
end
object xdwdsComplaintsDistrictSector: TStringField
FieldName = 'DistrictSector'
object xdwdsComplaintsStatusTextColor: TStringField
FieldName = 'StatusTextColor'
Size = 80
end
object xdwdsComplaintsAgencyLine: TStringField
FieldName = 'AgencyLine'
Size = 80
end
end
object wdsComplaints: TWebDataSource
......
webEMIMobile/View.Complaints.html
<div class="d-flex flex-column h-100">
<!-- Header / controls (non-scrolling) -->
<div class="flex-shrink-0">
<!-- Search bar under local navbar -->
<div class="bg-light border-bottom py-2">
<div class="container-fluid">
<div class="input-group">
<span class="input-group-text bg-white"><i class="fa fa-search"></i></span>
<input id="complaints_search" class="form-control" placeholder="Search...">
</div>
</div>
</div>
</div>
<!-- Scrolling list area -->
<div class="flex-grow-1 overflow-auto" style="min-height:0;">
<div class="container-fluid mt-2">
......
webEMIMobile/View.Complaints.pas
......@@ -30,8 +30,9 @@ type
xdwdsComplaintsStatusColor: TStringField;
xdwdsComplaintsPriorityColor: TStringField;
xdwdsComplaintsPriorityTextColor: TStringField;
xdwdsComplaintsDistrictSector: TStringField;
xdwdsComplaintsBusiness: TStringField;
xdwdsComplaintsStatusTextColor: TStringField;
xdwdsComplaintsAgencyLine: TStringField;
procedure WebFormCreate(Sender: TObject);
procedure WebFormDestroy(Sender: TObject);
private
......
webEMIMobile/View.Login.html
......@@ -53,10 +53,7 @@
</button>
</div>
<div class="card-footer text-muted small">
Please use your CHARMS username &amp; password to login.<br><br>
For non-CHARMS users, please call the CPS Help Desk at
(716) 858-7773 during business hours<br>
or email: <a href="mailto:CPSHelpdesk@erie.gov">CPSHelpdesk@erie.gov</a>
Please use your lems username &amp; password to login.
</div>
</div>
</div>
......
webEMIMobile/View.Main.dfm
......@@ -16,18 +16,6 @@ object FViewMain: TFViewMain
Visible = False
WidthPercent = 100.000000000000000000
end
object wllblLogout: TWebLinkLabel
Left = 551
Top = 85
Width = 41
Height = 15
ElementID = 'dropdown.menu.logout'
Visible = False
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
OnClick = wllblLogoutClick
Caption = ' Logout'
end
object lblAppTitle: TWebLabel
Left = 57
Top = 31
......@@ -82,6 +70,18 @@ object FViewMain: TFViewMain
ElementID = 'pnl_main'
ChildOrder = 3
TabOrder = 0
object WebButton1: TWebButton
Left = 456
Top = 20
Width = 96
Height = 25
Caption = 'WebButton1'
ElementClassName = 'btn btn-light'
ElementFont = efCSS
HeightStyle = ssAuto
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
end
end
object WebMessageDlg1: TWebMessageDlg
Left = 47
......@@ -159,7 +159,7 @@ object FViewMain: TFViewMain
end
object pnlUnits: TWebPanel
Left = 740
Top = 180
Top = 182
Width = 227
Height = 139
ElementID = 'pnl_units'
......@@ -177,7 +177,7 @@ object FViewMain: TFViewMain
end
object pnlDetails: TWebPanel
Left = 992
Top = 277
Top = 275
Width = 163
Height = 114
ElementID = 'pnl_details'
......@@ -197,6 +197,42 @@ object FViewMain: TFViewMain
OnClick = btnDetailsModalCloseClick
end
end
object pnlArchive: TWebPanel
Left = 992
Top = 395
Width = 163
Height = 114
ElementID = 'pnl_archive'
ChildOrder = 15
ElementFont = efCSS
TabOrder = 10
object btnArchiveModalClose: TWebButton
Left = 127
Top = 8
Width = 28
Height = 23
ElementID = 'btn_archive_modal_close'
ElementFont = efCSS
HeightStyle = ssAuto
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
OnClick = btnArchiveModalCloseClick
end
end
object btnLogout: TWebButton
Left = 438
Top = 66
Width = 96
Height = 25
Caption = 'Logout'
ChildOrder = 16
ElementID = 'btn_logout'
ElementFont = efCSS
HeightStyle = ssAuto
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
OnClick = btnLogoutClick
end
object xdwcBadgeCounts: TXDataWebClient
Connection = DMConnection.ApiConnection
Left = 44
......
webEMIMobile/View.Main.html
......@@ -11,8 +11,12 @@
<span id="lbl_main_title" class="navbar-brand text-light mb-0 ms-1"></span>
</div>
<!-- Right: Connection label -->
<span id="view.main.lblconnection" class="navbar-text text-light ms-auto"></span>
<!-- Right: Connection / Logout -->
<div class="d-flex align-items-center gap-2 ms-auto">
<span id="view.main.lblconnection" class="navbar-text text-light small"></span>
<button id="btn_logout" type="button" class="btn btn-outline-light btn-sm">Logout</button>
</div>
</div>
</nav>
......@@ -22,7 +26,6 @@
<div id="pnl_units" class="flex-grow-1 position-relative p-0 overflow-hidden d-none" style="min-height:0;"></div>
<div id="pnl_complaints" class="flex-grow-1 position-relative p-0 overflow-hidden d-none" style="min-height:0;"></div>
<!-- Details modal (new panel pnl_details) -->
<div id="pnl_details"
class="position-fixed top-0 start-0 w-100 h-100 d-none d-flex justify-content-center align-items-center"
......@@ -38,6 +41,21 @@
</div>
</div>
<!-- Archive details modal -->
<div id="pnl_archive"
class="position-fixed top-0 start-0 w-100 h-100 d-none d-flex justify-content-center align-items-center"
style="background: rgba(0,0,0,0.35); z-index:1070;">
<div class="card shadow-lg w-100 mx-2 d-flex flex-column" style="max-width: 96vw; height: 92%;">
<div class="card-header d-flex align-items-center justify-content-between">
<h5 class="card-title mb-0" id="lbl_archive_title">Archived Complaint Details</h5>
<button id="btn_archive_modal_close" type="button" class="btn-close" aria-label="Close"></button>
</div>
<div class="card-body p-0 flex-grow-1 overflow-hidden" style="min-height:0;">
<div id="pnl_archive_host" class="h-100"></div>
</div>
</div>
</div>
<!-- Bottom Nav -->
<nav id="bottom_nav" class="navbar navbar-dark bg-primary py-2 flex-shrink-0">
<div class="container-fluid">
......@@ -58,7 +76,6 @@
</div>
</div>
</nav>
</div>
<!-- Spinner -->
......@@ -81,7 +98,7 @@
Please contact EMSystems to solve the issue.
</div>
<div class="modal-footer justify-content-center">
<button type="button" id="btn_modal_restart" class="btn btn-primary">Back to Orders</button>
<button type="button" id="btn_modal_restart" class="btn btn-primary">Restart Application</button>
</div>
</div>
</div>
......
webEMIMobile/View.Main.pas
......@@ -12,7 +12,6 @@ uses
type
TFViewMain = class(TWebForm)
lblUsername: TWebLabel;
wllblLogout: TWebLinkLabel;
pnlMain: TWebPanel;
WebMessageDlg1: TWebMessageDlg;
lblAppTitle: TWebLabel;
......@@ -31,15 +30,21 @@ type
tmrGlobalRefresh: TWebTimer;
pnlDetails: TWebPanel;
btnDetailsModalClose: TWebButton;
pnlArchive: TWebPanel;
btnArchiveModalClose: TWebButton;
WebButton1: TWebButton;
btnLogout: TWebButton;
procedure WebFormCreate(Sender: TObject);
procedure mnuLogoutClick(Sender: TObject);
procedure wllblLogoutClick(Sender: TObject);
procedure lblLogoutClick(Sender: TObject);
procedure btnUnitsClick(Sender: TObject);
procedure btnComplaintsClick(Sender: TObject);
procedure btnMapClick(Sender: TObject);
procedure tmrBadgeCountsTimer(Sender: TObject);
procedure tmrGlobalRefreshTimer(Sender: TObject);
procedure btnDetailsModalCloseClick(Sender: TObject);
procedure btnArchiveModalCloseClick(Sender: TObject);
procedure btnLogoutClick(Sender: TObject);
private
{ Private declarations }
FUserInfo: string;
......@@ -48,6 +53,7 @@ type
FUnitsForm: TFViewUnits;
FComplaintsForm: TFViewComplaints;
FDetailsForm: TWebForm;
FArchiveForm: TWebForm;
FLogoutProc: TLogoutProc;
//WebSocketModule: Module.Websocket;
[async] procedure RefreshBadgesAsync;
......@@ -55,6 +61,8 @@ type
procedure SetHeaderTitle(const title: string);
procedure HideDetailsModal;
procedure ShowDetailsModal(const titleText: string);
procedure HideArchiveModal;
procedure ShowArchiveModal(const titleText: string);
type TActivePanel = (apNone, apMap, apUnits, apComplaints);
var
......@@ -74,6 +82,7 @@ type
class procedure Display(LogoutProc: TLogoutProc);
procedure ShowForm( AFormClass: TWebFormClass );
procedure ShowComplaintDetails(ComplaintId: string);
procedure ShowComplaintArchive(ComplaintId: string);
procedure SetActiveNavButton(const BtnId: string);
procedure ShowMapFocusUnit(const unitId: string);
procedure ShowMapFocusComplaint(const complaintId: string);
......@@ -95,12 +104,14 @@ uses
View.Users,
View.EditUser,
View.UnitDetails,
View.ComplaintArchive,
Utils;
{$R *.dfm}
const
DETAILS_HOST_ID = 'pnl_details_host';
ARCHIVE_HOST_ID = 'pnl_archive_host';
procedure TFViewMain.WebFormCreate(Sender: TObject);
var
......@@ -110,6 +121,7 @@ begin
lblUsername.Caption := ' ' + userName.ToLower + ' ';
FChildForm := nil;
FDetailsForm := nil;
FArchiveForm := nil;
FActivePanel := apNone;
FGlobalRefreshTick := 0;
......@@ -127,6 +139,7 @@ begin
HidePanel(pnlUnits);
HidePanel(pnlComplaints);
HidePanel(pnlDetails);
HidePanel(pnlArchive);
if not Assigned(FMapForm) then
begin
......@@ -223,12 +236,17 @@ begin
end;
procedure TFViewMain.wllblLogoutClick(Sender: TObject);
procedure TFViewMain.lblLogoutClick(Sender: TObject);
begin
FLogoutProc;
end;
procedure TFViewMain.btnArchiveModalCloseClick(Sender: TObject);
begin
HideArchiveModal;
end;
procedure TFViewMain.btnComplaintsClick(Sender: TObject);
begin
ShowForm(TFViewComplaints);
......@@ -237,9 +255,15 @@ end;
procedure TFViewMain.btnDetailsModalCloseClick(Sender: TObject);
begin
HideArchiveModal;
HideDetailsModal;
end;
procedure TFViewMain.btnLogoutClick(Sender: TObject);
begin
FLogoutProc;
end;
procedure TFViewMain.btnMapClick(Sender: TObject);
begin
ShowForm(TFViewMap);
......@@ -263,6 +287,7 @@ end;
procedure TFViewMain.ShowForm(AFormClass: TWebFormClass);
begin
HideArchiveModal;
HideDetailsModal;
if AFormClass = TFViewMap then
......@@ -377,6 +402,16 @@ begin
FDetailsForm := TFViewComplaintDetails.CreateForm(DETAILS_HOST_ID, ComplaintId);
end;
procedure TFViewMain.ShowComplaintArchive(ComplaintId: string);
begin
ShowArchiveModal('Archived Complaint Details');
if Assigned(FArchiveForm) then
FArchiveForm.Free;
FArchiveForm := TFViewComplaintArchive.CreateForm(ARCHIVE_HOST_ID, ComplaintId);
end;
procedure TFViewMain.ShowUnitDetails(UnitId: string);
begin
ShowDetailsModal('Unit Details');
......@@ -513,4 +548,27 @@ begin
end;
procedure TFViewMain.HideArchiveModal;
begin
HidePanel(pnlArchive);
if Assigned(FArchiveForm) then
begin
FArchiveForm.Free;
FArchiveForm := nil;
end;
end;
procedure TFViewMain.ShowArchiveModal(const titleText: string);
var
el: TJSElement;
begin
ShowPanel(pnlArchive);
el := Document.getElementById('lbl_archive_title');
if el <> nil then
el.innerHTML := titleText;
end;
end.
webEMIMobile/View.Map.dfm
......@@ -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
......
webEMIMobile/View.Units.dfm
......@@ -40,20 +40,22 @@ object FViewUnits: TFViewUnits
DataSource = wdsUnits
ItemTemplate =
'<div class="list-section-header small fw-semibold bg-body-second' +
'ary text-dark rounded-1 px-2 mb-1">(%DistrictHeader%)</div><div ' +
'class="card border shadow-sm"> <div class="card-body py-2 px-3 ' +
'd-flex gap-2"> <div class="flex-grow-1"> <div class="fw-' +
'bold text-uppercase small">(%UnitName%)&nbsp;-&nbsp;(%Status%)</' +
'div> <div class="small text-body-secondary mb-1">(%Location' +
'%)</div> <div class="small">(%CallType%)</div> <hr cla' +
'ss="unit-divider my-1" style="width: 80px; margin-left: 0" /> ' +
' <div class="small officer1">(%Officer1%)</div> <div clas' +
's="small officer2">(%Officer2%)</div> </div> <div class="d' +
'-flex flex-column justify-content-center gap-1"> <button ty' +
'pe="button" class="btn btn-primary btn-sm btn-unit-details" data' +
'-unitid="(%UnitId%)">Details</button> <button type="button"' +
' class="btn btn-primary btn-sm btn-unit-map" data-unitid="(%Unit' +
'Id%)">Map</button> </div> </div></div>'
'ary text-dark rounded-1 px-2 mb-1">(%AgencyHeader%)</div><div cl' +
'ass="card border shadow-sm"> <div class="card-body py-2 px-3 d-' +
'flex gap-2"> <div class="flex-grow-1"> <div class="fw-bo' +
'ld text-uppercase small">(%UnitName%)(%ComplaintHeader%)&nbsp;-&' +
'nbsp;(%Status%)</div> <div class="small text-body-secondary' +
' mb-1">(%Location%)</div> <div class="small">(%CallType%)</' +
'div> <hr class="unit-divider my-1" style="width: 80px; marg' +
'in-left: 0" /> <div class="small officer1">(%Officer1%)</di' +
'v> <div class="small officer2">(%Officer2%)</div> </div>' +
' <div class="d-flex flex-column justify-content-center gap-1"' +
'> <button type="button" class="btn btn-primary btn-sm btn-u' +
'nit-details" data-unitid="(%UnitId%)">Details</button> <but' +
'ton type="button" class="btn btn-sm btn-unit-map (%MapBut' +
'tonClass%)" data-unitid="(%UnitId%)" data-canmap="' +
'(%CanShowMap%)" title="(%MapButtonTitle%)" (%MapBu' +
'ttonDisabled%)> Map</button> </div> </div></div>'
ListSource = wdsUnits
end
object wdsUnits: TWebDataSource
......@@ -64,10 +66,10 @@ object FViewUnits: TFViewUnits
end
object xdwdsUnits: TXDataWebDataSet
Connection = DMConnection.ApiConnection
Left = 260
Left = 262
Top = 412
object xdwdsUnitsDistrictHeader: TStringField
FieldName = 'DistrictHeader'
object xdwdsUnitsAgencyHeader: TStringField
FieldName = 'AgencyHeader'
end
object xdwdsUnitsUnitId: TStringField
FieldName = 'UnitId'
......@@ -90,6 +92,33 @@ object FViewUnits: TFViewUnits
object xdwdsUnitsCallType: TStringField
FieldName = 'CallType'
end
object xdwdsUnitsAgency: TStringField
FieldName = 'Agency'
Size = 80
end
object xdwdsUnitsAgencyName: TStringField
FieldName = 'AgencyName'
Size = 80
end
object xdwdsUnitsAgencyType: TStringField
FieldName = 'AgencyType'
end
object xdwdsUnitsCanShowMap: TStringField
FieldName = 'CanShowMap'
end
object xdwdsUnitsMapButtonClass: TStringField
FieldName = 'MapButtonClass'
end
object xdwdsUnitsMapButtonDisabled: TStringField
FieldName = 'MapButtonDisabled'
end
object xdwdsUnitsMapButtonTitle: TStringField
FieldName = 'MapButtonTitle'
end
object xdwdsUnitsComplaintHeader: TStringField
FieldName = 'ComplaintHeader'
Size = 40
end
end
object xdwcUnits: TXDataWebClient
Connection = DMConnection.ApiConnection
......
webEMIMobile/View.Units.html
<div class="d-flex flex-column h-100">
<!-- Header / controls (non-scrolling) -->
<div class="flex-shrink-0">
<!-- Search bar under local navbar -->
<div class="bg-light border-bottom py-2">
<div class="container-fluid">
<div class="input-group">
<span class="input-group-text bg-white"><i class="fa fa-search"></i></span>
<input id="units_search" class="form-control" placeholder="Search...">
</div>
</div>
</div>
</div>
<!-- Scrolling list area -->
<div class="flex-grow-1 overflow-auto" style="min-height:0;">
<div class="container-fluid mt-2">
......
webEMIMobile/View.Units.pas
......@@ -17,7 +17,7 @@ type
xdwdsUnits: TXDataWebDataSet;
xdwcUnits: TXDataWebClient;
lblEntries: TWebLabel;
xdwdsUnitsDistrictHeader: TStringField;
xdwdsUnitsAgencyHeader: TStringField;
xdwdsUnitsUnitId: TStringField;
xdwdsUnitsUnitName: TStringField;
xdwdsUnitsLocation: TStringField;
......@@ -25,6 +25,14 @@ type
xdwdsUnitsOfficer1: TStringField;
xdwdsUnitsOfficer2: TStringField;
xdwdsUnitsCallType: TStringField;
xdwdsUnitsAgency: TStringField;
xdwdsUnitsAgencyName: TStringField;
xdwdsUnitsAgencyType: TStringField;
xdwdsUnitsCanShowMap: TStringField;
xdwdsUnitsMapButtonClass: TStringField;
xdwdsUnitsMapButtonDisabled: TStringField;
xdwdsUnitsMapButtonTitle: TStringField;
xdwdsUnitsComplaintHeader: TStringField;
procedure WebFormCreate(Sender: TObject);
private
FLoading: Boolean;
......@@ -65,6 +73,7 @@ var
el: TJSElement;
btn: TJSElement;
unitId: string;
canShowMap: string;
begin
btn := nil;
el := TJSElement(e.target);
......@@ -93,10 +102,16 @@ begin
if (btn <> nil) and (btn is TJSHtmlElement) then
begin
unitId := string(TJSHtmlElement(btn).getAttribute('data-unitid'));
canShowMap := string(TJSHtmlElement(btn).getAttribute('data-canmap'));
e.preventDefault;
e.stopPropagation;
if not SameText(canShowMap, 'true') then
Exit;
unitId := string(TJSHtmlElement(btn).getAttribute('data-unitid'));
asm
pas['View.Main'].FViewMain.ShowMapFocusUnit(unitId);
end;
......
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