Commit 6fa13c63 by Mac Stephens

Reworked envoy calls, added preliminary app structure, login functionality with…

Reworked envoy calls, added preliminary app structure, login functionality with embooking connection, and fncleaflet map with geojson district overlay
parent 691712ad
webEMIMobile/__history/
webEMIMobile/__recovery/
webEMIMobile/TMSWeb
webEMIMobile/Win32
webEMIMobile/css/__history/
emiMobileServer/__history
emiMobileServer/__recovery
emiMobileServer/doc/
emiMobileServer/Win32/
emiMobileServer/*.log
emiMobileServer/*.txt
emiMobileServer/Source/__history
emiMobileServer/Source/__recovery/
emiMobileServer/logs/*
*.local
*.exe
*.identcache
*.res
*.tvsconfig
object ApiDatabaseModule: TApiDatabaseModule
OnCreate = DataModuleCreate
Height = 480
Width = 640
object ucEnvoy: TUniConnection
ProviderName = 'PostgreSQL'
SpecificOptions.Strings = (
'PostgreSQL.Schema=envoy')
LoginPrompt = False
Left = 77
Top = 137
end
object PostgreSQLUniProvider1: TPostgreSQLUniProvider
Left = 228
Top = 138
end
object UniQuery1: TUniQuery
Connection = ucEnvoy
SQL.Strings = (
'')
Left = 363
Top = 138
end
object ucBooking: TUniConnection
ProviderName = 'Oracle'
Database = 'EMBOOKING'
Username = 'emBooking'
Server = 'EMBOOK-CPS'
LoginPrompt = False
Left = 77
Top = 231
EncryptedPassword = '9AFF92FF9DFF90FF90FF94FFCFFFCEFF'
end
object OracleUniProvider1: TOracleUniProvider
Left = 226
Top = 236
end
object uqBooking: TUniQuery
Connection = ucBooking
Left = 374
Top = 222
end
object uqUnitsCurrent: TUniQuery
Connection = ucBooking
SQL.Strings = (
'SELECT'
' uc.ENTRYID,'
' uc.UNITID,'
' COALESCE(uc.UNITNAME, uc.CAR_NUMBER) AS UNITNAME,'
' uc.UNIT_DISTRICT,'
' uc.GPS_LATITUDE,'
' uc.GPS_LONGITUDE'
'FROM UNITS_CURRENT@AVL_LINK uc')
Left = 462
Top = 324
end
object uqDISUnitsActive: TUniQuery
Connection = ucBooking
SQL.Strings = (
'SELECT'
' dua.UNITID,'
' dua.UNITNAME,'
' cun.CODE_DESC AS CARNUMBER_DESC,'
' cd.CODE_DESC AS DISTRICT_DESC,'
' cs.CODE_DESC AS SECTOR_DESC,'
' p1.PF_EMPNUM AS OFFICER1_EMPNUM,'
' p1.PF_LNAME AS OFFICER1_LAST_NAME,'
' p1.PF_FNAME AS OFFICER1_FIRST_NAME,'
' p1.PF_MI AS OFFICER1_MI,'
' p2.PF_EMPNUM AS OFFICER2_EMPNUM,'
' p2.PF_LNAME AS OFFICER2_LAST_NAME,'
' p2.PF_FNAME AS OFFICER2_FIRST_NAME,'
' p2.PF_MI AS OFFICER2_MI,'
' ca.LOCATION,'
' ca.COMPLAINT,'
' ca.UNITSTATUS,'
' cus.CODE_DESC AS UNIT_STATUS_DESC,'
' uc.ENTRYID,'
' uc.GPS_LATITUDE,'
' uc.GPS_LONGITUDE'
'FROM DIS_UNITS_ACTIVE dua'
'LEFT JOIN CD_UNIT_NUMBER cun ON cun.AGENCYCODE = dua.CA' +
'RNUMBER'
'LEFT JOIN CD_DISTRICT cd ON cd.AGENCYCODE = dua.DI' +
'STRICT'
'LEFT JOIN CD_SECTOR cs ON cs.AGENCYCODE = dua.SE' +
'CTOR AND cs.CODE_TYPE = cd.AGENCYCODE'
'LEFT JOIN PERSONNEL p1 ON dua.OFFICER1ID = p1.PF_' +
'NAMEID'
'LEFT JOIN PERSONNEL p2 ON dua.OFFICER2ID = p2.PF_' +
'NAMEID'
'LEFT JOIN CFS_ACTIVE ca ON dua.UNITID = ca.UNI' +
'TID'
'LEFT JOIN CD_UNITSTATUS cus ON ca.UNITSTATUS = cus.CO' +
'DE'
'LEFT JOIN UNITS_CURRENT@AVL_LINK uc ON dua.UNITID = uc.UNI' +
'TID')
Left = 462
Top = 374
end
object uqCFSActive: TUniQuery
Connection = ucBooking
SQL.Strings = (
'SELECT'
' ca.COMPLAINTID,'
' ca.UNITID,'
' ca.UNITNAME,'
' ca.DATEDISPATCHED,'
' ca.DATERESPONDED,'
' ca.DATEARRIVED,'
' ca.DATECLEARED,'
' ca.LOCATION'
'FROM CFS_ACTIVE ca'
'WHERE ca.COMPLAINTID = :COMPLAINTID'
'ORDER BY ca.DATEDISPATCHED')
Left = 278
Top = 318
ParamData = <
item
DataType = ftUnknown
Name = 'COMPLAINTID'
Value = nil
end>
end
object uqCFSMemos: TUniQuery
Connection = ucBooking
SQL.Strings = (
'SELECT'
' cm.MEMO_ID,'
' cm.CFSID,'
' cm.MEMO_TYPE,'
' cm.TIMESTAMP,'
' cm.BADGE_NUMBER,'
' cm.REMARKS'
'FROM CFS_MEMOS cm'
'WHERE cm.CFSID = :CFSID'
'ORDER BY cm.TIMESTAMP ASC')
Left = 282
Top = 376
ParamData = <
item
DataType = ftUnknown
Name = 'CFSID'
Value = nil
end>
end
object uqComplaintList: TUniQuery
Connection = ucBooking
SQL.Strings = (
'-- uqComplaintActive_List'
'SELECT'
' ca.COMPLAINTID,'
' ca.CFSID,'
' ca.COMPLAINT,'
' ca.AGENCY,'
' cdc.CODE_DESC AS DISPATCH_CODE_DESC,'
' ca.SOURCE,'
' ccs.CODE_DESC AS SOURCE_DESC,'
' ca.PRIORITY,'
' ca.ADDRESSID,'
' ca.ADDRESS,'
' ca.APARTMENT,'
' ca.CITY,'
' ca.BUSINESS,'
' ca.DISPATCHDISTRICT,'
' ca.DISPATCHSECTOR,'
' ca.ADDRESSDISTRICT,'
' ca.ADDRESSSECTOR,'
' ca.XCOORD,'
' ca.YCOORD,'
' ca.WARNINGS,'
' ca.CONTACTS,'
' ca.HISTORY,'
' ct.DATEREPORTED,'
' ct.DATERECEIVED,'
' ct.DATEDISPATCHED,'
' ct.DATERESPONDED,'
' ct.DATEARRIVED,'
' ct.DATECLEARED'
'FROM COMPLAINT_ACTIVE ca'
'JOIN COMPLAINT_TIMES ct ON ca.COMPLAINTID = ct.COMPLAINTID'
'LEFT JOIN CD_DISPATCHCODES cdc ON ca.DISPATCHCODE = cdc.CODE'
'LEFT JOIN CD_CALLSOURCES ccs ON ca.SOURCE = ccs.CODE'
'WHERE ca.COMPLAINT IS NOT NULL'
'ORDER BY ct.DATEREPORTED DESC, ca.PRIORITY DESC')
Left = 76
Top = 320
end
object uqComplaintDetails: TUniQuery
Connection = ucBooking
SQL.Strings = (
'-- uqComplaintActive_Detail'
'SELECT'
' ca.COMPLAINTID,'
' ca.CFSID,'
' ca.COMPLAINT,'
' ca.AGENCY,'
' ca.DISPATCHCODE,'
' cdc.CODE_DESC AS DISPATCH_CODE_DESC,'
' ca.SOURCE,'
' ccs.CODE_DESC AS SOURCE_DESC,'
' ca.PRIORITY,'
' ca.ADDRESSID,'
' ca.ADDRESS,'
' ca.APARTMENT,'
' ca.CITY,'
' ca.BUSINESS,'
' ca.DISPATCHDISTRICT,'
' ca.DISPATCHSECTOR,'
' ca.ADDRESSDISTRICT,'
' ca.ADDRESSSECTOR,'
' ca.XCOORD,'
' ca.YCOORD,'
' ca.WARNINGS,'
' ca.CONTACTS,'
' ca.HISTORY,'
' ct.DATEREPORTED,'
' ct.DATERECEIVED,'
' ct.DATEDISPATCHED,'
' ct.DATERESPONDED,'
' ct.DATEARRIVED,'
' ct.DATECLEARED'
'FROM COMPLAINT_ACTIVE ca'
'JOIN COMPLAINT_TIMES ct ON ca.COMPLAINTID = ct.COMPLAINTID'
'LEFT JOIN CD_DISPATCHCODES cdc ON ca.DISPATCHCODE = cdc.CODE'
'LEFT JOIN CD_CALLSOURCES ccs ON ca.SOURCE = ccs.CODE'
'WHERE ca.COMPLAINTID = :COMPLAINTID')
Left = 74
Top = 376
ParamData = <
item
DataType = ftUnknown
Name = 'COMPLAINTID'
Value = nil
end>
end
end
// Where the database is kept. Only used by Lookup.ServiceImpl to retrieve info
// from the data base and send it to the client.
// Author: ???
unit Api.Database;
interface
uses
System.SysUtils, System.Classes, Data.DB, MemDS, DBAccess, Uni, UniProvider,
PostgreSQLUniProvider, System.Variants, System.Generics.Collections, System.IniFiles,
Common.Logging, Vcl.Forms, OracleUniProvider;
type
TApiDatabaseModule = class(TDataModule)
ucEnvoy: TUniConnection;
PostgreSQLUniProvider1: TPostgreSQLUniProvider;
UniQuery1: TUniQuery;
ucBooking: TUniConnection;
OracleUniProvider1: TOracleUniProvider;
uqBooking: TUniQuery;
uqUnitsCurrent: TUniQuery;
uqDISUnitsActive: TUniQuery;
uqCFSActive: TUniQuery;
uqCFSMemos: TUniQuery;
uqComplaintList: TUniQuery;
uqComplaintDetails: TUniQuery;
procedure DataModuleCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
class procedure ExecSQL(const SQL: string);
end;
var
ApiDatabaseModule: TApiDatabaseModule;
implementation
{%CLASSGROUP 'Vcl.Controls.TControl'}
{$R *.dfm}
procedure TApiDatabaseModule.DataModuleCreate(Sender: TObject);
var
iniFile: TIniFile;
begin
iniFile := TIniFile.Create(ChangeFileExt(Application.ExeName, '.ini'));
try
ucEnvoy.Server := iniFile.ReadString('Database', 'Server', '');
ucEnvoy.Database := iniFile.ReadString('Database', 'Database', '');
ucEnvoy.Username := iniFile.ReadString('Database', 'Username', '');
ucEnvoy.Password := iniFile.ReadString('Database', 'Password', '');
try
Logger.Log(2, '');
Logger.Log(2, 'Connecting to envoyCalls Database (ApiDatabaseModule)...');
Logger.Log(2, Format('--ucEnvoy.Server: %s ucEnvoy.Username: %s', [ucEnvoy.Server, ucEnvoy.Username]));
if not ucEnvoy.Connected then
ucEnvoy.Connect;
Logger.Log(2, '--ucEnvoy connected!');
except
on E: Exception do
begin
Logger.Log(2, Format('Failed to connect to envoyCalls database: %s', [E.Message]));
end;
end;
Logger.Log(1, '');
Logger.Log(1, 'Loading Twilio settings...');
var twilioSID := iniFile.ReadString('Twilio', 'AccountSID', '');
if twilioSID.IsEmpty then
Logger.Log(1, 'Twilio->AccountSID: Entry not found')
else
Logger.Log(1, 'Twilio->AccountSID: ' + twilioSID);
var twilioAuth := iniFile.ReadString('Twilio', 'AuthHeader', '');
if twilioAuth.IsEmpty then
Logger.Log(1, 'Twilio->AuthHeader: Entry not found')
else
Logger.Log(1, 'Twilio->AuthHeader: ' + twilioAuth);
finally
iniFile.Free;
end;
end;
class procedure TApiDatabaseModule.ExecSQL(const SQL: string);
var
DB: TApiDatabaseModule;
begin
DB := TApiDatabaseModule.Create(nil);
try
DB.UniQuery1.SQL.Text := SQL;
DB.UniQuery1.ExecSQL;
finally
DB.Free;
end;
end;
end.
object ApiServerModule: TApiServerModule
Height = 273
Width = 230
object SparkleHttpSysDispatcher: TSparkleHttpSysDispatcher
Left = 84
Top = 30
end
object XDataServer1: TXDataServer
Dispatcher = SparkleHttpSysDispatcher
ModelName = 'Api'
EntitySetPermissions = <>
SwaggerOptions.Enabled = True
SwaggerOptions.AuthMode = Jwt
SwaggerUIOptions.Enabled = True
SwaggerUIOptions.ShowFilter = True
SwaggerUIOptions.TryItOutEnabled = True
Left = 85
Top = 110
object XDataServer1Logging: TSparkleGenericMiddleware
OnMiddlewareCreate = XDataServer1LoggingMiddlewareCreate
end
object XDataServer1CORS: TSparkleCorsMiddleware
end
object XDataServer1Compress: TSparkleCompressMiddleware
end
object XDataServer1JWT: TSparkleJwtMiddleware
OnGetSecret = XDataServer1JWTGetSecret
end
end
end
unit Api.Server.Module;
interface
uses
System.SysUtils, System.Classes, System.Generics.Collections,
Aurelius.Drivers.SQLite,
Aurelius.Comp.Connection,
Aurelius.Drivers.Interfaces,
XData.Aurelius.ConnectionPool, XData.Server.Module, Sparkle.Comp.Server,
XData.Comp.Server, XData.Comp.ConnectionPool, Sparkle.Comp.HttpSysDispatcher,
Sparkle.Comp.JwtMiddleware, Sparkle.Middleware.Jwt, Aurelius.Criteria.Linq,
Sparkle.HttpServer.Module, Sparkle.HttpServer.Context,
Sparkle.Comp.CompressMiddleware, Sparkle.Comp.CorsMiddleware,
Sparkle.Comp.GenericMiddleware, Aurelius.Drivers.UniDac, UniProvider,
Data.DB, DBAccess, Uni;
type
TApiServerModule = class(TDataModule)
SparkleHttpSysDispatcher: TSparkleHttpSysDispatcher;
XDataServer1: TXDataServer;
XDataServer1Logging: TSparkleGenericMiddleware;
XDataServer1CORS: TSparkleCorsMiddleware;
XDataServer1Compress: TSparkleCompressMiddleware;
XDataServer1JWT: TSparkleJwtMiddleware;
procedure XDataServer1LoggingMiddlewareCreate(Sender: TObject;
var Middleware: IHttpServerMiddleware);
procedure XDataServer1JWTGetSecret(Sender: TObject; var Secret: string);
private
{ Private declarations }
public
{ Public declarations }
procedure StartApiServer(ABaseUrl: string; AModelName: string);
end;
const
SERVER_PATH_SEGMENT = 'api';
var
ApiServerModule: TApiServerModule;
implementation
uses
Sparkle.HttpServer.Request,
Sparkle.Middleware.Cors,
Sparkle.Middleware.Compress,
XData.OpenApi.Service,
XData.Sys.Exceptions,
Common.Logging,
Common.Middleware.Logging,
Common.Config, Vcl.Forms, IniFiles;
{%CLASSGROUP 'Vcl.Controls.TControl'}
{$R *.dfm}
{ TApiServerModule }
function IsAdmin(Request: THttpServerRequest): Boolean;
var
User: IUserIdentity;
begin
User := Request.User;
Result := (User <> nil) and User.Claims.Exists('admin') and User.Claims['admin'].AsBoolean;
end;
procedure TApiServerModule.StartApiServer(ABaseUrl: string; AModelName: string);
var
Url: string;
begin
RegisterOpenApiService;
Url := ABaseUrl;
if not Url.EndsWith('/') then
Url := Url + '/';
Url := Url + SERVER_PATH_SEGMENT;
XDataServer1.BaseUrl := Url;
XDataServer1.ModelName := AModelName;
SparkleHttpSysDispatcher.Start;
Logger.Log(1, Format('Api server module listening at "%s"', [Url]));
end;
procedure TApiServerModule.XDataServer1LoggingMiddlewareCreate(Sender: TObject;
var Middleware: IHttpServerMiddleware);
begin
Middleware := TLoggingMiddleware.Create(Logger);
end;
procedure TApiServerModule.XDataServer1JWTGetSecret(Sender: TObject;
var Secret: string);
begin
Secret := serverConfig.jwtTokenSecret;
end;
end.
object AppServerModule: TAppServerModule
Height = 173
Width = 218
object SparkleHttpSysDispatcher: TSparkleHttpSysDispatcher
Left = 88
Top = 16
end
object SparkleStaticServer: TSparkleStaticServer
Dispatcher = SparkleHttpSysDispatcher
Left = 88
Top = 88
object SparkleStaticServerCompress: TSparkleCompressMiddleware
end
object SparkleStaticServerLogging: TSparkleLoggingMiddleware
FormatString = ':method :url :statuscode - :responsetime ms'
ExceptionFormatString = '(%1:s: %4:s) %0:s - %2:s'
ErrorResponseOptions.ErrorCode = 'ServerError'
ErrorResponseOptions.ErrorMessageFormat = 'Internal server error: %4:s'
end
end
end
unit App.Server.Module;
interface
uses
System.SysUtils, System.Classes, System.Generics.Collections,
Sparkle.Comp.Server, Sparkle.Comp.StaticServer, Sparkle.Comp.HttpSysDispatcher,
Sparkle.Module.Static, Sparkle.Comp.CompressMiddleware,
Sparkle.HttpServer.Module, Sparkle.HttpServer.Context,
Sparkle.Comp.LoggingMiddleware;
type
TAppServerModule = class(TDataModule)
SparkleHttpSysDispatcher: TSparkleHttpSysDispatcher;
SparkleStaticServer: TSparkleStaticServer;
SparkleStaticServerCompress: TSparkleCompressMiddleware;
SparkleStaticServerLogging: TSparkleLoggingMiddleware;
private
{ Private declarations }
public
{ Public declarations }
procedure StartAppServer(ABaseUrl: string);
end;
const
SERVER_PATH_SEGMENT = 'app';
var
AppServerModule: TAppServerModule;
implementation
uses
Sparkle.Middleware.Compress,
Common.Logging,
Common.Config;
{%CLASSGROUP 'Vcl.Controls.TControl'}
{$R *.dfm}
{ TAppServerModule }
procedure TAppServerModule.StartAppServer(ABaseUrl: string);
var
url: string;
begin
url := ABaseUrl;
if not url.EndsWith('/') then
url := url + '/';
url := url + SERVER_PATH_SEGMENT;
SparkleStaticServer.BaseUrl := url;
SparkleStaticServer.RootDir := serverConfig.webAppFolder;
SparkleHttpSysDispatcher.Start;
Logger.Log(1, Format('App server module listening at "%s", rootDir: %s', [url, serverConfig.webAppFolder]));
end;
end.
object AuthDatabase: TAuthDatabase
OnCreate = DataModuleCreate
OnDestroy = DataModuleDestroy
Height = 249
Width = 433
object uq: TUniQuery
Connection = ucEnvoy
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 ucEnvoy: TUniConnection
ProviderName = 'PostgreSQL'
SpecificOptions.Strings = (
'PostgreSQL.Schema=envoy')
LoginPrompt = False
Left = 43
Top = 79
end
object PostgreSQLUniProvider1: TPostgreSQLUniProvider
Left = 276
Top = 156
end
object OracleUniProvider1: TOracleUniProvider
Left = 94
Top = 152
end
object ucBooking: TUniConnection
ProviderName = 'Oracle'
Database = 'EMBOOKING'
Username = 'emBooking'
Server = 'EMBOOK-CPS'
LoginPrompt = False
Left = 339
Top = 75
EncryptedPassword = '9AFF92FF9DFF90FF90FF94FFCFFFCEFF'
end
object uqUserPref: TUniQuery
Connection = ucBooking
SQL.Strings = (
'SELECT * FROM USER_PREFERENCES')
Left = 204
Top = 114
end
object uqBooking: TUniQuery
Connection = ucBooking
Left = 98
Top = 44
end
end
unit Auth.Database;
interface
uses
System.SysUtils, System.Classes, IniFiles, Vcl.Forms, MemDS,
Data.DB, DBAccess, Uni, UniProvider, PostgreSQLUniProvider, OracleUniProvider;
type
TAuthDatabase = class(TDataModule)
uq: TUniQuery;
uqMisc: TUniQuery;
ucEnvoy: TUniConnection;
PostgreSQLUniProvider1: TPostgreSQLUniProvider;
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;
uqUserPref: TUniQuery;
uqBooking: TUniQuery;
procedure DataModuleCreate(Sender: TObject);
procedure DataModuleDestroy(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
procedure SetLoginAuditEntry( userStr: string );
end;
var
AuthDatabase: TAuthDatabase;
implementation
uses
System.JSON,
Common.Config,
Common.Logging,
uLibrary;
{%CLASSGROUP 'Vcl.Controls.TControl'}
{$R *.dfm}
procedure TAuthDatabase.DataModuleCreate(Sender: TObject);
var
iniFile: TIniFile;
begin
iniFile := TIniFile.Create(ChangeFileExt(Application.ExeName, '.ini'));
try
ucEnvoy.Server := iniFile.ReadString('Database', 'Server', '');
ucEnvoy.Database := iniFile.ReadString('Database', 'Database', '');
ucEnvoy.Username := iniFile.ReadString('Database', 'Username', '');
ucEnvoy.Password := iniFile.ReadString('Database', 'Password', '');
ucBooking.Server := IniFile.ReadString('EMB Database', 'Server', 'EMBOOKING');
ucBooking.Username := IniFile.ReadString('EMB Database', 'Username', 'emBooking');
ucBooking.Password := IniFile.ReadString('EMB Database', 'Password', 'embook01');
try
Logger.Log(2, '');
Logger.Log(2, 'Connecting to envoyCalls Database...');
Logger.Log(2, Format('--ucEnvoy.Server: %s ucEnvoy.Username: %s', [ucEnvoy.Server, ucEnvoy.Username]));
if not ucEnvoy.Connected then
ucEnvoy.Connect;
Logger.Log(2, '--ucEnvoy connected!');
Logger.Log(2, '');
Logger.Log(2, 'Connecting to emBooking Database...');
if not ucBooking.Connected then
ucBooking.Connect;
except
on E: Exception do
begin
Logger.Log(2, Format('Failed to connect to database: %s', [E.Message]));
end;
end;
Logger.Log(1, '');
Logger.Log(1, 'Loading Twilio settings...');
var twilioSID := iniFile.ReadString('Twilio', 'AccountSID', '');
if twilioSID.IsEmpty then
Logger.Log(1, 'Twilio->AccountSID: Entry not found')
else
Logger.Log(1, 'Twilio->AccountSID Found');
var twilioAuth := iniFile.ReadString('Twilio', 'AuthHeader', '');
if twilioAuth.IsEmpty then
Logger.Log(1, 'Twilio->AuthHeader: Entry not found')
else
Logger.Log(1, 'Twilio->AuthHeader Found');
finally
iniFile.Free;
end;
end;
procedure TAuthDatabase.DataModuleDestroy(Sender: TObject);
begin
ucEnvoy.Connected := false;
ucBooking.Connected := false;
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' );
userInfo := TStringList.Create;
try
userInfo.Delimiter := '&';
userInfo.StrictDelimiter := True;
userInfo.DelimitedText := userStr;
username := userInfo.Values['username'];
fullname := userInfo.Values['fullname'];
agency := userInfo.Values['agency'];
userid := userInfo.Values['userId'];
personnelid := userInfo.Values['personnelid'];
if ServerConfig.auditEnabled then
begin
auditMasterId := GetNextSeqVal( uqMisc, 'SEQ_AUDIT_MASTERID' );
SetMasterAuditEntry( uq, auditMasterId, 'BKG', '', agency, personnelid, fullname, 'Login', '', 'webCharms' );
end
else
begin
Logger.Log( 3, 'SetSearchAuditEntry->SetMasterAuditEntry - auditEnabled = false' );
end;
finally
userInfo.Free;
end;
end;
end.
object AuthServerModule: TAuthServerModule
Height = 273
Width = 230
object SparkleHttpSysDispatcher: TSparkleHttpSysDispatcher
Left = 88
Top = 16
end
object XDataServer: TXDataServer
Dispatcher = SparkleHttpSysDispatcher
ModelName = 'Auth'
EntitySetPermissions = <>
SwaggerOptions.Enabled = True
SwaggerUIOptions.Enabled = True
SwaggerUIOptions.ShowFilter = True
SwaggerUIOptions.TryItOutEnabled = True
Left = 91
Top = 92
object XDataServerLogging: TSparkleGenericMiddleware
OnMiddlewareCreate = XDataServerLoggingMiddlewareCreate
end
object XDataServerCORS: TSparkleCorsMiddleware
end
object XDataServerCompress: TSparkleCompressMiddleware
end
end
end
unit Auth.Server.Module;
interface
uses
System.SysUtils, System.Classes, System.Generics.Collections,
Aurelius.Comp.Connection,
Aurelius.Drivers.Interfaces,
XData.Aurelius.ConnectionPool, XData.Server.Module, XData.Comp.ConnectionPool,
Sparkle.Comp.Server, Sparkle.Comp.JwtMiddleware, XData.Comp.Server,
Sparkle.Comp.HttpSysDispatcher, Sparkle.Comp.CompressMiddleware,
Sparkle.Comp.CorsMiddleware, Sparkle.HttpServer.Module,
Sparkle.HttpServer.Context, Sparkle.Comp.GenericMiddleware;
type
TAuthServerModule = class(TDataModule)
SparkleHttpSysDispatcher: TSparkleHttpSysDispatcher;
XDataServer: TXDataServer;
XDataServerLogging: TSparkleGenericMiddleware;
XDataServerCORS: TSparkleCorsMiddleware;
XDataServerCompress: TSparkleCompressMiddleware;
procedure XDataServerLoggingMiddlewareCreate(Sender: TObject;
var Middleware: IHttpServerMiddleware);
private
{ Private declarations }
public
{ Public declarations }
procedure StartAuthServer(ABaseUrl: string; AModelName: string);
end;
const
SERVER_PATH_SEGMENT = 'auth';
var
AuthServerModule: TAuthServerModule;
implementation
uses
Sparkle.Middleware.Cors,
Sparkle.Middleware.Compress,
XData.OpenApi.Service,
Common.Logging,
Common.Middleware.Logging;
{%CLASSGROUP 'Vcl.Controls.TControl'}
{$R *.dfm}
{ TAuthServerModule }
procedure TAuthServerModule.StartAuthServer(ABaseUrl: string;
AModelName: string);
var
Url: string;
begin
RegisterOpenApiService;
Url := ABaseUrl;
if not Url.EndsWith('/') then
Url := Url + '/';
Url := Url + SERVER_PATH_SEGMENT;
XDataServer.BaseUrl := Url;
XDataServer.ModelName := AModelName;
SparkleHttpSysDispatcher.Start;
Logger.Log(1, Format('Auth server module listening at "%s"', [Url]));
end;
procedure TAuthServerModule.XDataServerLoggingMiddlewareCreate(Sender: TObject;
var Middleware: IHttpServerMiddleware);
begin
Middleware := TLoggingMiddleware.Create(Logger);
end;
end.
unit Auth.Service;
interface
uses
XData.Service.Common,
Aurelius.Mapping.Attributes,
System.Generics.Collections,
System.JSON;
const
AUTH_MODEL = 'Auth';
type
TAgencyItem = class
public
agency: String;
constructor Create( AAgency : String );
end;
TAgenciesList = class
public
count: integer;
returned: integer;
data: TList<TAgencyItem>;
end;
TAgencyConfigItem = class
public
id: integer;
agency: String;
name: String;
end;
TAgencyConfigList = class
public
count: integer;
returned: integer;
data: TList<TAgencyConfigItem>;
end;
[ServiceContract, Model(AUTH_MODEL)]
IAuthService = interface(IInvokable)
['{D2290B28-964C-4155-A83A-DAE87C4C7FE7}']
function Login(const user, password, agency: string): string;
[HttpGet] function GetAgenciesList(): TAgenciesList;
[HttpGet] function GetAgencyConfigList: TAgencyConfigList;
function VerifyVersion(ClientVersion: string): TJSONObject;
end;
implementation
{ TAgencyItem }
constructor TAgencyItem.Create(AAgency: String);
begin
agency := AAgency;
end;
end.
constructor TAgencyItem.Create(AAgency: String);
begin
agency := AAgency;
end;
end.
unit Auth.ServiceImpl;
interface
uses
XData.Service.Common,
XData.Server.Module,
Auth.Service,
Auth.Database,
Uni, Data.DB, System.JSON, System.SysUtils, System.IOUtils, IniFiles;
type
[ServiceImplementation]
TAuthService = class(TInterfacedObject, IAuthService)
strict private
authDB: TAuthDatabase;
function GetQuery: TUniQuery;
private
userName: string;
userFullName: string;
userAgency: string;
userBadge: string;
userId: string;
userPersonnelId: string;
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
function Login(const User, Password, Agency: string): string;
function GetAgencieslist(): TAgenciesList;
function GetAgencyConfiglist: TAgencyConfigList;
end;
implementation
uses
System.DateUtils,
System.Generics.Collections,
Bcl.JOSE.Core.Builder,
Bcl.JOSE.Core.JWT,
Aurelius.Global.Utils,
XData.Sys.Exceptions,
Common.Logging,
Common.Config;
{ TAuthService }
procedure TAuthService.AfterConstruction;
begin
inherited;
authDB := TAuthDatabase.Create(nil);
end;
procedure TAuthService.BeforeDestruction;
begin
authDB.Free;
inherited;
end;
function TAuthService.GetQuery: TUniQuery;
begin
Result := authDB.uq;
end;
function TAuthService.GetAgenciesList: TAgenciesList;
var
agency: TAgencyItem;
begin
Logger.Log(2, 'TAuthService.GetAgenciesList - call');
if authDB.ucBooking.Connected then
begin
authDB.uqBooking.Close;
authDB.uqBooking.SQL.Text := 'select * from agencies order by agency';
authDB.uqBooking.Open;
Result := TAgenciesList.Create;
Result.data := TList<TAgencyItem>.Create;
TXDataOperationContext.Current.Handler.ManagedObjects.Add(Result.data);
while not authDB.uqBooking.Eof do
begin
agency := TAgencyItem.Create(authDB.uqBooking.FieldByName('agency').AsString);
TXDataOperationContext.Current.Handler.ManagedObjects.Add(agency);
Result.Data.Add(agency);
authDB.uqBooking.Next;
end;
authDB.uqBooking.Close;
Result.count := Result.data.count;
Result.returned := Result.data.count;
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!');
end;
end;
function TAuthService.GetAgencyConfigList: TAgencyConfigList;
var
agencyConfig: TAgencyConfigItem;
sql: string;
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;
Result := TAgencyConfigList.Create;
Result.data := TList<TAgencyConfigItem>.Create;
TXDataOperationContext.Current.Handler.ManagedObjects.Add(Result.data);
while not authDB.uqBooking.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;
end;
authDB.uqBooking.Close;
Result.count := Result.data.Count;
Result.returned := Result.data.Count;
Logger.Log(2, 'GetAgencyConfigList - ' + IntToStr(Result.Count));
end;
function TAuthService.VerifyVersion(ClientVersion: string): TJSONObject;
var
iniFile: TIniFile;
webClientVersion: string;
begin
Logger.Log(3, 'AuthService.VerifyVersion called');
Result := TJSONObject.Create;
TXDataOperationContext.Current.Handler.ManagedObjects.Add(Result);
iniFile := TIniFile.Create(ChangeFileExt(ParamStr(0), '.ini'));
try
webClientVersion := iniFile.ReadString('Settings', 'webClientVersion', '');
Result.AddPair('webClientVersion', webClientVersion);
if webClientVersion = '' then
begin
Logger.Log(2, 'AuthService.VerifyVersion: webClientVersion not configured');
Result.AddPair('error', 'webClientVersion is not configured.');
Exit;
end;
if clientVersion <> webClientVersion then
begin
Logger.Log(2, 'AuthService.VerifyVersion: client version mismatch');
Result.AddPair('error',
'Your browser is running an old version of the app.' + sLineBreak +
'Please click below to reload.');
end
else
Logger.Log(3, 'AuthService.VerifyVersion: version check passed');
finally
iniFile.Free;
end;
end;
function TAuthService.Login(const User, Password, Agency: string): string;
var
userState: Integer;
JWT: TJWT;
begin
Logger.Log(1, Format('AuthService.Login - User: "%s" Agency: "%s"', [User, Agency]));
userState := CheckUser(User, Password, Agency);
if userState = 0 then
raise EXDataHttpUnauthorized.Create('Invalid user or password');
if userState = 1 then
raise EXDataHttpUnauthorized.Create('User not active!');
JWT := TJWT.Create;
try
JWT.Claims.JWTId := LowerCase(Copy(TUtils.GuidToVariant(TUtils.NewGuid), 2, 36));
JWT.Claims.IssuedAt := Now;
JWT.Claims.Expiration := IncHour(Now, 24);
JWT.Claims.SetClaimOfType<string>('user_name', userName);
JWT.Claims.SetClaimOfType<string>('user_fullname', userFullName);
JWT.Claims.SetClaimOfType<string>('user_agency', userAgency);
JWT.Claims.SetClaimOfType<string>('user_badge', userBadge);
JWT.Claims.SetClaimOfType<string>('user_id', userId);
JWT.Claims.SetClaimOfType<string>('user_personnelid', userPersonnelId);
Result := TJOSE.SHA256CompactToken(ServerConfig.jwtTokenSecret, JWT);
finally
JWT.Free;
end;
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;
if authDB.uqBooking.IsEmpty then
Result := 0
else
begin
if authDB.uqBooking.FieldByName('active').AsString = 'F' then
Result := 1
else
begin
decryptedPassword := Uppercase(Trim(Decrypt(authDB.uqBooking.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;
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;
function TAuthService.Decrypt(inStr, keyStr: AnsiString): AnsiString;
var
outStr: AnsiString;
k, i: integer;
tempKeyStr: AnsiString;
begin
k := Integer(inStr[1]);
tempKeyStr := keyStr;
while Length(tempKeyStr) < 256 do
tempKeyStr := tempKeyStr + tempKeyStr;
for i := 1 to Length(inStr) - 1 do
begin
k := (k + i) mod 256;
outStr := outStr + AnsiChar(Integer(inStr[i+1]) xor Integer(tempKeyStr[k+1]));
end;
Result := Trim(outStr);
end;
initialization
RegisterServiceType(TAuthService);
end.
unit Common.Config;
interface
const
defaultServerUrl = 'http://localhost:2009/emiMobile/';
type
TServerConfig = class
private
Furl: string;
FJWTTokenSecret: string;
FAdminPassword: string;
FWebAppFolder: string;
FReportsFolder: string;
FMemoLogLevel: Integer;
FFileLogLevel: Integer;
FAuditEnabled: Boolean;
public
constructor Create;
property url: string read FUrl write FUrl;
property jwtTokenSecret: string read FJWTTokenSecret write FJWTTokenSecret;
property adminPassword: string read FAdminPassword write FAdminPassword;
property webAppFolder: string read FWebAppFolder write FWebAppFolder;
property reportsFolder: string read FReportsFolder write FReportsFolder;
property auditEnabled: Boolean read FAuditEnabled write FAuditEnabled;
property memoLogLevel: Integer read FMemoLogLevel write FMemoLogLevel;
property fileLogLevel: Integer read FFileLogLevel write FFileLogLevel;
end;
procedure LoadServerConfig;
var
serverConfig: TServerConfig;
implementation
uses
Bcl.Json, System.SysUtils, System.IOUtils, System.StrUtils,
Common.Logging;
procedure LoadServerConfig;
var
configFile: string;
localConfig: TServerConfig;
begin
Logger.Log(1, '--LoadServerConfig - start');
configFile := TPath.ChangeExtension(ParamStr(0), '.json');
Logger.Log(1, '-- Config file: ' + configFile);
if TFile.Exists(configFile) then
begin
Logger.Log(1, '-- Config file found.');
localConfig := TJson.Deserialize<TServerConfig>(TFile.ReadAllText(configFile));
Logger.Log(1, '-- localConfig loaded from config file');
serverConfig.Free;
Logger.Log(1, '-- serverConfig.Free - called');
serverConfig := localConfig;
Logger.Log(1, '-- serverConfig := localConfig - called');
Logger.Log(1, '');
Logger.Log(1, '--- Server Config Values ---');
Logger.Log(1, '-- url: ' + serverConfig.url + IfThen(serverConfig.url = defaultServerUrl, ' [default]', ' [from config]'));
Logger.Log(1, '-- adminPassword: ' + serverConfig.adminPassword + IfThen(serverConfig.adminPassword = 'whatisthisusedfor', ' [default]', ' [from config]'));
Logger.Log(1, '-- jwtTokenSecret: ' + serverConfig.jwtTokenSecret + IfThen(serverConfig.jwtTokenSecret = 'super_secret0123super_secret4567', ' [default]', ' [from config]'));
Logger.Log(1, '-- webAppFolder: ' + serverConfig.webAppFolder + IfThen(serverConfig.webAppFolder = 'static', ' [default]', ' [from config]'));
Logger.Log(1, '-- memoLogLevel: ' + IntToStr(serverConfig.memoLogLevel));
Logger.Log(1, '-- fileLogLevel: ' + IntToStr(serverConfig.fileLogLevel));
Logger.Log(1, '-- auditEnabled: ' + BoolToStr(serverConfig.auditEnabled, True));
end
else
begin
Logger.Log(1, '-- Config file not found.');
end;
Logger.Log(1, '-------------------------------------------------------------');
Logger.Log(1, '--LoadServerConfig - end');
end;
{ TServerConfig }
constructor TServerConfig.Create;
begin
Logger.Log(1, '--TServerConfig.Create - start');
url := defaultServerUrl;
adminPassword := 'whatisthisusedfor';
jwtTokenSecret := 'super_secret0123super_secret4567';
webAppFolder := 'static';
reportsFolder := 'reports';
memoLogLevel := 3;
fileLogLevel := 4;
auditEnabled := False;
Logger.Log(1, '--TServerConfig.Create - end');
end;
end.
unit Common.Ini;
interface
uses
System.SysUtils, System.IniFiles, Vcl.Forms;
type
TIniEntries = class
private
// [Settings]
FMemoLogLevel: Integer;
FMemoLogLevelFromIni: Boolean;
FFileLogLevel: Integer;
FFileLogLevelFromIni: Boolean;
FLogFileNum: Integer;
FLogFileNumFromIni: Boolean;
FEmailPolling: Boolean;
FEmailPollingFromIni: Boolean;
FEmailPollingInterval: Integer;
FEmailPollingIntervalFromIni: Boolean;
FWebClientVersion: string;
FWebClientVersionFromIni: Boolean;
FTwilioUpdateTime: Integer;
FTwilioUpdateTimeFromIni: Boolean;
// [Database]
FDatabaseServer: string;
FDatabaseServerFromIni: Boolean;
FDatabaseName: string;
FDatabaseNameFromIni: Boolean;
FDatabaseUsername: string;
FDatabaseUsernameFromIni: Boolean;
FDatabasePassword: string;
FDatabasePasswordFromIni: Boolean;
// [Twilio]
FTwilioSID: string;
FTwilioSIDFromIni: Boolean;
FTwilioAuthHeader: string;
FTwilioAuthHeaderFromIni: Boolean;
public
constructor Create;
// [Settings]
property MemoLogLevel: Integer read FMemoLogLevel;
property MemoLogLevelFromIni: Boolean read FMemoLogLevelFromIni;
property FileLogLevel: Integer read FFileLogLevel;
property FileLogLevelFromIni: Boolean read FFileLogLevelFromIni;
property LogFileNum: Integer read FLogFileNum;
property LogFileNumFromIni: Boolean read FLogFileNumFromIni;
property EmailPolling: Boolean read FEmailPolling;
property EmailPollingFromIni: Boolean read FEmailPollingFromIni;
property EmailPollingInterval: Integer read FEmailPollingInterval;
property EmailPollingIntervalFromIni: Boolean read FEmailPollingIntervalFromIni;
property WebClientVersion: string read FWebClientVersion;
property WebClientVersionFromIni: Boolean read FWebClientVersionFromIni;
property TwilioUpdateTime: Integer read FTwilioUpdateTime;
property TwilioUpdateTimeFromIni: Boolean read FTwilioUpdateTimeFromIni;
// [Database]
property DatabaseServer: string read FDatabaseServer;
property DatabaseServerFromIni: Boolean read FDatabaseServerFromIni;
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;
// [Twilio]
property TwilioSID: string read FTwilioSID;
property TwilioSIDFromIni: Boolean read FTwilioSIDFromIni;
property TwilioAuthHeader: string read FTwilioAuthHeader;
property TwilioAuthHeaderFromIni: Boolean read FTwilioAuthHeaderFromIni;
end;
procedure LoadIniEntries;
var
IniEntries: TIniEntries;
implementation
procedure LoadIniEntries;
begin
if Assigned(IniEntries) then
IniEntries.Free;
IniEntries := TIniEntries.Create;
end;
{ TIniEntries }
constructor TIniEntries.Create;
var
iniFile: TIniFile;
begin
iniFile := TIniFile.Create(ChangeFileExt(Application.ExeName, '.ini'));
try
// [Settings]
FMemoLogLevel := iniFile.ReadInteger('Settings', 'MemoLogLevel', 3);
FMemoLogLevelFromIni := iniFile.ValueExists('Settings', 'MemoLogLevel');
FFileLogLevel := iniFile.ReadInteger('Settings', 'FileLogLevel', 3);
FFileLogLevelFromIni := iniFile.ValueExists('Settings', 'FileLogLevel');
FLogFileNum := iniFile.ReadInteger('Settings', 'LogFileNum', 0);
FLogFileNumFromIni := iniFile.ValueExists('Settings', 'LogFileNum');
FEmailPolling := iniFile.ReadBool('Settings', 'EmailPolling', False);
FEmailPollingFromIni := iniFile.ValueExists('Settings', 'EmailPolling');
FEmailPollingInterval := iniFile.ReadInteger('Settings', 'EmailPollingInterval', 1);
FEmailPollingIntervalFromIni := iniFile.ValueExists('Settings', 'EmailPollingInterval');
FWebClientVersion := iniFile.ReadString('Settings', 'webClientVersion', '');
FWebClientVersionFromIni := iniFile.ValueExists('Settings', 'webClientVersion');
FTwilioUpdateTime := iniFile.ReadInteger('Settings', 'TwilioUpdateTime', 0);
FTwilioUpdateTimeFromIni := iniFile.ValueExists('Settings', 'TwilioUpdateTime');
// [Database]
FDatabaseServer := iniFile.ReadString('Database', 'Server', 'localhost');
FDatabaseServerFromIni := iniFile.ValueExists('Database', 'Server');
FDatabaseName := iniFile.ReadString('Database', 'Database', 'envoy_db');
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');
// [Twilio]
FTwilioSID := iniFile.ReadString('Twilio', 'AccountSID', '');
FTwilioSIDFromIni := iniFile.ValueExists('Twilio', 'AccountSID');
FTwilioAuthHeader := iniFile.ReadString('Twilio', 'AuthHeader', '');
FTwilioAuthHeaderFromIni := iniFile.ValueExists('Twilio', 'AuthHeader');
finally
iniFile.Free;
end;
end;
end.
unit Common.Logging;
interface
uses
Generics.Collections;
type
ILog = interface;
ILogAppender = interface;
ILogger = interface
['{4D667DD2-BE11-496B-B92A-C47E03520BD6}']
procedure Log(logLevel: integer; Msg: string); overload;
procedure Log(logLevel: integer; Log: ILog); overload;
procedure AddAppender(ALogAppender: ILogAppender);
function Appenders: TArray<ILogAppender>;
end;
ILogAppender = interface
['{A3B7D6FB-C75F-4BEF-8797-907B6FDAD5D2}']
procedure Send(logLevel: integer; Log: ILog);
end;
ILog = interface
['{8E9C6580-C099-47C0-8B1B-6D7A28EC4FA3}']
function GetMessage: string;
end;
TLogger = class( TInterfacedObject, ILogger )
strict private
FAppenders: TList<ILogAppender>;
public
constructor Create; overload;
constructor Create(ALogger: ILogger); overload;
destructor Destroy; override;
procedure Log(logLevel: integer; Msg: string); overload;
procedure Log(logLevel: integer; Log: ILog); overload;
procedure AddAppender(ALogAppender: ILogAppender);
function Appenders: TArray<ILogAppender>;
end;
TLogMessage = class( TInterfacedObject, ILog )
private
FMsg: string;
public
constructor Create(AMsg: string);
function GetMessage: string;
end;
function Logger: ILogger;
implementation
var
_Logger: ILogger;
function Logger: ILogger;
begin
Result := _Logger;
end;
{ TLogMessage }
constructor TLogMessage.Create(AMsg: string);
begin
FMsg := AMsg;
end;
function TLogMessage.GetMessage: string;
begin
Result := FMsg;
end;
{ TLogger }
procedure TLogger.AddAppender(ALogAppender: ILogAppender);
begin
FAppenders.Add(ALogAppender);
end;
function TLogger.Appenders: TArray<ILogAppender>;
var
I: integer;
begin
SetLength(Result, FAppenders.Count);
for I := 0 to FAppenders.Count - 1 do
Result[I] := FAppenders[I];
end;
constructor TLogger.Create(ALogger: ILogger);
var
Appender: ILogAppender;
begin
FAppenders := TList<ILogAppender>.Create;
if ALogger <> nil then
for Appender in ALogger.Appenders do
AddAppender(Appender);
end;
constructor TLogger.Create;
begin
Create(nil);
end;
destructor TLogger.Destroy;
begin
FAppenders.Free;
inherited;
end;
procedure TLogger.Log(logLevel: integer; Log: ILog);
var
Appender: ILogAppender;
begin
for Appender in FAppenders do
Appender.Send(logLevel, Log);
end;
procedure TLogger.Log(logLevel: integer; Msg: string);
begin
Log(logLevel, TLogMessage.Create(Msg));
end;
initialization
_Logger := TLogger.Create;
end.
unit Common.Middleware.Logging;
interface
uses
System.Classes, System.SysUtils,
Sparkle.HttpServer.Module,
Sparkle.HttpServer.Context,
Sparkle.Http.Headers,
Common.Logging;
type
TLoggingMiddleware = class(THttpServerMiddleware, IHttpServerMiddleware)
private
FLogger: ILogger;
function GetNewHttpRequestLog(Request: THttpServerRequest): ILog;
protected
procedure ProcessRequest(Context: THttpServerContext; Next: THttpServerProc); override;
public
constructor Create(ALogger: ILogger);
end;
THttpRequestLog = class( TInterfacedObject, ILog )
strict private
FMethod: string;
FUriPath: string;
FUriQuery: string;
FProtocol: string;
FRemoteIp: string;
FHeaders: string;
FContent: string;
FContentLength: Int64;
public
constructor Create(AMethod: string; AUriPath: string; AUriQuery: string;
AProtocol: string; ARemoteIp: string; AHeaders: string; AContent: string;
AContentLength: Int64);
function GetMessage: string;
end;
// THttpResponseLog = class( TInterfacedObject, ILog )
// strict private
// FMethod: string;
// FUriPath: string;
// FUriQuery: string;
// FProtocol: string;
// FRemoteIp: string;
// FHeaders: string;
// FContent: string;
// FContentLength: Int64;
// public
// constructor Create(AMethod: string; AUriPath: string; AUriQuery: string;
// AProtocol: string; ARemoteIp: string; AHeaders: string; AContent: string;
// AContentLength: Int64);
// function GetMessage: string;
// end;
implementation
{ TLoggingMiddleware }
constructor TLoggingMiddleware.Create(ALogger: ILogger);
begin
FLogger := TLogger.Create(ALogger);
end;
function TLoggingMiddleware.GetNewHttpRequestLog(
Request: THttpServerRequest): ILog;
var
Msg: TStrings;
Header: THttpHeaderInfo;
StringStream: TStringStream;
Headers, Content: string;
begin
Result := nil;
Msg := TStringList.Create;
try
if Length(Request.Headers.AllHeaders.ToArray) = 0 then
Headers := ''
else
begin
for Header in Request.Headers.AllHeaders do
Msg.Add(Header.Name + ': ' + Header.Value);
Headers := Msg.Text;
end;
finally
Msg.Free;
end;
StringStream := TStringStream.Create(Request.Content);
try
Content := StringStream.DataString
finally
StringStream.Free;
end;
Result := THttpRequestLog.Create(
Request.Method,
Request.Uri.Path,
Request.Uri.Query,
Request.Protocol,
Request.RemoteIp,
Headers,
Content,
Request.ContentLength
);
end;
procedure TLoggingMiddleware.ProcessRequest(Context: THttpServerContext;
Next: THttpServerProc);
var
RequestLogMessage: string;
begin
Context.Response.OnHeaders(
procedure(Resp: THttpServerResponse)
begin
if (Resp.StatusCode >= 400) and (Resp.StatusCode <= 499) then
FLogger.Log(5, Format('%d %s on %s', [Resp.StatusCode, Resp.StatusReason, RequestLogMessage]));
end
);
RequestLogMessage := GetNewHttpRequestLog(Context.Request).GetMessage;
FLogger.Log(5, RequestLogMessage);
Next(Context);
end;
{ THttpRequestLog }
constructor THttpRequestLog.Create(AMethod, AUriPath, AUriQuery,
AProtocol, ARemoteIp, AHeaders, AContent: string; AContentLength: Int64);
begin
FMethod := AMethod;
FUriPath := AUriPath;
FUriQuery := AUriQuery;
FProtocol := AProtocol;
FRemoteIp := ARemoteIp;
FHeaders := AHeaders;
FContent := AContent;
FContentLength := AContentLength;
end;
function THttpRequestLog.GetMessage: string;
var
Msg: TStrings;
begin
Result := '';
Msg := TStringList.Create;
try
Msg.Add(Format('%s %s %s',
[
FMethod,
FUriPath + FUriQuery,
FProtocol,
FRemoteIp
]));
// if Not FHeaders.IsEmpty then
// Msg.Add(FHeaders);
// if (Not FContent.IsEmpty) then
// Msg.Add(FContent);
Result := Trim(Msg.Text);
finally
Msg.Free;
end;
end;
end.
// Uses Twilio.Data.Module for the rest api calls. Simply for testing querys.
// Visual aspect is for testing purposes only and has no affect on the client.
// Authors:
// Cameron Hayes
// Elias Serraf
// Mac ...
unit Data;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, AdvUtil, Data.DB, Vcl.Grids, AdvObj,
BaseGrid, AdvGrid, DBAdvGrid, MemDS, DBAccess, Uni, Vcl.StdCtrls, Vcl.Mask,
vcl.wwdbedit, vcl.wwdotdot, vcl.wwdbcomb, REST.Client, REST.Types, System.JSON,
System.Generics.Collections, AdvEdit, vcl.wwdblook, vcl.wwdbdatetimepicker,
System.Hash;
type
TFData = class(TForm)
dsCalls: TDataSource;
btnFind: TButton;
Memo1: TMemo;
btnGetCalls: TButton;
txtPhoneNum: TAdvEdit;
DBAdvGrid1: TDBAdvGrid;
DBAdvGrid2: TDBAdvGrid;
dsRecordings: TDataSource;
wwlcStore: TwwDBLookupCombo;
dtpCallsDate1: TwwDBDateTimePicker;
FullUpdate: TButton;
lblStartDate: TLabel;
lblLocation: TLabel;
dtpCallsDate2: TwwDBDateTimePicker;
Label1: TLabel;
edtUsername: TEdit;
edtPassword: TEdit;
lblHash: TLabel;
btnAddUser: TButton;
lblHash2: TLabel;
uqUsers: TUniQuery;
cbAdmin: TCheckBox;
uqUsersuser_id: TLargeintField;
uqUsersusername: TStringField;
uqUserspassword: TMemoField;
uqUsersdate_created: TStringField;
uqUsersadmin: TBooleanField;
edtFullName: TEdit;
edtPhoneNumber: TEdit;
edtEmailAddress: TEdit;
uqUsersemail: TMemoField;
uqUsersphone_number: TStringField;
uqUsersfull_name: TStringField;
uqUsersactive: TBooleanField;
procedure btnFindClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure btnGetCallsClick(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FullUpdateClick(Sender: TObject);
procedure wwlcStoreCloseUp(Sender: TObject; LookupTable,
FillTable: TDataSet; modified: Boolean);
procedure btnAddUserClick(Sender: TObject);
procedure addUser();
private
{ Private declarations }
accountSID: string;
authHeader: string;
public
{ Public declarations }
end;
var
FData: TFData;
implementation
{$R *.dfm}
uses Api.Database, Twilio.Data.Module, uLibrary;
procedure TFData.FormCreate(Sender: TObject);
begin
TwilioDataModule := TTwilioDataModule.Create(Self);
end;
procedure TFData.FormDestroy(Sender: TObject);
begin
TwilioDataModule.Free;
end;
procedure TFData.FullUpdateClick(Sender: TObject);
var
count: string;
begin
count := TwilioDataModule.FullUpdate();
Memo1.Lines.Add(count);
end;
procedure TFData.wwlcStoreCloseUp(Sender: TObject; LookupTable,
FillTable: TDataSet; modified: Boolean);
begin
if wwlcStore.Text = '' then
txtPhoneNum.Text := ''
else
txtPhoneNum.Text := wwlcStore.LookupValue;
end;
procedure TFData.btnGetCallsClick(Sender: TObject);
// Gets 50 calls and adds them to the database if they havent seen an earlier call
begin
TwilioDataModule.GetCalls(txtPhoneNum.Text, 50, 0 );
end;
procedure TFData.btnAddUserClick(Sender: TObject);
var
dateCreated: TDateTime;
hashString: string;
SQL: string;
begin
addUser();
end;
procedure TFData.addUser();
var
dateCreated: TDateTime;
hashString: string;
SQL: string;
username: string;
begin
dateCreated := now;
hashString := DateTimeToStr(dateCreated) + edtPassword.Text;
lblHash.Caption := THashSHA2.GetHashString(
hashString,
THashSHA2.TSHA2Version.SHA512).ToUpper;
lblHash2.Caption := IntToStr(length(DateTimeToStr(dateCreated)));
username := edtUsername.Text;
username := username.ToLower;
SQL := 'select * from envoy.users where username = ' + QuotedStr(username);
uqUsers.Close;
uqUsers.SQL.Text := sql;
uqUsers.Open;
if uqUsers.IsEmpty then
begin
uqUsers.Insert;
uqUsersusername.AsString := username;
uqUserspassword.AsString := THashSHA2.GetHashString(hashString,
THashSHA2.TSHA2Version.SHA512).ToUpper;
uqUsersdate_created.AsString := DateTimeToStr(dateCreated);
uqUsersadmin.AsBoolean := cbAdmin.Checked;
uqUsersphone_number.AsString := edtPhoneNumber.Text;
uqUsersemail.AsString := edtEmailAddress.Text;
uqUsersfull_name.AsString := edtFullName.Text;
uqUsers.Post;
lblHash2.Caption := 'Added';
end
else
lblHash2.Caption := 'Username already taken';
end;
procedure TFData.btnFindClick(Sender: TObject);
// Retrieves calls from a specific number from the database.
// SQL: SQL statement to retrieve calls from the database
// whereSQL: where section of the SQL that is built in the function
var
SQL: string;
whereSQL: string;
begin
//TwilioDataModule.ShowCalls(txtPhoneNum.Text);
whereSQL := 'where ';
if wwlcStore.Text <> '' then
whereSQL := whereSQL + 'to_formatted = ' + QuotedStr(txtPhoneNum.Text);
if dtpCallsDate1.Text <> '' then
if whereSQL = 'where ' then
whereSQL := whereSQL + 'date_created > ' + QuotedStr(dtpCallsDate1.Text)
else
whereSQL := whereSQL + 'AND date_created > ' + QuotedStr(dtpCallsDate1.Text);
if dtpCallsDate2.Text <> '' then
if whereSQL = 'where ' then
whereSQL := whereSQL + 'date_created <= ' + QuotedStr(dtpCallsDate2.Text)
else
whereSQL := whereSQL + 'AND date_created <= ' + QuotedStr(dtpCallsDate2.Text);
if whereSQL = 'where ' then
whereSQL := '';
SQL := 'select * from envoy.calls '+ whereSQL + ' order by date_created desc';
Memo1.Lines.Add(SQL);
doQuery(TwilioDataModule.uqCalls, SQL);
DBAdvGrid1.AutoSizeColumns(true);
end;
end.
// Lookup Service interface which retrieves information from the database
// which is then sent to the client.
// Authors:
// Cameron Hayes
// Mac ...
// Elias Sarraf
unit Lookup.Service;
interface
uses
XData.Service.Common,
Aurelius.Mapping.Attributes,
System.JSON,
System.Generics.Collections,
System.Classes;
const
API_MODEL = 'Api';
type
TCallItem = class
// Class of the info we want from the database from a specific call.
// callSid: SID of the call, 34 digit string.
// fromNumber: Who the phone call was from. (xxx) xxx-xxxx
// toNumber: Who the phone call was to. (xxx) xxx-xxxx
// dateCreated: Date the phone call was created. mm/dd/yyyy hh:nn:ss am/pm
// mediaURL: Link to the recording audio
// duration: Length of the entire call and recording.
// transcription: Transcription of the recording. Not always present due to
// the call being answerered or caller did not leave a message.
public
callSid: string;
fromNumber: string;
toNumber: string;
dateCreated: string;
mediaUrl: string;
duration: string;
transcription: string;
end;
// List of call items
// count: Total amount of records that fit the SQL query
// data: List of retrieved calls
TCallList = class
public
count: integer;
data: TList<TCallItem>;
end;
TUserItem = class
public
userID: string;
username: string;
full_name: string;
phone_number: string;
email_address: string;
admin: boolean;
active: boolean;
password: string;
end;
TUserList = class
public
count: integer;
data: TList<TUserItem>;
end;
type
[ServiceContract, Model(API_MODEL)]
ILookupService = interface(IInvokable)
['{F24E1468-5279-401F-A877-CD48B44F4416}']
[HttpGet] function GetCalls(searchOptions: string): TCallList;
[HttpGet] function Search(phoneNum: string): TCallList;
[HttpGet] function GetUsers(searchOptions: string): TUserList;
function AddUser(userInfo: string): string;
function DelUser(username: string): string;
function EditUser(const editOptions: string): string;
end;
implementation
initialization
RegisterServiceType(TypeInfo(ILookupService));
end.
object FMain: TFMain
Left = 0
Top = 0
Caption = 'emiMobileServer'
ClientHeight = 597
ClientWidth = 764
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OnClose = FormClose
DesignSize = (
764
597)
TextHeight = 13
object memoInfo: TMemo
Left = 8
Top = 40
Width = 744
Height = 549
Anchors = [akLeft, akTop, akRight, akBottom]
ReadOnly = True
TabOrder = 0
end
object btnApiSwaggerUI: TButton
Left = 297
Top = 8
Width = 100
Height = 25
Caption = 'Api SwaggerUI'
TabOrder = 1
OnClick = btnApiSwaggerUIClick
end
object btnData: TButton
Left = 525
Top = 8
Width = 75
Height = 25
Caption = 'Data'
TabOrder = 2
OnClick = btnDataClick
end
object btnExit: TButton
Left = 671
Top = 8
Width = 75
Height = 25
Caption = 'Exit'
TabOrder = 3
OnClick = btnExitClick
end
object btnAuthSwaggerUI: TButton
Left = 169
Top = 8
Width = 100
Height = 25
Caption = 'Auth SwaggerUI'
TabOrder = 4
OnClick = btnAuthSwaggerUIClick
end
object initTimer: TTimer
OnTimer = initTimerTimer
Left = 58
Top = 398
end
object ExeInfo1: TExeInfo
Version = '1.6.1.1'
Left = 256
Top = 402
end
object tmrTwilio: TTimer
Enabled = False
Interval = 30000
OnTimer = tmrTwilioTimer
Left = 146
Top = 416
end
end
unit Main;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, Winapi.ShellApi,
System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs,
Vcl.StdCtrls, Vcl.ExtCtrls, System.Generics.Collections, System.IniFiles,
Auth.Service, Auth.Server.Module, Api.Server.Module, App.Server.Module,
ExeInfo, Lookup.Service;
type
TFMain = class(TForm)
memoInfo: TMemo;
btnApiSwaggerUI: TButton;
btnData: TButton;
btnExit: TButton;
initTimer: TTimer;
btnAuthSwaggerUI: TButton;
ExeInfo1: TExeInfo;
tmrTwilio: TTimer;
procedure btnApiSwaggerUIClick(Sender: TObject);
procedure btnDataClick(Sender: TObject);
procedure btnExitClick(Sender: TObject);
procedure tmrTwilioTimer(Sender: TObject);
procedure ContactFormData(AText: String);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure initTimerTimer(Sender: TObject);
procedure btnAuthSwaggerUIClick(Sender: TObject);
strict private
phoneDict: TDictionary<string, string>;
procedure StartServers;
function LogValue(const LabelName: string; const Value: string; FromIni: Boolean): string;
end;
var
FMain: TFMain;
implementation
uses
Common.Logging,
Common.Config,
Common.Ini,
Sparkle.Utils,
Data, Twilio.Data.Module, Api.Database, System.StrUtils;
{$R *.dfm}
{ --- Event Handlers --- }
procedure TFMain.btnExitClick(Sender: TObject);
begin
Close;
end;
procedure TFMain.btnApiSwaggerUIClick(Sender: TObject);
begin
ShellExecute(Handle, 'open', PChar(TSparkleUtils.CombineUrlFast(ApiServerModule.XDataServer1.BaseUrl, 'swaggerui')), nil, nil, SW_SHOWNORMAL);
end;
procedure TFMain.btnAuthSwaggerUIClick(Sender: TObject);
begin
ShellExecute(Handle, 'open', PChar(TSparkleUtils.CombineUrlFast(AuthServerModule.XDataServer.BaseUrl, 'swaggerui')), nil, nil, SW_SHOWNORMAL);
end;
procedure TFMain.btnDataClick(Sender: TObject);
begin
FData := TFData.Create(Self);
FData.ShowModal;
FData.Free;
end;
procedure TFMain.ContactFormData(AText: String);
begin
if memoInfo.CanFocus then
TThread.Queue(nil, procedure begin memoInfo.Lines.Add(AText); end)
else
TThread.Synchronize(nil, procedure begin memoInfo.Lines.Add(AText); end);
end;
procedure TFMain.initTimerTimer(Sender: TObject);
begin
initTimer.Enabled := False;
Caption := Caption + ' ver ' + ExeInfo1.FileVersion;
ServerConfig := TServerConfig.Create;
LoadIniEntries;
LoadServerConfig;
StartServers;
end;
procedure TFMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
phoneDict.Free;
ServerConfig.Free;
IniEntries.Free;
AuthServerModule.Free;
ApiServerModule.Free;
AppServerModule.Free;
end;
{ --- Helpers --- }
function TFMain.LogValue(const LabelName: string; const Value: string; FromIni: Boolean): string;
begin
Result := LabelName + ': ' + Value + IfThen(FromIni, ' [from ini]', ' [default]');
end;
procedure TFMain.StartServers;
begin
Logger.Log(1, '');
Logger.Log(1, '*******************************************************');
Logger.Log(1, '* emiMobile Server *');
Logger.Log(1, Format('* Version: %s', [FMain.ExeInfo1.FileVersion]));
Logger.Log(1, '* Developed by EM Systems, Inc. *');
Logger.Log(1, '*******************************************************');
Logger.Log(1, '');
Logger.Log(1, '--- Settings ---');
Logger.Log(1, LogValue('--Settings->LogFileNum', IniEntries.LogFileNum.ToString, IniEntries.LogFileNumFromIni));
Logger.Log(1, LogValue('--Settings->webClientVersion', IniEntries.WebClientVersion, IniEntries.WebClientVersionFromIni));
Logger.Log(1, LogValue('--Settings->TwilioUpdateTime', IniEntries.TwilioUpdateTime.ToString, IniEntries.TwilioUpdateTimeFromIni));
Logger.Log(1, '');
Logger.Log(1, '--- Database ---');
Logger.Log(1, LogValue('--Database->Server', IniEntries.DatabaseServer, IniEntries.DatabaseServerFromIni));
Logger.Log(1, LogValue('--Database->Database', IniEntries.DatabaseName, IniEntries.DatabaseNameFromIni));
Logger.Log(1, LogValue('--Database->Username', IniEntries.DatabaseUsername, IniEntries.DatabaseUsernameFromIni));
Logger.Log(1, LogValue('--Database->Password', IniEntries.DatabasePassword, IniEntries.DatabasePasswordFromIni));
Logger.Log(1, '');
Logger.Log(1, '--- Twilio ---');
Logger.Log(1, LogValue('--Twilio->AccountSID', IniEntries.TwilioSID, IniEntries.TwilioSIDFromIni));
Logger.Log(1, LogValue('--Twilio->AuthHeader', IniEntries.TwilioAuthHeader, IniEntries.TwilioAuthHeaderFromIni));
Logger.Log(1, '');
try
AuthServerModule := TAuthServerModule.Create(Self);
AuthServerModule.StartAuthServer(ServerConfig.url, AUTH_MODEL);
ApiServerModule := TApiServerModule.Create(Self);
ApiServerModule.StartApiServer(ServerConfig.url, API_MODEL);
AppServerModule := TAppServerModule.Create(Self);
AppServerModule.StartAppServer(ServerConfig.url);
if IniEntries.TwilioUpdateTime > 0 then
begin
TwilioDataModule := TTwilioDataModule.Create(Self);
tmrTwilio.Interval := IniEntries.TwilioUpdateTime * 60000;
tmrTwilio.Enabled := True;
Logger.Log(1, Format('Twilio polling enabled every %d minutes.', [IniEntries.TwilioUpdateTime]));
end
else
begin
tmrTwilio.Enabled := False;
Logger.Log(1, 'Twilio polling disabled (TwilioUpdateTime = 0)');
end;
except
on E: Exception do
Logger.Log(2, 'Failed to start server modules: ' + E.Message);
end;
end;
procedure TFMain.tmrTwilioTimer(Sender: TObject);
begin
tmrTwilio.Enabled := False;
Logger.Log(4, 'tmrTwilioTimer ---start');
TwilioDataModule := TTwilioDataModule.Create(Self);
TwilioDataModule.UpdateDB;
TwilioDataModule.Free;
Logger.Log(4, 'tmrTwilioTimer ---end (interval: ' + tmrTwilio.Interval.ToString + ' ms)');
tmrTwilio.Enabled := True;
end;
end.
object TwilioDataModule: TTwilioDataModule
OnCreate = DataModuleCreate
OnDestroy = DataModuleDestroy
Height = 338
Width = 537
object ucEnvoy: TUniConnection
ProviderName = 'PostgreSQL'
SpecificOptions.Strings = (
'PostgreSQL.Schema=envoy')
LoginPrompt = False
Left = 65
Top = 89
end
object PostgreSQLUniProvider1: TPostgreSQLUniProvider
Left = 226
Top = 88
end
object UniQuery1: TUniQuery
Connection = ucEnvoy
SQL.Strings = (
'')
Left = 361
Top = 88
end
object uqLocations: TUniQuery
Connection = ucEnvoy
SQL.Strings = (
'select * from locations')
Left = 130
Top = 172
object uqLocationslocation: TStringField
DisplayWidth = 30
FieldName = 'location'
Required = True
Size = 30
end
object uqLocationsphone_number: TStringField
DisplayWidth = 14
FieldName = 'phone_number'
Required = True
Visible = False
Size = 14
end
object uqLocationsphone_number_formatted: TStringField
FieldName = 'phone_number_formatted'
Size = 14
end
end
object uqRecordings: TUniQuery
Connection = ucEnvoy
SQL.Strings = (
'select * from recordings')
Left = 224
Top = 174
object uqRecordingsaccount_sid: TStringField
FieldName = 'account_sid'
Size = 34
end
object uqRecordingsapi_version: TStringField
FieldName = 'api_version'
Size = 10
end
object uqRecordingscall_sid: TStringField
FieldName = 'call_sid'
Size = 34
end
object uqRecordingsconference_sid: TStringField
FieldName = 'conference_sid'
Size = 34
end
object uqRecordingsdate_created: TDateTimeField
FieldName = 'date_created'
end
object uqRecordingsdate_updated: TDateTimeField
FieldName = 'date_updated'
end
object uqRecordingsstart_time: TDateTimeField
FieldName = 'start_time'
end
object uqRecordingsduration: TStringField
FieldName = 'duration'
Size = 4
end
object uqRecordingssid: TStringField
FieldName = 'sid'
Required = True
Size = 34
end
object uqRecordingsprice: TStringField
FieldName = 'price'
Size = 8
end
object uqRecordingsprice_unit: TStringField
FieldName = 'price_unit'
Size = 3
end
object uqRecordingsstatus: TStringField
FieldName = 'status'
Size = 10
end
object uqRecordingschannels: TStringField
FieldName = 'channels'
Size = 1
end
object uqRecordingssource: TStringField
FieldName = 'source'
Size = 10
end
object uqRecordingserror_code: TStringField
FieldName = 'error_code'
Size = 5
end
object uqRecordingsuri: TStringField
FieldName = 'uri'
Size = 106
end
object uqRecordingsencryption_details: TStringField
FieldName = 'encryption_details'
Size = 30
end
object uqRecordingsmedia_url: TStringField
FieldName = 'media_url'
Size = 123
end
object uqRecordingstranscription: TMemoField
FieldName = 'transcription'
BlobType = ftMemo
end
end
object uqCalls: TUniQuery
Connection = ucEnvoy
SQL.Strings = (
'select * from calls')
Left = 323
Top = 176
object uqCallsdate_updated: TDateTimeField
FieldName = 'date_updated'
end
object uqCallsprice_unit: TStringField
FieldName = 'price_unit'
Size = 3
end
object uqCallsparent_call_sid: TStringField
FieldName = 'parent_call_sid'
Size = 34
end
object uqCallscaller_name: TStringField
FieldName = 'caller_name'
Size = 30
end
object uqCallsduration: TStringField
FieldName = 'duration'
Size = 4
end
object uqCallsannotation: TMemoField
FieldName = 'annotation'
BlobType = ftMemo
end
object uqCallsanswered_by: TStringField
FieldName = 'answered_by'
Size = 30
end
object uqCallssid: TStringField
FieldName = 'sid'
Required = True
Size = 34
end
object uqCallsqueue_time: TStringField
FieldName = 'queue_time'
Size = 4
end
object uqCallsprice: TStringField
FieldName = 'price'
Size = 8
end
object uqCallsapi_version: TStringField
FieldName = 'api_version'
Size = 10
end
object uqCallsstatus: TStringField
FieldName = 'status'
Size = 10
end
object uqCallsdirection: TStringField
FieldName = 'direction'
Size = 8
end
object uqCallsstart_time: TDateTimeField
FieldName = 'start_time'
end
object uqCallsdate_created: TDateTimeField
FieldName = 'date_created'
end
object uqCallsfrom_formatted: TStringField
FieldName = 'from_formatted'
Size = 13
end
object uqCallsgroup_sid: TStringField
FieldName = 'group_sid'
Size = 34
end
object uqCallstrunk_sid: TStringField
FieldName = 'trunk_sid'
Size = 34
end
object uqCallsuri: TStringField
FieldName = 'uri'
Size = 101
end
object uqCallsaccount_sid: TStringField
FieldName = 'account_sid'
Size = 34
end
object uqCallsend_time: TDateTimeField
FieldName = 'end_time'
end
object uqCallsto_formatted: TStringField
FieldName = 'to_formatted'
Size = 13
end
object uqCallsphone_number_sid: TStringField
FieldName = 'phone_number_sid'
Size = 34
end
object uqCallsforwarded_from: TStringField
FieldName = 'forwarded_from'
Size = 12
end
end
end
unit uLibrary;
interface
uses
System.Classes, Uni;
const
ADD_REC_AUDIT_ENTRY = '0';
EDIT_REC_AUDIT_ENTRY = '1';
DEL_REC_AUDIT_ENTRY = '2';
REVIEW_REC_AUDIT_ENTRY = '3';
VIEW_REC_AUDIT_ENTRY = '4';
FIND_REC_AUDIT_ENTRY = '5';
PRINT_REC_AUDIT_ENTRY = '6';
OTHER_REC_AUDIT_ENTRY = '99';
function GetServerTimeStamp( uq: TUniQuery ): TDateTime;
procedure DoQuery( uq: TUniQuery; sql: string );
function CalculateAge( const dob, dt: TDateTime ): Integer;
function GetNextSeqVal( uq: TUniQuery; sequence: string ): string;
function FormatNamePersonnel( uq: TUniQuery; format: string ): string;
function FormatBkNum( bkNum: string ): string;
function GetAssociatedNumber( uq: TUniQuery; numberType: string ): string;
function FormatBookingAddress( uq: TUniQuery; format: string ): string;
function SetMasterAuditEntry( uq: TUniQuery; const entryId, auditType, linkId, agency, personnelId, recUser, details, searchKey, execSource: string ): Boolean;
function SetDetailAuditEntry( uq: TUniQuery; const entryId, title, auditType: string; auditList: TStringList ): Boolean;
function GetOfficerName( agency, officer: string; uq: TUniQuery ): string;
function GetRiciOfficerName( agency, officer: string; uq: TUniQuery ): string;
implementation
uses
System.SysUtils,
Data.DB;
function GetServerTimeStamp( uq: TUniQuery ): TDateTime;
var
sql: string;
serverDateTime: TDateTime;
begin
sql := 'select sysdate as currentdatetime from dual';
DoQuery( uq, sql );
serverDateTime := uq.FieldByName('CURRENTDATETIME').AsDateTime;
uq.Close;
Result := serverDateTime;
end;
procedure DoQuery(uq: TUniQuery; sql: string);
begin
uq.Close;
uq.SQL.Text := sql;
uq.Open;
end;
function CalculateAge( const dob, dt: TDateTime): Integer;
var
age: Integer;
y1, m1, d1, y2, m2, d2: Word;
begin
Result := 0;
if dt < dob then
Exit;
DecodeDate( dob, y1, m1, d1);
DecodeDate( dt, y2, m2, d2);
age := y2 - y1;
// Feb 29
//if ( (m1=2) and (d1=29) ) and ( not IsLeapYear(y2) ) then
// d1 := 28;
if (m1 = 2) and (d1 = 29) and (not (IsLeapYear (y2))) then
begin
m1 := 3;
d1 := 1;
end;
if (m2 < m1) or ((m2 = m1) and (d2 < d1)) then
Dec(age);
Result := age
end;
function GetNextSeqVal(uq: TUniQuery; sequence: string ): string;
var
sql: string;
begin
sql := 'select ' + sequence + '.NEXTVAL as nextseqval from dual';
uq.Close;
uq.SQL.Text := sql;
uq.Open;
Result := uq.FieldByName('NEXTSEQVAL').AsString;
end;
function FormatNamePersonnel( uq: TUniQuery; format: string ): string;
var
leng: Integer;
i: Integer;
officerText: String;
begin
leng := Length( format );
for i := 0 to leng - 1 do
begin
case format[i+1] of
'S':
officerText := officerText + uq.FieldByName('PF_LNAME').AsString;
'F':
if not uq.FieldByName('PF_FNAME').AsString.IsEmpty then
officerText := TrimRight( officerText + uq.FieldByName('PF_FNAME').AsString ) ;
'M':
if not uq.FieldByName('PF_MI').AsString.IsEmpty then
officerText := TrimRight( officerText + uq.FieldByName('PF_MI').AsString );
',':
officerText := officerText + ',';
'.':
officerText := officerText + '.';
' ':
officerText := officerText + ' ';
end;
end;
Result := officerText;
end;
function FormatBkNum( bkNum: string ): string;
var
bkNumStr: string;
begin
bkNumStr := bkNum;
Result := bkNumStr.Insert( 4, '-' );
end;
function GetAssociatedNumber( uq: TUniQuery; numberType: string): string;
var
TLocateOptions: set of TLocateOption;
begin
if uq.Locate('OTHER_AGENCY_CODE', numberType, TLocateOptions)
then Result := uq.FieldByName('IDENTIFICATION').AsString
end;
function FormatBookingAddress( uq: TUniQuery; format: string ): string;
var
addressText: AnsiString;
leng: Integer;
i : Integer;
begin
leng := Length( format );
for i := 0 to leng - 1 do
begin
case format[i+1] of
'S':
begin
addressText := addressText + uq.FieldByName('STREET_NUM').AsString;
if uq.FieldByName('STREET_NUM_HALF').AsString = 'Y' then
addressText := addressText + ' 1/2';
if uq.FieldByName('STREET_DIRECTION').AsString <> '' then
addressText := addressText + ' ' + uq.FieldByName('STREET_DIRECTION').AsString;
if uq.FieldByName('STREET_NAME').AsString <> '' then
addressText := addressText + ' ' + TrimRight( uq.FieldByName('STREET_NAME').AsString );
if uq.FieldByName('STREET_TYPE').AsString <> '' then
addressText := addressText + ' ' + TrimRight( uq.FieldByName('STREET_TYPE').AsString );
if uq.FieldByName('APARTMENT_NUM').AsString <> '' then
addressText := addressText + ' APT: ' + TrimRight( uq.FieldByName('APARTMENT_NUM').AsString );
end;
'C':
if uq.FieldByName('CITY').AsString <> '' then
addressText := addressText + ' ' + TrimRight( uq.FieldByName('CITY').AsString );
'T':
if uq.FieldByName('STATE').AsString <> '' then
addressText := addressText + ' ' + TrimRight( uq.FieldByName('STATE').AsString );
'Z':
if uq.FieldByName('ZIP_CODE').AsString <> '' then
addressText := addressText + ' ' + TrimRight( uq.FieldByName('ZIP_CODE').AsString );
'R':
if uq.FieldByName('COUNTRY').AsString <> '' then
addressText := addressText + ' ' + TrimRight( uq.FieldByName('COUNTRY').AsString );
',':
addressText := addressText + ',';
'.':
addressText := addressText + '.';
' ':
addressText := addressText + ' ';
end;
end;
Result := addressText;
end;
function SetMasterAuditEntry(uq: TUniQuery; const entryId, auditType, linkId, agency, personnelId, recUser, details, searchKey, execSource: string) : Boolean;
var
sql: string;
begin
sql := 'insert into auditmaster ';
sql := sql + '( AUDITMASTERID, SOURCEID, AUDITTYPE, AGENCY, PERSONNELID, RECUSER, RECDATE, DETAILS, SEARCHKEY, EXECSRC) ';
sql := sql + 'values (';
sql := sql + entryID + ', ';
sql := sql + QuotedStr(linkID) + ', ';
sql := sql + QuotedStr(auditType) + ', ';
sql := sql + QuotedStr(agency) + ', ';
sql := sql + personnelid + ', ';
sql := sql + QuotedStr(recUser) + ', ';
sql := sql + 'sysdate, ';
sql := sql + QuotedStr(details) + ', ';
sql := sql + QuotedStr(searchKey) + ', ';
sql := sql + QuotedStr(execSource) + ')';
uq.Close;
uq.SQL.Text := sql;
uq.Execute;
uq.Close;
Result := True;
end;
function SetDetailAuditEntry(uq: TUniQuery; const entryId, title, auditType: string; auditList: TStringList) : Boolean;
var
i: Integer;
sql: string;
begin
for i := 0 to auditList.Count - 1 do
begin
sql := 'insert into auditdetail values (';
sql := sql + entryId + ', ';
sql := sql + QuotedStr( auditList.Names[i] ) + ', ';
sql := sql + QuotedStr( '' ) + ', ';
sql := sql + QuotedStr( auditList.ValueFromIndex[i] ) + ', ';
sql := sql + auditType + ')';
uq.Close;
uq.SQL.Text := sql;
uq.Execute;
uq.Close;
end;
Result := True;
end;
function GetOfficerName( agency, officer: string; uq: TUniQuery ): string;
var
sql: string;
begin
if agency.IsEmpty or officer.IsEmpty then
Exit;
sql := 'select a.agency_id, p.agency, p.pf_nameid, pf_lname, pf_fname, pf_mi, pf_badge ';
sql := sql + 'from personnel p ';
sql := sql + 'join agencycodes a on a.agency = p.agency ';
sql := sql + 'where a.agency_id = ' + agency + ' and p.pf_nameid = ' + officer;
uq.Close;
uq.SQL.Text := sql;
uq.Open;
if uq.IsEmpty then
Result := agency + '-' + officer + ': not found'
else
begin
Result := uq.FieldByName('pf_lname').AsString + ', ' + uq.FieldByName('pf_fname').AsString;
Result := Result + ' ' + uq.FieldByName('pf_mi').AsString + ' (' + uq.FieldByName('pf_badge').AsString + ')';
end;
end;
function GetRiciOfficerName( agency, officer: string; uq: TUniQuery ): string;
var
sql: string;
begin
if agency.IsEmpty or officer.IsEmpty then
Exit;
sql := 'select * from rici.officer@rici_link where agency = ' + agency + ' and empno = ' + QuotedStr(officer);
uq.Close;
uq.SQL.Text := sql;
uq.Open;
if uq.IsEmpty then
Result := agency + '-' + officer + ': not found'
else
Result := uq.FieldByName('surname').AsString + ', ' + uq.FieldByName('given1').AsString + ' (' + uq.FieldByName('empno').AsString + ')';
end;
end.
program emiMobileServer;
uses
FastMM4,
System.SyncObjs,
System.SysUtils,
Vcl.StdCtrls,
IniFiles,
Vcl.Forms,
Api.Server.Module in 'Source\Api.Server.Module.pas' {ApiServerModule: TDataModule},
Main in 'Source\Main.pas' {FMain},
Common.Logging in 'Source\Common.Logging.pas',
Data in 'Source\Data.pas' {FData},
Api.Database in 'Source\Api.Database.pas' {ApiDatabaseModule: TDataModule},
Common.Middleware.Logging in 'Source\Common.Middleware.Logging.pas',
Common.Config in 'Source\Common.Config.pas',
Auth.Server.Module in 'Source\Auth.Server.Module.pas' {AuthServerModule: TDataModule},
Auth.Database in 'Source\Auth.Database.pas' {AuthDatabase: TDataModule},
uLibrary in 'Source\uLibrary.pas',
Auth.Service in 'Source\Auth.Service.pas',
Lookup.Service in 'Source\Lookup.Service.pas',
Auth.ServiceImpl in 'Source\Auth.ServiceImpl.pas',
Lookup.ServiceImpl in 'Source\Lookup.ServiceImpl.pas',
Twilio.Data.Module in 'Source\Twilio.Data.Module.pas' {TwilioDataModule: TDataModule},
App.Server.Module in 'Source\App.Server.Module.pas' {AppServerModule: TDataModule},
Common.Ini in 'Source\Common.Ini.pas';
type
TMemoLogAppender = class( TInterfacedObject, ILogAppender )
private
FLogLevel: Integer;
FLogMemo: TMemo;
FCriticalSection: TCriticalSection;
public
constructor Create(ALogLevel: Integer; ALogMemo: TMemo);
destructor Destroy; override;
procedure Send(logLevel: Integer; Log: ILog);
end;
TFileLogAppender = class( TInterfacedObject, ILogAppender )
private
FLogLevel: Integer;
FFilename: string;
FLogDirectory: string;
FCriticalSection: TCriticalSection;
function GetLogFilePath: string;
public
constructor Create(ALogLevel: Integer; AFilename: string);
destructor Destroy; override;
procedure Send(logLevel: Integer; Log: ILog);
end;
{ TMemoLogAppender }
constructor TMemoLogAppender.Create(ALogLevel: Integer; ALogMemo: TMemo);
begin
FLogLevel := ALogLevel;
FLogMemo := ALogMemo;
FCriticalSection := TCriticalSection.Create;
end;
destructor TMemoLogAppender.Destroy;
begin
FCriticalSection.Free;
inherited;
end;
procedure TMemoLogAppender.Send(logLevel: Integer; Log: ILog);
var
FormattedMessage: string;
LogTime: TDateTime;
LogMsg: string;
begin
FCriticalSection.Acquire;
try
LogTime := Now;
FormattedMessage := FormatDateTime('[yyyy-mm-dd HH:nn:ss.zzz]', LogTime);
LogMsg := Log.GetMessage;
if LogMsg.IsEmpty then
FormattedMessage := ''
else
FormattedMessage := FormattedMessage + '[' + IntToStr(logLevel) +'] ' + LogMsg;
if logLevel <= FLogLevel then
FLogMemo.Lines.Add( FormattedMessage );
finally
FCriticalSection.Release;
end;
end;
{ TFileLogAppender }
constructor TFileLogAppender.Create(ALogLevel: integer; AFilename: string);
var
iniFile: TIniFile;
fileNum: integer;
logsDir: string;
begin
FLogLevel := ALogLevel;
FCriticalSection := TCriticalSection.Create;
FLogDirectory := ExtractFilePath(Application.ExeName) + 'logs\';
if not DirectoryExists(FLogDirectory) then
CreateDir(FLogDirectory);
iniFile := TIniFile.Create( ChangeFileExt(Application.ExeName, '.ini') );
try
fileNum := iniFile.ReadInteger( 'Settings', 'LogFileNum', 0 );
FFilename := AFilename + Format( '%.4d', [fileNum] );
iniFile.WriteInteger( 'Settings', 'LogFileNum', fileNum + 1 );
finally
iniFile.Free;
end;
end;
destructor TFileLogAppender.Destroy;
begin
FCriticalSection.Free;
inherited;
end;
function TFileLogAppender.GetLogFilePath: string;
begin
Result := FLogDirectory + FFilename + '.log';
end;
procedure TFileLogAppender.Send(logLevel: integer; Log: ILog);
var
FormattedMessage: string;
LogFile: string;
LogTime: TDateTime;
LogMsg: string;
FLogFile: TextFile;
begin
FCriticalSection.Acquire;
try
LogTime := Now;
LogFile := GetLogFilePath;
formattedMessage := FormatDateTime('[yyyy-mm-dd HH:nn:ss.zzz]', logTime);
logMsg := Log.GetMessage;
if logMsg.IsEmpty then
formattedMessage := ''
else
formattedMessage := formattedMessage + '[' + IntToStr(logLevel) +'] ' + logMsg;
try
AssignFile( FLogFile, LogFile );
if FileExists(LogFile) then
Append( FLogFile )
else
ReWrite( FLogFile );
if logLevel <= FLogLevel then
WriteLn( FLogFile, FormattedMessage );
finally
CloseFile(FLogFile);
end;
finally
FCriticalSection.Release;
end;
end;
{$R *.res}
var
iniFile: TIniFile;
memoLogLevel: Integer;
fileLogLevel: Integer;
begin
ReportMemoryLeaksOnShutdown := True;
Application.Initialize;
Application.MainFormOnTaskbar := True;
Application.CreateForm(TFMain, FMain);
iniFile := TIniFile.Create( ChangeFileExt(Application.ExeName, '.ini') );
try
memoLogLevel := IniFile.ReadInteger( 'Settings', 'MemoLogLevel', 3 );
fileLogLevel := IniFile.ReadInteger( 'Settings', 'FileLogLevel', 4 );
finally
iniFile.Free;
end;
Logger.AddAppender(TMemoLogAppender.Create( memoLogLevel, FMain.memoinfo ));
Logger.AddAppender(TFileLogAppender.Create( fileLogLevel, 'webPoliceReports' ));
Application.Run;
end.
[Settings]
LogFileNum=409
webClientVersion=0.1.0
TwilioUpdateTime=1
[Database]
Server=192.168.102.130
--Server=192.168.198.129
Database=envoy_db
Username=postgres
Password=postgreSQL
--Password=emsys01
[Twilio]
AccountSID=AC37aeef9c36a2cccbaecbadafc172b2ff
AuthHeader=Basic QUMzN2FlZWY5YzM2YTJjY2NiYWVjYmFkYWZjMTcyYjJmZjo5NzM5OTAwYTgyZmRlNjVlMzI2ODFmZjVmMmI5ZGZjZgo=
[ExpressSkins]
Version=1.0.0
Enabled=1
ShowNotifications=1
Kind=2
NativeStyle=1
ScrollbarMode=0
ScrollMode=0
SkinName=WXICompact
RenderMode=0
TouchMode=0
FormCorners=0
SkinPaletteName=Default
ShowFormShadow=2
UseSkins=1
UseImageSet=0
UseSkinsInPopupMenus=1
LightStyleMode=3
UseGlobalSkin=1
dxSkinWXI=1
dxSkinTheBezier=1
dxSkinOffice2019Colorful=1
dxSkinOffice2019Black=1
dxSkinOffice2019DarkGray=1
dxSkinOffice2019White=1
dxSkinBasic=1
dxSkinBlack=0
dxSkinBlue=0
dxSkinBlueprint=0
dxSkinCaramel=0
dxSkinCoffee=0
dxSkinDarkroom=0
dxSkinDarkSide=0
dxSkinDevExpressDarkStyle=0
dxSkinDevExpressStyle=0
dxSkinFoggy=0
dxSkinGlassOceans=0
dxSkinHighContrast=0
dxSkiniMaginary=0
dxSkinLilian=0
dxSkinLiquidSky=0
dxSkinLondonLiquidSky=0
dxSkinMcSkin=0
dxSkinMetropolis=0
dxSkinMetropolisDark=0
dxSkinMoneyTwins=0
dxSkinOffice2007Black=0
dxSkinOffice2007Blue=0
dxSkinOffice2007Green=0
dxSkinOffice2007Pink=0
dxSkinOffice2007Silver=0
dxSkinOffice2010Black=0
dxSkinOffice2010Blue=0
dxSkinOffice2010Silver=0
dxSkinOffice2013DarkGray=0
dxSkinOffice2013LightGray=0
dxSkinOffice2013White=0
dxSkinOffice2016Colorful=0
dxSkinOffice2016Dark=0
dxSkinPumpkin=0
dxSkinSeven=0
dxSkinSevenClassic=0
dxSkinSharp=0
dxSkinSharpPlus=0
dxSkinSilver=0
dxSkinSpringtime=0
dxSkinStardust=0
dxSkinSummer2008=0
dxSkinTheAsphaltWorld=0
dxSkinValentine=0
dxSkinVisualStudio2013Blue=0
dxSkinVisualStudio2013Dark=0
dxSkinVisualStudio2013Light=0
dxSkinVS2010=0
dxSkinWhiteprint=0
dxSkinXmas2008Blue=0
unit App.Config;
interface
uses
JS,
XData.Web.Connection,
XData.Web.Request,
XData.Web.Response;
type
TAppConfig = class
private
FAuthUrl: string;
FApiUrl: string;
FAppUrl: string;
public
constructor Create;
property AuthUrl: string read FAuthUrl write FAuthUrl;
property ApiUrl: string read FApiUrl write FApiUrl;
property AppUrl: string read FAppUrl write FAppUrl;
end;
TConfigLoadedProc = reference to procedure(Config: TAppConfig);
procedure LoadConfig(LoadProc: TConfigLoadedProc);
implementation
procedure LoadConfig(LoadProc: TConfigLoadedProc);
procedure OnSuccess(Response: IHttpResponse);
var
Obj: TJSObject;
Config: TAppConfig;
begin
Config := TAppConfig.Create;
try
if Response.StatusCode = 200 then
begin
Obj := TJSObject(TJSJSON.parse(Response.ContentAsText));
if JS.toString(Obj['AuthUrl']) <> '' then
Config.AuthUrl := JS.toString(Obj['AuthUrl']);
if JS.toString(Obj['ApiUrl']) <> '' then
Config.ApiUrl := JS.toString(Obj['ApiUrl']);
if JS.toString(Obj['AppUrl']) <> '' then
Config.AppUrl := JS.toString(Obj['AppUrl']);
end;
finally
LoadProc(Config);
Config.Free;
end;
end;
procedure OnError;
var
Config: TAppConfig;
begin
Config := TAppConfig.Create;
try
LoadProc(Config);
finally
Config.Free;
end;
end;
var
Conn: TXDataWebConnection;
begin
Conn := TXDataWebConnection.Create(nil);
try
Conn.SendRequest(THttpRequest.Create('config/config.json'), @OnSuccess, @OnError);
finally
Conn.Free;
end;
end;
{ TAppConfig }
constructor TAppConfig.Create;
begin
FAuthUrl := '';
FApiUrl := '';
FAppUrl := '';
end;
end.
unit App.Types;
interface
uses
Bcl.Rtti.Common;
type
TProc = reference to procedure;
TSuccessProc = reference to procedure;
TLogoutProc = reference to procedure(AMessage: string = '');
TUnauthorizedAccessProc = reference to procedure(AMessage: string);
TVersionCheckCallback = reference to procedure(Success: Boolean; ErrorMessage: string);
TListProc = reference to procedure;
TSelectProc = reference to procedure(AParam: string);
TSelectProc2 = reference to procedure(AParam: string; BParam: string);
TSelectProc3 = reference to procedure(AParam: string; BParam: string; CParam: Boolean);
TSelectProc4 = reference to procedure(AParam: string; BParam: string; CParam: string; DParam: Boolean);
TSearchProc = reference to procedure(AParam: string; BParam: string; CParam: Integer; DParam: Boolean);
TReportProc = reference to procedure(AParam: string);
implementation
end.
unit Auth.Service;
interface
uses
SysUtils, Web, JS,
XData.Web.Client;
const
TOKEN_NAME = 'WEBEMIMOBILE_TOKEN';
type
TOnLoginSuccess = reference to procedure;
TOnLoginError = reference to procedure(AMsg: string);
TOnProfileSuccess = reference to procedure;
TOnProfileError = reference to procedure(AMsg: string);
TAuthService = class
private
FClient: TXDataWebClient;
procedure SetToken(AToken: string);
procedure DeleteToken;
public
constructor Create; reintroduce;
destructor Destroy; override;
procedure Login(AUser, APassword, AAgency: string; ASuccess: TOnLoginSuccess;
AError: TOnLoginError);
procedure Logout;
function GetToken: string;
function Authenticated: Boolean;
function TokenExpirationDate: TDateTime;
function TokenExpired: Boolean;
function TokenPayload: JS.TJSObject;
end;
TJwtHelper = class
private
class function HasExpirationDate(AToken: string): Boolean;
public
class function TokenExpirationDate(AToken: string): TJSDate;
class function TokenExpired(AToken: string): Boolean;
class function DecodePayload(AToken: string): string;
end;
function AuthService: TAuthService;
implementation
uses
ConnectionModule;
var
_AuthService: TAuthService;
function AuthService: TAuthService;
begin
if not Assigned(_AuthService) then
begin
_AuthService := TAuthService.Create;
end;
Result := _AuthService;
end;
{ TAuthService }
function TAuthService.Authenticated: Boolean;
begin
Result := not isNull(window.localStorage.getItem(TOKEN_NAME)) and
(window.localStorage.getItem(TOKEN_NAME) <> '');
end;
constructor TAuthService.Create;
begin
FClient := TXDataWebClient.Create(nil);
FClient.Connection := DMConnection.AuthConnection;
end;
procedure TAuthService.DeleteToken;
begin
window.localStorage.removeItem(TOKEN_NAME);
end;
destructor TAuthService.Destroy;
begin
FClient.Free;
inherited;
end;
function TAuthService.GetToken: string;
begin
Result := window.localStorage.getItem(TOKEN_NAME);
end;
procedure TAuthService.Login(AUser, APassword, AAgency: string; ASuccess: TOnLoginSuccess;
AError: TOnLoginError);
procedure OnLoad(Response: TXDataClientResponse);
var
Token: JS.TJSObject;
begin
Token := JS.TJSObject(Response.Result);
SetToken(JS.toString(Token.Properties['value']));
ASuccess;
end;
procedure OnError(Error: TXDataClientError);
begin
AError(Format('%s: %s', [Error.ErrorCode, Error.ErrorMessage]));
end;
begin
if (AUser = '') or (APassword = '') or (AAgency = '') then
begin
AError('Please enter a username, password, and agency');
Exit;
end;
FClient.RawInvoke(
'IAuthService.Login', [AUser, APassword, AAgency],
@OnLoad, @OnError
);
end;
procedure TAuthService.Logout;
begin
DeleteToken;
end;
procedure TAuthService.SetToken(AToken: string);
begin
window.localStorage.setItem(TOKEN_NAME, AToken);
end;
function TAuthService.TokenExpirationDate: TDateTime;
var
ExpirationDate: TJSDate;
begin
if not Authenticated then
Exit(Now);
ExpirationDate := TJwtHelper.TokenExpirationDate(GetToken);
Result := EncodeDate(
ExpirationDate.FullYear,
ExpirationDate.Month + 1,
ExpirationDate.Date
) +
EncodeTime(
ExpirationDate.Hours,
ExpirationDate.Minutes,
ExpirationDate.Seconds,
0
);
end;
function TAuthService.TokenExpired: Boolean;
begin
if not Authenticated then
Exit(False);
Result := TJwtHelper.TokenExpired(GetToken);
end;
function TAuthService.TokenPayload: JS.TJSObject;
begin
if not Authenticated then
Exit(nil);
Result := TJSObject(TJSJSON.parse(TJwtHelper.DecodePayload(GetToken)));
end;
{ TJwtHelper }
class function TJwtHelper.DecodePayload(AToken: string): string;
begin
if Trim(AToken) = '' then
Exit('');
Result := '';
asm
var Token = AToken.split('.');
if (Token.length = 3) {
Result = Token[1];
Result = atob(Result);
}
end;
end;
class function TJwtHelper.HasExpirationDate(AToken: string): Boolean;
var
Payload: string;
Obj: TJSObject;
begin
Payload := DecodePayload(AToken);
Obj := TJSObject(TJSJSON.parse(Payload));
Result := Obj.hasOwnProperty('exp');
end;
class function TJwtHelper.TokenExpirationDate(AToken: string): TJSDate;
var
Payload: string;
Obj: TJSObject;
Epoch: NativeInt;
begin
if not HasExpirationDate(AToken) then
raise Exception.Create('Token has no expiration date');
Payload := DecodePayload(AToken);
Obj := TJSObject(TJSJSON.parse(Payload));
Epoch := toInteger(Obj.Properties['exp']);
Result := TJSDate.New(Epoch * 1000);
end;
class function TJwtHelper.TokenExpired(AToken: string): Boolean;
begin
if not HasExpirationDate(AToken) then
Exit(False);
Result := TJSDate.now > toInteger(TokenExpirationDate(AToken).valueOf);
end;
end.
object DMConnection: TDMConnection
Height = 302
Width = 266
object ApiConnection: TXDataWebConnection
OnError = ApiConnectionError
OnRequest = ApiConnectionRequest
OnResponse = ApiConnectionResponse
Left = 112
Top = 132
end
object AuthConnection: TXDataWebConnection
OnError = AuthConnectionError
Left = 110
Top = 68
end
object XDataWebClient1: TXDataWebClient
Connection = AuthConnection
Left = 112
Top = 200
end
end
unit ConnectionModule;
interface
uses
System.SysUtils, System.Classes, WEBLib.Modules, XData.Web.Connection,
App.Types, App.Config, XData.Web.Client;
type
TDMConnection = class(TWebDataModule)
ApiConnection: TXDataWebConnection;
AuthConnection: TXDataWebConnection;
XDataWebClient1: TXDataWebClient;
procedure ApiConnectionError(Error: TXDataWebConnectionError);
procedure ApiConnectionRequest(Args: TXDataWebConnectionRequest);
procedure ApiConnectionResponse(Args: TXDataWebConnectionResponse);
procedure AuthConnectionError(Error: TXDataWebConnectionError);
private
FUnauthorizedAccessProc: TUnauthorizedAccessProc;
public
const clientVersion = '0.1.0';
procedure InitApp(SuccessProc: TSuccessProc;
UnauthorizedAccessProc: TUnauthorizedAccessProc);
procedure SetClientConfig(Callback: TVersionCheckCallback);
end;
var
DMConnection: TDMConnection;
implementation
uses
JS, Web,
XData.Web.Request,
XData.Web.Response,
Auth.Service,
View.ErrorPage;
{%CLASSGROUP 'Vcl.Controls.TControl'}
{$R *.dfm}
procedure TDMConnection.ApiConnectionError(Error: TXDataWebConnectionError);
begin
TFViewErrorPage.DisplayConnectionError(Error);
end;
procedure TDMConnection.ApiConnectionRequest(Args: TXDataWebConnectionRequest);
begin
if AuthService.Authenticated then
Args.Request.Headers.SetValue('Authorization', 'Bearer ' + AuthService.GetToken);
end;
procedure TDMConnection.ApiConnectionResponse(
Args: TXDataWebConnectionResponse);
begin
if Args.Response.StatusCode = 401 then
FUnauthorizedAccessProc(Format('%d: %s',[Args.Response.StatusCode, Args.Response.ContentAsText]));
end;
procedure TDMConnection.AuthConnectionError(Error: TXDataWebConnectionError);
begin
TFViewErrorPage.DisplayConnectionError(Error);
end;
procedure TDMConnection.InitApp(SuccessProc: TSuccessProc;
UnauthorizedAccessProc: TUnauthorizedAccessProc);
procedure ConfigLoaded(Config: TAppConfig);
begin
if Config.AuthUrl <> '' then
AuthConnection.URL := Config.AuthUrl;
if Config.ApiUrl <> '' then
ApiConnection.URL := Config.ApiUrl;
AuthConnection.Open(SuccessProc);
end;
begin
FUnauthorizedAccessProc := UnauthorizedAccessProc;
LoadConfig(@ConfigLoaded);
end;
procedure TDMConnection.SetClientConfig(Callback: TVersionCheckCallback);
begin
XDataWebClient1.Connection := AuthConnection;
XDataWebClient1.RawInvoke('IAuthService.VerifyVersion', [clientVersion],
procedure(Response: TXDataClientResponse)
var
jsonResult: TJSObject;
error: string;
begin
jsonResult := TJSObject(Response.Result);
if jsonResult.HasOwnProperty('error') then
error := string(jsonResult['error'])
else
error := '';
if error <> '' then
Callback(False, error)
else
Callback(True, '');
end);
end;
end.
{
"AuthUrl" : "http://localhost:2009/emimobile/auth/",
"ApiUrl" : "http://localhost:2009/emimobile/api/",
"AppUrl" : "http://localhost:2009/emimobile/app/"
}
\ No newline at end of file
.login-card {
display: inline-block;
width: 300px; /* Adjust width as needed */
padding: 0;
border-radius: 10px;
box-shadow: 0 4px 8px rgba(0, 0, 0, 0.1);
background-color: #fff;
}
.card-header {
width: 100%;
text-align: left; /* Align text to the left */
background-color: #f8f9fa; /* Match the card background */
padding: 0.75rem 1.25rem;
border-bottom: 1px solid rgba(0, 0, 0, 0.125);
border-top-left-radius: 10px;
border-top-right-radius: 10px;
margin: 0; /* Remove any margin */
box-sizing: border-box; /* Ensure padding is included in the element's total width and height */
}
.mr-2 {
margin-right: 0.5rem;
}
.card-title {
margin: 0;
font-size: 1.25rem; /* Adjust font size as needed */
}
.card-body {
padding: 2rem;
}
.table tbody tr:hover {
background-color: #d1e7fd; /* Light blue color for hover effect */
cursor: pointer;
}
.form-input{
display: table;
}
.form-cells{
display: table-cell
}
.table tbody tr {
transition: background-color 0.3s ease;
}
.table {
box-shadow: 0 4px 8px rgba(0, 0, 0, 0.1);
border-radius: 5px;
}
@media (max-width: 1200px) {
.table-responsive {
display: block;
width: 100%;
overflow-x: auto;
-webkit-overflow-scrolling: touch;
}
.table thead {
display: none;
}
.table tbody, .table tr, .table td {
display: block;
width: 100%;
}
.table tr {
margin-bottom: 1rem;
}
.table td {
text-align: right;
padding-left: 50%; /* Adjust padding to accommodate the data-label */
position: relative;
}
.table td::before {
content: attr(data-label);
position: absolute;
left: 0;
width: 50%;
padding-left: 15px; /* Adjust as necessary */
font-weight: bold;
text-align: left;
}
.table td .transcript {
margin-top: 20px; /* Set top margin to 20px */
text-align: left; /* Ensure text alignment is left */
margin-left: 8px;
white-space: normal; /* Prevent text from being cut off */
}
}
.login-navbar {
max-width: 1200px; /* Set the max-width to match a medium screen */
margin: auto;
border-bottom-left-radius: 10px; /* Round the bottom left corner */
border-bottom-right-radius: 10px; /* Round the bottom right corner */
border: 1px solid #d3d3d3;
}
.navbar-toggler {
display: none;
}
.dropdown-menu a {
display: flex; /* Use flexbox for alignment */
align-items: center; /* Vertically center the content */
width: 100%; /* Ensure they take up the full width */
padding: 0.5rem 1rem; /* Add padding to make them clickable */
color: #000; /* Adjust the text color if necessary */
text-decoration: none; /* Remove underlines */
}
.dropdown-menu a:hover {
background-color: #204d74;
color: #fff;
}
.dropdown-menu a span {
flex-grow: 1; /* Make the span take up the remaining space */
}
/* Style for the selected number */
.selected-number .page-link {
background-color: #204d74;
color: #fff !important;
}
/* Style for the unselected numbers and text (previous/next) */
.pagination .page-item a,
.pagination .page-item span {
color: #204d74;
}
.pagination .page-item.active .page-link,
.pagination .page-item.active .page-link:hover,
.pagination .page-item.active .page-link:focus {
background-color: #204d74;
border-color: #204d74;
color: #fff !important;
}
/* This is needed to get rid of the line that was appearing. */
span.card {
border: none;
}
.modal-backdrop {
z-index: 1040 !important;
}
.modal {
z-index: 1055 !important;
}
unit Paginator.Plugins;
interface
uses
SysUtils, WEBLib.Lists;
type
TPaginatorPlugin = class;
TOnItemClick = reference to procedure(APaginatorPlugin: TPaginatorPlugin);
TPaginatorPlugin = class
const
VISIBLE_PAGES = 7;
ITEM_CLASS_NAME = 'pagination_button';
strict private
FPaginator: TWebListControl;
FActivePage: integer;
function CreateItem: TListItem;
procedure InitPaginator(AActivePage: Integer; APageCount: Integer;
AVisiblePages: integer);
function GetActivePage: integer;
private
FOnItemClick: TOnItemClick;
FOriginalOnItemClick: TListItemEvent;
procedure InternalItemClick(Sender: TObject; AListItem: TListItem);
public
constructor Create(APaginator: TWebListControl;
AItemClickCallback: TOnItemClick);
procedure Init(AActivePage: Integer; APageCount: Integer);
property ActivePage: Integer read GetActivePage;
end;
implementation
{ TPaginatorPlugin }
constructor TPaginatorPlugin.Create(APaginator: TWebListControl;
AItemClickCallback: TOnItemClick);
begin
FPaginator := APaginator;
FOnItemClick := AItemClickCallback;
FOriginalOnItemClick := APaginator.OnItemClick;
APaginator.OnItemClick := InternalItemClick;
end;
function TPaginatorPlugin.CreateItem: TListItem;
begin
Result := FPaginator.Items.Add;
Result.ItemClassName := ITEM_CLASS_NAME;
end;
function TPaginatorPlugin.GetActivePage: integer;
begin
Result := FActivePage;
end;
procedure TPaginatorPlugin.Init(AActivePage, APageCount: Integer);
begin
FActivePage := AActivePage;
InitPaginator(FActivePage, APageCount, VISIBLE_PAGES);
end;
procedure TPaginatorPlugin.InitPaginator(AActivePage, APageCount,
AVisiblePages: integer);
var
Item: TListItem;
I, ButtonNumber, Idx: integer;
HasLeftSeparator: Boolean;
HasRightSeparator: Boolean;
begin
FPaginator.Items.Clear;
HasLeftSeparator := (AVisiblePages < APageCount) and (AActivePage > AVisiblePages - 2);
HasRightSeparator := (AVisiblePages < APageCount) and (AActivePage < APageCount - AVisiblePages + 3);
// first page
ButtonNumber := 1;
Item := CreateItem;
Item.Active := AActivePage = 1;
Item.Text := IntToStr(ButtonNumber);
if HasLeftSeparator then
begin
Item := CreateItem;
Item.Active := False;
Item.Enabled := False;
Item.Text := '...';
end;
if HasRightSeparator and HasLeftSeparator then
begin
Idx := (AVisiblePages - 2) div 2;
for I := AActivePage - Idx to AActivePage + Idx do
begin
ButtonNumber := I;
Item := CreateItem;
Item.Active := ButtonNumber = AActivePage;
Item.Text := IntToStr(ButtonNumber);
end;
end
else
for I := 2 to AVisiblePages - 1 do
begin
if I > APageCount - 1 then
Break;
ButtonNumber := I;
if (not HasRightSeparator) and HasLeftSeparator then
ButtonNumber := APageCount - AVisiblePages + I;
Item := CreateItem;
Item.Active := ButtonNumber = AActivePage;
Item.Text := IntToStr(ButtonNumber);
end;
if APageCount > 1 then
begin
// last page
if HasRightSeparator then
begin
Item := CreateItem;
Item.Active := False;
Item.Enabled := False;
Item.Text := '...';
end;
ButtonNumber := APageCount;
Item := CreateItem;
Item.Active := AActivePage = APageCount;
Item.Text := IntToStr(ButtonNumber);
end;
end;
procedure TPaginatorPlugin.InternalItemClick(Sender: TObject;
AListItem: TListItem);
var
ActivePage: integer;
begin
if TryStrToInt(AListItem.Text, ActivePage) then
begin
FActivePage := ActivePage;
if Assigned(FOnItemClick) then
FOnItemClick(Self);
if Assigned(FOriginalOnItemClick) then
FOriginalOnItemClick(Sender, AListItem);
end;
end;
end.
unit Utils;
interface
uses
System.Classes, SysUtils, JS, Web, WEBLib.Forms, WEBLib.Toast, DateUtils, WebLib.Dialogs;
procedure ShowStatusMessage(const AMessage, AClass: string; const AElementId: string);
procedure HideStatusMessage(const AElementId: string);
procedure ShowSpinner(SpinnerID: string);
procedure HideSpinner(SpinnerID: string);
procedure ShowErrorModal(msg: string);
function CalculateAge(DateOfBirth: TDateTime): Integer;
function FormatPhoneNumber(PhoneNumber: string): string;
procedure ApplyReportTitle(CurrentReportType: string);
procedure ShowToast(const MessageText: string; const ToastType: string = 'success');
procedure ShowConfirmationModal(msg, leftLabel, rightLabel: string; ConfirmProc: TProc<Boolean>);
// function FormatDollarValue(ValueStr: string): string;
implementation
procedure ShowStatusMessage(const AMessage, AClass: string; const AElementId: string);
var
StatusMessage: TJSHTMLElement;
begin
StatusMessage := TJSHTMLElement(document.getElementById(AElementId));
if Assigned(StatusMessage) then
begin
if AMessage = '' then
begin
StatusMessage.style.setProperty('display', 'none');
StatusMessage.className := '';
StatusMessage.innerHTML := '';
end
else
begin
StatusMessage.innerHTML := AMessage;
StatusMessage.className := 'alert ' + AClass;
StatusMessage.style.setProperty('display', 'block');
end
end
else
console.log('Error: Status message element not found');
end;
procedure HideStatusMessage(const AElementId: string);
var
StatusMessage: TJSHTMLElement;
begin
StatusMessage := TJSHTMLElement(document.getElementById(AElementId));
if Assigned(StatusMessage) then
begin
StatusMessage.style.setProperty('display', 'none');
StatusMessage.className := '';
StatusMessage.innerHTML := '';
end
else
console.log('Error: Status message element not found');
end;
procedure ShowSpinner(SpinnerID: string);
var
SpinnerElement: TJSHTMLElement;
begin
SpinnerElement := TJSHTMLElement(document.getElementById(SpinnerID));
if Assigned(SpinnerElement) then
begin
// Move spinner to the <body> if it's not already there
asm
if (SpinnerElement.parentNode !== document.body) {
document.body.appendChild(SpinnerElement);
}
end;
SpinnerElement.classList.remove('d-none');
SpinnerElement.classList.add('d-block');
end;
end;
procedure HideSpinner(SpinnerID: string);
var
SpinnerElement: TJSHTMLElement;
begin
SpinnerElement := TJSHTMLElement(document.getElementById(SpinnerID));
if Assigned(SpinnerElement) then
begin
SpinnerElement.classList.remove('d-block');
SpinnerElement.classList.add('d-none');
end;
end;
procedure ShowErrorModal(msg: string);
begin
asm
var modal = document.getElementById('main_errormodal');
var label = document.getElementById('main_lblmodal_body');
var reloadBtn = document.getElementById('btn_modal_restart');
if (label) label.innerText = msg;
// Ensure modal is a direct child of <body>
if (modal && modal.parentNode !== document.body) {
document.body.appendChild(modal);
}
// Bind hard reload to button
if (reloadBtn) {
reloadBtn.onclick = function () {
window.location.reload(true); // hard reload, bypass cache
};
}
// Show the Bootstrap modal
var bsModal = new bootstrap.Modal(modal, { keyboard: false });
bsModal.show();
end;
end;
// ShowConfirmationModal displays a two-button modal with custom labels.
// Params:
// - messageText: text shown in the modal body
// - leftButtonText: label for the left button (e.g., "Cancel")
// - rightButtonText: label for the right button (e.g., "Delete")
// - callback: procedure(confirmed: Boolean); confirmed = True if right button clicked
//
// Example:
// ShowConfirmationModal('Delete this?', 'Cancel', 'Delete',
// procedure(confirmed: Boolean)
// begin
// if confirmed then DeleteOrder();
// end);
// function ShowConfirmationModal(msg, leftLabel, rightLabel: string;): Boolean;
// if ShowConfirmationModal then
// doThing()
// else
// doOtherThing();
procedure ShowConfirmationModal(msg, leftLabel, rightLabel: string; ConfirmProc: TProc<Boolean>);
begin
asm
var modal = document.getElementById('main_confirmation_modal');
var body = document.getElementById('main_modal_body');
var btnLeft = document.getElementById('btn_confirm_left');
var btnRight = document.getElementById('btn_confirm_right');
var bsModal;
if (body) body.innerText = msg;
if (btnLeft) btnLeft.innerText = leftLabel;
if (btnRight) btnRight.innerText = rightLabel;
if (modal && modal.parentNode !== document.body) {
document.body.appendChild(modal);
}
btnLeft.onclick = null;
btnRight.onclick = null;
btnLeft.onclick = function () {
bsModal.hide();
ConfirmProc(true); // user confirmed
};
btnRight.onclick = function () {
bsModal.hide();
ConfirmProc(false); // user canceled
};
bsModal = new bootstrap.Modal(modal, { keyboard: false });
bsModal.show();
end;
end;
function CalculateAge(DateOfBirth: TDateTime): Integer;
var
Today, BirthDate: TJSDate;
Year, Month, Day, BirthYear, BirthMonth, BirthDay: NativeInt;
DOBString: string;
begin
Today := TJSDate.New;
Year := Today.FullYear;
Month := Today.Month + 1;
Day := Today.Date;
// Formats the DateOfBirth as an ISO 8601 date string
DOBString := FormatDateTime('yyyy-mm-dd', DateOfBirth);
BirthDate := TJSDate.New(DOBString);
if BirthDate = nil then
begin
Exit(0); // Exit the function with an age of 0 if the date creation fails
end;
BirthYear := BirthDate.FullYear;
BirthMonth := BirthDate.Month + 1;
BirthDay := BirthDate.Date;
Result := Year - BirthYear;
if (Month < BirthMonth) or ((Month = BirthMonth) and (Day < BirthDay)) then
Dec(Result);
end;
function FormatPhoneNumber(PhoneNumber: string): string;
var
Digits: string;
begin
Digits := PhoneNumber.Replace('(', '').Replace(')', '').Replace('-', '').Replace(' ', '');
case Length(Digits) of
7: Result := Format('%s-%s', [Copy(Digits, 1, 3), Copy(Digits, 4, 4)]);
10: Result := Format('(%s) %s-%s', [Copy(Digits, 1, 3), Copy(Digits, 4, 3), Copy(Digits, 7, 4)]);
else
// If the number does not have 7 or 10 digits, whatever they typed is returned
Result := PhoneNumber;
end;
end;
procedure ShowToast(const MessageText: string; const ToastType: string = 'success');
var
ParsedText, ToastKind, MsgPrefix: string;
Parts: TArray<string>;
begin
ParsedText := MessageText.Trim;
ToastKind := ToastType.ToLower;
// Check for "Success:" or "Failure:" at the start of message
if ParsedText.Contains(':') then
begin
Parts := ParsedText.Split([':'], 2);
MsgPrefix := Parts[0].Trim.ToLower;
if (MsgPrefix = 'success') or (MsgPrefix = 'failure') then
begin
ParsedText := Parts[1].Trim;
if MsgPrefix = 'success' then
ToastKind := 'success'
else
ToastKind := 'danger';
end;
end;
asm
var toastEl = document.getElementById('bootstrapToast');
var toastBody = document.getElementById('bootstrapToastBody');
if (!toastEl || !toastBody) return;
toastBody.innerText = ParsedText;
toastEl.classList.remove('bg-success', 'bg-danger', 'bg-warning', 'bg-info');
toastEl.classList.remove('slide-in');
switch (ToastKind) {
case 'danger':
toastEl.classList.add('bg-danger');
break;
case 'warning':
toastEl.classList.add('bg-warning');
break;
case 'info':
toastEl.classList.add('bg-info');
break;
default:
toastEl.classList.add('bg-success');
}
// Add slide-in animation
toastEl.classList.add('slide-in');
var toast = new bootstrap.Toast(toastEl, { delay: 2500 });
toast.show();
// Remove animation class after it's done (so it can be reapplied)
setTimeout(function() {
toastEl.classList.remove('slide-in');
}, 500);
end;
end;
procedure ApplyReportTitle(CurrentReportType: string);
var
CrimeTitleElement: TJSHTMLElement;
begin
CrimeTitleElement := TJSHTMLElement(document.getElementById('crime_title'));
if Assigned(CrimeTitleElement) then
CrimeTitleElement.innerText := CurrentReportType
else
Console.Log('Element with ID "crime_title" not found.');
end;
// Used html number input type to restrict the input instead of this function
// function FormatDollarValue(ValueStr: string): string;
// var
// i: Integer;
// begin
// Result := ''; // Initialize the result
// // Filter out any characters that are not digits or decimal point
// for i := 1 to Length(ValueStr) do
// begin
// if (Pos(ValueStr[i], '0123456789.') > 0) then
// begin
// Result := Result + ValueStr[i];
// end;
// end;
// end;
end.
object FViewAdmin: TFViewAdmin
Width = 640
Height = 480
OnShow = WebFormShow
object lblInfo: TWebLabel
Left = 29
Top = 255
Width = 78
Height = 15
Caption = 'Add New User:'
ElementID = 'lblinfo'
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
end
object lblResult: TWebLabel
Left = 32
Top = 374
Width = 3
Height = 15
ElementID = 'lblresult'
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
end
object WebLabel1: TWebLabel
Left = 24
Top = 24
Width = 60
Height = 15
Caption = 'User Profile'
ElementID = 'view.userprofile.title'
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
end
object WebLabel3: TWebLabel
Left = 24
Top = 59
Width = 61
Height = 15
Caption = 'User Name:'
ElementID = 'view.userprofile.form.lblUserName'
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
end
object WebLabel2: TWebLabel
Left = 40
Top = 155
Width = 39
Height = 15
Caption = 'User Id:'
ElementID = 'view.userprofile.form.lblUserId'
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
end
object WebLabel4: TWebLabel
Left = 29
Top = 83
Width = 57
Height = 15
Caption = 'Full Name:'
ElementID = 'view.userprofile.form.lblFullName'
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
end
object WebLabel5: TWebLabel
Left = 39
Top = 107
Width = 43
Height = 15
Caption = 'Agency:'
ElementID = 'view.userprofile.form.lblAgency'
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
end
object WebLabel6: TWebLabel
Left = 22
Top = 131
Width = 66
Height = 15
Caption = 'Badge Num:'
ElementID = 'view.userprofile.form.lblBadgeNum'
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
end
object WebLabel7: TWebLabel
Left = 15
Top = 179
Width = 68
Height = 15
Caption = 'Personnel Id:'
ElementID = 'view.userprofile.form.lblPersonnelId'
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
end
object edtAddUsername: TWebEdit
Left = 29
Top = 276
Width = 121
Height = 22
ChildOrder = 1
ElementID = 'edtusername'
HeightPercent = 100.000000000000000000
TextHint = 'Username'
WidthPercent = 100.000000000000000000
end
object edtPassword: TWebEdit
Left = 29
Top = 310
Width = 121
Height = 22
ChildOrder = 2
ElementID = 'edtpassword'
HeightPercent = 100.000000000000000000
TextHint = 'Password'
WidthPercent = 100.000000000000000000
end
object btnAddUser: TWebButton
Left = 29
Top = 338
Width = 96
Height = 25
Caption = 'Add User'
ChildOrder = 3
ElementID = 'btnadduser'
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
OnClick = btnAddUserClick
end
object edtUsername: TWebEdit
Left = 83
Top = 56
Width = 121
Height = 21
ChildOrder = 12
ElementID = 'view.userprofile.form.edtUserName'
HeightPercent = 100.000000000000000000
ReadOnly = True
WidthPercent = 100.000000000000000000
end
object edtUserId: TWebEdit
Left = 83
Top = 152
Width = 121
Height = 21
ChildOrder = 13
ElementID = 'view.userprofile.form.edtUserId'
HeightPercent = 100.000000000000000000
ReadOnly = True
TabOrder = 1
WidthPercent = 100.000000000000000000
end
object edtFullName: TWebEdit
Left = 83
Top = 80
Width = 121
Height = 21
ChildOrder = 5
ElementID = 'view.userprofile.form.edtFullName'
HeightPercent = 100.000000000000000000
ReadOnly = True
WidthPercent = 100.000000000000000000
end
object edtAgency: TWebEdit
Left = 83
Top = 104
Width = 121
Height = 21
ChildOrder = 7
ElementID = 'view.userprofile.form.edtAgency'
HeightPercent = 100.000000000000000000
ReadOnly = True
WidthPercent = 100.000000000000000000
end
object chkAdminUser: TWebCheckBox
Left = 32
Top = 203
Width = 113
Height = 22
Caption = 'chkAdminUser'
ChildOrder = 9
ElementID = 'view.userprofile.form.chkAdminUser'
Enabled = False
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
end
object edtBadgeNum: TWebEdit
Left = 83
Top = 128
Width = 121
Height = 21
ChildOrder = 7
ElementID = 'view.userprofile.form.edtBadgeNum'
HeightPercent = 100.000000000000000000
ReadOnly = True
WidthPercent = 100.000000000000000000
end
object edtPersonnelId: TWebEdit
Left = 83
Top = 176
Width = 121
Height = 21
ChildOrder = 12
ElementID = 'view.userprofile.form.edtPersonnelId'
HeightPercent = 100.000000000000000000
ReadOnly = True
TabOrder = 1
WidthPercent = 100.000000000000000000
end
object XDataWebClient1: TXDataWebClient
Connection = DMConnection.ApiConnection
Left = 339
Top = 90
end
end
<div class="row">
<div class="col-lg-12">
<h1 class="page-header" id="view.userprofile.title">Admin User Profile</h1>
<div role="form">
<div class="form-group">
<label id="view.userprofile.form.lblUserName">User Name:</label>
<input id="view.userprofile.form.edtUserName" class="form-control">
</div>
<div class="form-group">
<label id="view.userprofile.form.lblFullName">User Fullname:</label>
<input id="view.userprofile.form.edtFullName" class="form-control">
</div>
<div class="form-group">
<label id="view.userprofile.form.lblAgency">User Agency:</label>
<input id="view.userprofile.form.edtAgency" class="form-control">
</div>
<div class="form-group">
<label id="view.userprofile.form.lblBadgeNum">User Bage #:</label>
<input id="view.userprofile.form.edtBadgeNum" class="form-control">
</div>
<div class="form-group">
<label id="view.userprofile.form.lblUserId">User Id:</label>
<input id="view.userprofile.form.edtUserId" class="form-control">
</div>
<div class="form-group">
<label id="view.userprofile.form.lblPersonnelId">Personnel Id:</label>
<input id="view.userprofile.form.edtPersonnelId" class="form-control">
</div>
<div class="custom-control custom-checkbox">
<input type="checkbox" class="custom-control-input" id="view.userprofile.form.chkAdminUser">
<label class="custom-control-label" for="view.userprofile.form.chkAdminUser">Admin User</label>
</div>
<div class="form-input">
<div><label id="lblinfo" class="py-2" style="font-size: 1.00rem;"></label></div>
<div><input class="form-control input-sm" id="edtusername" width='50%'/></div>
<div class="py-2"><input class="form-control input-sm" id="edtpassword" width='50%'/></div>
<button id="btnadduser"></button>
<div><label id="lblresult" class="py-2" style="font-size: 1.00rem;"></label></div>
</div>
</div>
</div>
</div>
// Delete this
unit View.Admin;
interface
uses
System.SysUtils, System.Classes, JS, Web, WEBLib.Graphics, WEBLib.Controls,
WEBLib.Forms, WEBLib.Dialogs, Vcl.Controls, Vcl.StdCtrls, WEBLib.StdCtrls,
XData.Web.Client, WEBLib.ExtCtrls, DB, XData.Web.JsonDataset,
XData.Web.Dataset, XData.Web.Connection, Vcl.Forms;
type
TFViewAdmin = class(TWebForm)
lblInfo: TWebLabel;
edtAddUsername: TWebEdit;
edtPassword: TWebEdit;
btnAddUser: TWebButton;
XDataWebClient1: TXDataWebClient;
lblResult: TWebLabel;
WebLabel1: TWebLabel;
WebLabel3: TWebLabel;
WebLabel2: TWebLabel;
WebLabel4: TWebLabel;
WebLabel5: TWebLabel;
WebLabel6: TWebLabel;
WebLabel7: TWebLabel;
edtUsername: TWebEdit;
edtUserId: TWebEdit;
edtFullName: TWebEdit;
edtAgency: TWebEdit;
chkAdminUser: TWebCheckBox;
edtBadgeNum: TWebEdit;
edtPersonnelId: TWebEdit;
procedure btnAddUserClick(Sender: TObject);
procedure WebFormShow(Sender: TObject);
[async] procedure AddUser();
private
{ Private declarations }
public
{ Public declarations }
end;
var
FViewAdmin: TFViewAdmin;
implementation
uses
XData.Model.Classes,
ConnectionModule,
Auth.Service;
{$R *.dfm}
procedure TFViewAdmin.WebFormShow(Sender: TObject);
begin
console.log('');
edtUsername.Text := JS.toString(AuthService.TokenPayload.Properties['user_name']);
edtFullName.Text := JS.toString(AuthService.TokenPayload.Properties['user_fullname']);
edtAgency.Text := JS.toString(AuthService.TokenPayload.Properties['user_agency']);
edtBadgeNum.Text := JS.toString(AuthService.TokenPayload.Properties['user_badge']);
edtUserId.Text := JS.toString(AuthService.TokenPayload.Properties['user_id']);
edtPersonnelId.Text := JS.toString(AuthService.TokenPayload.Properties['user_personnelid']);
//edtJwt.Text := TJSJSON.stringify(AuthService.TokenPayload);
chkAdminUser.Checked := JS.toBoolean(AuthService.TokenPayload.Properties['user_admin']);
end;
procedure TFViewAdmin.btnAddUserClick(Sender: TObject);
begin
AddUser();
end;
procedure TFViewAdmin.AddUser();
var
xdcResponse: TXDataClientResponse;
responseString: TJSObject;
begin
xdcResponse := await(XDataWebClient1.RawInvokeAsync('ILookupService.AddUser',
[edtAddUsername.Text, edtPassword.Text]));
responseString := TJSObject(xdcResponse.Result);
lblResult.Caption := string(responseString['value']);
end;
end.
\ No newline at end of file
object FViewComplaints: TFViewComplaints
Width = 676
Height = 480
CSSLibrary = cssBootstrap
ElementFont = efCSS
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
ParentFont = False
Visible = True
OnCreate = WebFormCreate
object lblEntries: TWebLabel
Left = 0
Top = 336
Width = 77
Height = 13
Caption = 'Showing 0 of ...'
ElementID = 'lblentries'
ElementFont = efCSS
HeightStyle = ssAuto
HeightPercent = 100.000000000000000000
Visible = False
WidthPercent = 100.000000000000000000
end
object wcbPageSize: TWebComboBox
Left = 0
Top = 0
Width = 145
Height = 21
ElementClassName = 'custom-select'
ElementID = 'wcbpagesize'
ElementFont = efCSS
HeightStyle = ssAuto
HeightPercent = 100.000000000000000000
Text = '10'
Visible = False
WidthPercent = 100.000000000000000000
ItemIndex = -1
Items.Strings = (
'10'
'25'
'50')
end
object wcbLocation: TWebLookupComboBox
Left = 154
Top = 0
Width = 145
Height = 22
ElementClassName = 'custom-select'
ElementID = 'wcblocation'
ElementFont = efCSS
HeightPercent = 100.000000000000000000
Visible = False
WidthPercent = 100.000000000000000000
ItemIndex = -1
LookupValues = <
item
DisplayText = 'All'
end
item
Value = '(716) 681-8820'
DisplayText = 'Galleria'
end
item
Value = '(716) 297-4654'
DisplayText = 'NF Outlet'
end
item
Value = '(585) 445-8911'
DisplayText = 'Rochester'
end
item
Value = '(315) 565-4138'
DisplayText = 'Syracuse'
end>
end
object dtpStartDate: TWebEdit
Left = 342
Top = 0
Width = 121
Height = 22
ChildOrder = 10
ElementClassName = 'form-control'
ElementID = 'dtpstartdate'
ElementFont = efCSS
HeightStyle = ssAuto
HeightPercent = 100.000000000000000000
Visible = False
WidthPercent = 100.000000000000000000
end
object dtpEndDate: TWebEdit
Left = 478
Top = 0
Width = 121
Height = 22
ChildOrder = 10
ElementClassName = 'form-control'
ElementID = 'dtpenddate'
ElementFont = efCSS
HeightStyle = ssAuto
HeightPercent = 100.000000000000000000
Visible = False
WidthPercent = 100.000000000000000000
end
object wcbSortBy: TWebComboBox
Left = 442
Top = 52
Width = 145
Height = 21
ElementClassName = 'custom-select'
ElementID = 'wcbsortby'
ElementFont = efCSS
HeightStyle = ssAuto
HeightPercent = 100.000000000000000000
Text = 'Date'
Visible = False
WidthPercent = 100.000000000000000000
ItemIndex = -1
Items.Strings = (
'Date'
'Phone Number')
end
object btnApply: TWebButton
Left = 478
Top = 128
Width = 96
Height = 25
Caption = 'Apply'
ChildOrder = 7
ElementClassName = 'btn btn-light'
ElementID = 'btnapply'
ElementFont = efCSS
HeightStyle = ssAuto
HeightPercent = 100.000000000000000000
Visible = False
WidthPercent = 100.000000000000000000
end
object edtSearch: TWebEdit
Left = 50
Top = 382
Width = 121
Height = 22
HelpType = htKeyword
ChildOrder = 8
ElementClassName = 'form-control'
ElementID = 'edtsearch'
ElementFont = efCSS
HeightStyle = ssAuto
HeightPercent = 100.000000000000000000
HideSelection = False
TextHint = 'Format: (XXX) XXX-XXXX'
Visible = False
WidthPercent = 100.000000000000000000
end
object XDataWebClient1: TXDataWebClient
Connection = DMConnection.ApiConnection
Left = 426
Top = 240
end
object XDataWebDataSet1: TXDataWebDataSet
Connection = DMConnection.ApiConnection
Left = 440
Top = 300
end
end
<div class="sticky-top">
<!-- Local navbar (Complaints) -->
<nav class="navbar navbar-dark bg-primary py-2"><!-- removed sticky-top -->
<div class="container-fluid">
<div class="row w-100 g-2 align-items-stretch">
<div class="col">
<span id="complaints.title" class="navbar-brand mb-0 h5 text-white">Complaints</span>
</div>
<div class="col">
<button id="complaints.btnrefresh" type="button" class="btn btn-primary w-100 h-100">
<i class="fa fa-sync-alt me-1"></i><span class="d-none d-sm-inline">Refresh</span>
</button>
</div>
<div class="col">
<button id="complaints.btngroup" type="button" class="btn btn-primary w-100 h-100">
<i class="fa fa-layer-group me-1"></i><span class="d-none d-sm-inline">Group</span>
</button>
</div>
<div class="col">
<button id="complaints.btnfilter" type="button" class="btn btn-primary w-100 h-100">
<i class="fa fa-sliders-h me-1"></i><span class="d-none d-sm-inline">Filter</span>
</button>
</div>
</div>
</div>
</nav>
<!-- Search bar under local navbar -->
<div class="bg-light border-bottom py-2"><!-- removed sticky-top -->
<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> <!-- /sticky-top wrapper -->
<!-- Existing content (unchanged) -->
<div class="row">
<div class="col-12">
<div class="container mt-4">
<div class="row justify-content-center">
<div class="col-12 col-md-10 col-lg-8">
<h1 class="page-header pt-3 pb-2 mb-3 border-bottom fs-4 fw-bold" id="view.calls.title">Complaints</h1>
<!-- Data Table -->
<div class="table-responsive mt-4">
<table class="table table-sm table-striped table-bordered align-middle" id="tblPhoneGrid">
<thead class="table-dark">
<tr>
<th scope="col">Phone Number</th>
<th scope="col">Caller</th>
<th scope="col">Time</th>
<th scope="col">Duration</th>
<th scope="col">Transcript</th>
<th scope="col">Listen</th>
</tr>
</thead>
<tbody>
<!-- Rows added dynamically in Delphi -->
</tbody>
</table>
</div>
<!-- Entry Count Label -->
<label id="lblentries" class="mt-2 d-block"></label>
<!-- Pagination -->
<nav aria-label="Page navigation">
<ul class="pagination justify-content-center" id="pagination">
<!-- Pagination items added in Delphi -->
</ul>
</nav>
</div>
</div>
</div>
</div>
</div>
object FViewEditUser: TFViewEditUser
Width = 640
Height = 480
OnShow = WebFormCreate
object WebLabel1: TWebLabel
Left = 8
Top = 99
Width = 73
Height = 15
Caption = 'Make Admin?'
Color = clBtnFace
ElementID = 'lblAdmin'
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
end
object WebLabel2: TWebLabel
Left = 16
Top = 8
Width = 57
Height = 15
Caption = 'Full Name:'
Color = clBtnFace
ElementID = 'lblfullname'
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
end
object WebLabel3: TWebLabel
Left = 14
Top = 37
Width = 53
Height = 15
Caption = 'Password:'
Color = clBtnFace
ElementID = 'lblpassword'
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
end
object WebLabel4: TWebLabel
Left = 6
Top = 62
Width = 84
Height = 15
Caption = 'Phone Number:'
Color = clBtnFace
ElementID = 'lblphone'
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
end
object WebLabel5: TWebLabel
Left = 256
Top = 8
Width = 56
Height = 15
Caption = 'Username:'
Color = clBtnFace
ElementID = 'lblusername'
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
end
object WebLabel6: TWebLabel
Left = 240
Top = 41
Width = 100
Height = 15
Caption = 'Confirm Password:'
Color = clBtnFace
ElementID = 'lblconfirm'
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
end
object WebLabel7: TWebLabel
Left = 252
Top = 69
Width = 32
Height = 15
Caption = 'Email:'
Color = clBtnFace
ElementID = 'lblemail'
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
end
object lblactive: TWebLabel
Left = 237
Top = 95
Width = 38
Height = 15
Caption = 'Active?'
Color = clBtnFace
ElementID = 'lblactive'
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
end
object edtPhoneNumber: TWebEdit
Left = 96
Top = 62
Width = 121
Height = 22
ChildOrder = 7
ElementID = 'edtphonenumber'
HeightPercent = 100.000000000000000000
ShowHint = True
TextHint = '(555) 555-5555'
WidthPercent = 100.000000000000000000
end
object edtConfirmPassword: TWebEdit
Left = 348
Top = 34
Width = 121
Height = 22
ChildOrder = 7
ElementID = 'edtconfirmpassword'
HeightPercent = 100.000000000000000000
PasswordChar = '*'
WidthPercent = 100.000000000000000000
end
object edtEmail: TWebEdit
Left = 348
Top = 62
Width = 121
Height = 22
ChildOrder = 7
ElementID = 'edtemail'
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
end
object edtPassword: TWebEdit
Left = 96
Top = 34
Width = 121
Height = 22
ChildOrder = 13
ElementID = 'edtpassword'
HeightPercent = 100.000000000000000000
PasswordChar = '*'
WidthPercent = 100.000000000000000000
end
object cbAdmin: TWebCheckBox
Left = 96
Top = 96
Width = 107
Height = 20
Caption = 'Make Admin?'
ChildOrder = 12
ElementID = 'cbadminuser'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = [fsBold]
HeightPercent = 100.000000000000000000
ParentFont = False
WidthPercent = 100.000000000000000000
end
object btnConfirm: TWebButton
Left = 96
Top = 138
Width = 96
Height = 25
Caption = 'Confirm'
ChildOrder = 9
ElementClassName = 'btn btn-light'
ElementID = 'btnconfirm'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -20
Font.Name = 'Segoe UI'
Font.Style = []
HeightPercent = 100.000000000000000000
ParentFont = False
WidthPercent = 100.000000000000000000
OnClick = btnConfirmClick
end
object edtFullname: TWebEdit
Left = 96
Top = 4
Width = 121
Height = 22
ChildOrder = 14
ElementID = 'edtfullname'
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
end
object edtUsername: TWebEdit
Left = 346
Top = 4
Width = 121
Height = 22
ChildOrder = 14
ElementID = 'edtusername'
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
end
object btnCancel: TWebButton
Left = 238
Top = 138
Width = 96
Height = 25
Caption = 'Cancel'
ChildOrder = 9
ElementClassName = 'btn btn-light'
ElementID = 'btncancel'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -20
Font.Name = 'Segoe UI'
Font.Style = []
HeightPercent = 100.000000000000000000
ParentFont = False
WidthPercent = 100.000000000000000000
OnClick = btnCancelClick
end
object btnConfirmChanges: TWebButton
Left = 100
Top = 330
Width = 96
Height = 25
Caption = 'Confirm'
ChildOrder = 16
ElementID = 'btn_confirm_changes'
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
OnClick = btnConfirmChangesClick
end
object pnlMessage: TWebPanel
Left = 482
Top = 4
Width = 121
Height = 33
ElementID = 'view.login.message'
ChildOrder = 17
TabOrder = 10
object lblMessage: TWebLabel
Left = 16
Top = 11
Width = 46
Height = 15
Caption = 'Message'
ElementID = 'view.login.message.label'
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
end
object btnCloseNotification: TWebButton
Left = 96
Top = 3
Width = 22
Height = 25
ChildOrder = 1
ElementID = 'view.login.message.button'
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
OnClick = btnCloseNotificationClick
end
end
object cbActive: TWebCheckBox
Left = 346
Top = 94
Width = 107
Height = 20
Caption = 'Active?'
ChildOrder = 12
ElementID = 'cbactive'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = [fsBold]
HeightPercent = 100.000000000000000000
ParentFont = False
WidthPercent = 100.000000000000000000
end
object XDataWebClient1: TXDataWebClient
Connection = DMConnection.ApiConnection
Left = 462
Top = 164
end
object WebTimer1: TWebTimer
Enabled = False
Interval = 500
OnTimer = WebTimer1Timer
Left = 236
Top = 194
end
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