Skip to content

E
emT3web
Commit b094feee by Elias Sarraf
Options

reworking project - the webAppTemplate project will be based on this

parent 11ad67f8
Showing with 728 additions and 2959 deletions
.gitignore
emT3VCLDemo/__history/ emT3VCLDemo/__history/
emT3VCLDemo/Win64x/Debug/ emT3VCLDemo/Win64x/
emT3Web/__history/ emT3Web/__history/
emT3Web/config/__history/ emT3Web/__recovery/
emT3Web/config/
emT3Web/Win32/ emT3Web/Win32/
emT3XDataServer/__history/ emT3XDataServer/__history/
emT3XDataServer/bin/logs/
emT3XDataServer/bin/static/
emT3XDataServer/Source/__history/ emT3XDataServer/Source/__history/
emT3XDataServer/Win32/ emT3XDataServer/Win32/
...@@ -14,17 +17,4 @@ emT3XDataServer/Win32/ ...@@ -14,17 +17,4 @@ emT3XDataServer/Win32/
*.skincfg *.skincfg
*.tvsconfig *.tvsconfig
*.txt *.txt
emT3Web/Win32/Debug/
emT3Web/__recovery/
emT3WebApp/__history/
*.zip *.zip
emT3WebApp/css/__history/
emT3XDataServer/bin/static/
emT3WebApp/Win32/Debug/
emT3VCLDemo/uMain.dfm
...@@ -105,7 +105,7 @@ object fMain: TfMain ...@@ -105,7 +105,7 @@ object fMain: TfMain
'MySQL.HttpTrustServerCertificate=False' 'MySQL.HttpTrustServerCertificate=False'
'MySQL.ProxyPort=0') 'MySQL.ProxyPort=0')
Username = 'etask' Username = 'etask'
Server = '192.168.12.51' Server = '192.168.116.131'
LoginPrompt = False LoginPrompt = False
Left = 390 Left = 390
Top = 342 Top = 342
......
emT3Web/Auth.Service.pas
...@@ -12,6 +12,8 @@ const ...@@ -12,6 +12,8 @@ const
type type
TOnLoginSuccess = reference to procedure; TOnLoginSuccess = reference to procedure;
TOnLoginError = reference to procedure(AMsg: string); TOnLoginError = reference to procedure(AMsg: string);
TOnProfileSuccess = reference to procedure;
TOnProfileError = reference to procedure(AMsg: string);
TAuthService = class TAuthService = class
private private
...@@ -21,9 +23,8 @@ type ...@@ -21,9 +23,8 @@ type
public public
constructor Create; reintroduce; constructor Create; reintroduce;
destructor Destroy; override; destructor Destroy; override;
procedure Login(AUser, APassword, AClientVersion: string; ASuccess: TOnLoginSuccess;
procedure Login(const userId, taskId, urlCode: string; ASuccess: TOnLoginSuccess; AError: TOnLoginError); AError: TOnLoginError);
procedure Logout; procedure Logout;
function GetToken: string; function GetToken: string;
function Authenticated: Boolean; function Authenticated: Boolean;
...@@ -41,7 +42,7 @@ type ...@@ -41,7 +42,7 @@ type
class function DecodePayload(AToken: string): string; class function DecodePayload(AToken: string): string;
end; end;
function AuthService: TAuthService; function AuthService: TAuthService;
implementation implementation
...@@ -54,7 +55,9 @@ var ...@@ -54,7 +55,9 @@ var
function AuthService: TAuthService; function AuthService: TAuthService;
begin begin
if not Assigned(_AuthService) then if not Assigned(_AuthService) then
begin
_AuthService := TAuthService.Create; _AuthService := TAuthService.Create;
end;
Result := _AuthService; Result := _AuthService;
end; end;
...@@ -88,7 +91,8 @@ begin ...@@ -88,7 +91,8 @@ begin
Result := window.localStorage.getItem(TOKEN_NAME); Result := window.localStorage.getItem(TOKEN_NAME);
end; end;
procedure TAuthService.Login(const userId, taskId, urlCode: string; ASuccess: TOnLoginSuccess; AError: TOnLoginError); procedure TAuthService.Login(AUser, APassword, AClientVersion: string; ASuccess: TOnLoginSuccess;
AError: TOnLoginError);
procedure OnLoad(Response: TXDataClientResponse); procedure OnLoad(Response: TXDataClientResponse);
var var
...@@ -105,14 +109,14 @@ procedure TAuthService.Login(const userId, taskId, urlCode: string; ASuccess: TO ...@@ -105,14 +109,14 @@ procedure TAuthService.Login(const userId, taskId, urlCode: string; ASuccess: TO
end; end;
begin begin
if (userId = '') or (taskId = '') or (urlCode = '') then if (AUser = '') or (APassword = '') then
begin begin
AError('Missing URL parameters. Please reopen from emt3.'); AError('Please enter a username and a password');
Exit; Exit;
end; end;
FClient.RawInvoke( FClient.RawInvoke(
'IAuthService.Login', [userId, taskId, urlCode], 'IAuthService.Login', [AUser, APassword, AClientVersion],
@OnLoad, @OnError @OnLoad, @OnError
); );
end; end;
...@@ -136,9 +140,17 @@ begin ...@@ -136,9 +140,17 @@ begin
ExpirationDate := TJwtHelper.TokenExpirationDate(GetToken); ExpirationDate := TJwtHelper.TokenExpirationDate(GetToken);
Result := Result := EncodeDate(
EncodeDate(ExpirationDate.FullYear, ExpirationDate.Month + 1, ExpirationDate.Date) + ExpirationDate.FullYear,
EncodeTime(ExpirationDate.Hours, ExpirationDate.Minutes, ExpirationDate.Seconds, 0); ExpirationDate.Month + 1,
ExpirationDate.Date
) +
EncodeTime(
ExpirationDate.Hours,
ExpirationDate.Minutes,
ExpirationDate.Seconds,
0
);
end; end;
function TAuthService.TokenExpired: Boolean; function TAuthService.TokenExpired: Boolean;
...@@ -164,7 +176,8 @@ begin ...@@ -164,7 +176,8 @@ begin
Result := ''; Result := '';
asm asm
const parts = AToken.split('.'); const parts = AToken.split('.');
if (parts.length === 3) { if (parts.length === 3) { // <- strict compare
// JWTs use url-safe base64; convert before atob
Result = atob(parts[1].replace(/-/g,'+').replace(/_/g,'/')); Result = atob(parts[1].replace(/-/g,'+').replace(/_/g,'/'));
} }
end; end;
......
emT3Web/ConnectionModule.dfm
...@@ -2,6 +2,7 @@ object DMConnection: TDMConnection ...@@ -2,6 +2,7 @@ object DMConnection: TDMConnection
Height = 264 Height = 264
Width = 395 Width = 395
object ApiConnection: TXDataWebConnection object ApiConnection: TXDataWebConnection
URL = 'http://localhost:2001/emsys/emt3/api'
OnError = ApiConnectionError OnError = ApiConnectionError
OnRequest = ApiConnectionRequest OnRequest = ApiConnectionRequest
OnResponse = ApiConnectionResponse OnResponse = ApiConnectionResponse
...@@ -9,6 +10,7 @@ object DMConnection: TDMConnection ...@@ -9,6 +10,7 @@ object DMConnection: TDMConnection
Top = 80 Top = 80
end end
object AuthConnection: TXDataWebConnection object AuthConnection: TXDataWebConnection
URL = 'http://localhost:2001/emsys/emt3/auth'
OnError = AuthConnectionError OnError = AuthConnectionError
Left = 48 Left = 48
Top = 16 Top = 16
......
emT3Web/ConnectionModule.pas
...@@ -4,7 +4,8 @@ interface ...@@ -4,7 +4,8 @@ interface
uses uses
System.SysUtils, System.Classes, WEBLib.Modules, XData.Web.Connection, System.SysUtils, System.Classes, WEBLib.Modules, XData.Web.Connection,
App.Types, App.Config, XData.Web.Client; App.Types, App.Config, XData.Web.Client, WEBLib.Dialogs, Vcl.Menus,
WEBLib.Menus;
type type
TDMConnection = class(TWebDataModule) TDMConnection = class(TWebDataModule)
...@@ -17,10 +18,11 @@ type ...@@ -17,10 +18,11 @@ type
procedure AuthConnectionError(Error: TXDataWebConnectionError); procedure AuthConnectionError(Error: TXDataWebConnectionError);
private private
FUnauthorizedAccessProc: TUnauthorizedAccessProc; FUnauthorizedAccessProc: TUnauthorizedAccessProc;
public
const clientVersion = '0.0.1';
procedure InitApp(SuccessProc: TSuccessProc; UnauthorizedAccessProc: TUnauthorizedAccessProc); public
const clientVersion = '0.8.3';
procedure InitApp(SuccessProc: TSuccessProc;
UnauthorizedAccessProc: TUnauthorizedAccessProc);
procedure SetClientConfig(Callback: TVersionCheckCallback); procedure SetClientConfig(Callback: TVersionCheckCallback);
end; end;
...@@ -33,35 +35,59 @@ uses ...@@ -33,35 +35,59 @@ uses
JS, Web, JS, Web,
XData.Web.Request, XData.Web.Request,
XData.Web.Response, XData.Web.Response,
Auth.Service, Auth.Service;
Utils;
{%CLASSGROUP 'Vcl.Controls.TControl'} {%CLASSGROUP 'Vcl.Controls.TControl'}
{$R *.dfm} {$R *.dfm}
procedure TDMConnection.ApiConnectionError(Error: TXDataWebConnectionError); procedure TDMConnection.ApiConnectionError(Error: TXDataWebConnectionError);
var
errorMsg: string;
begin begin
ShowErrorModal(Error.ToString); errorMsg := Error.ErrorMessage;
if errorMsg = '' then
errorMsg := 'Connection error';
if Assigned(FUnauthorizedAccessProc) then
FUnauthorizedAccessProc(errorMsg)
else
ShowMessage(errorMsg);
end; end;
procedure TDMConnection.ApiConnectionRequest(Args: TXDataWebConnectionRequest); procedure TDMConnection.ApiConnectionRequest(Args: TXDataWebConnectionRequest);
begin begin
if AuthService.Authenticated then if AuthService.Authenticated then
Args.Request.Headers.SetValue('Authorization', 'Bearer ' + AuthService.GetToken); Args.Request.Headers.SetValue('Authorization', 'Bearer ' + AuthService.GetToken);
end; end;
procedure TDMConnection.ApiConnectionResponse(Args: TXDataWebConnectionResponse);
procedure TDMConnection.ApiConnectionResponse(
Args: TXDataWebConnectionResponse);
begin begin
if (Args.Response.StatusCode = 401) and Assigned(FUnauthorizedAccessProc) then if Args.Response.StatusCode = 401 then
FUnauthorizedAccessProc(Format('%d: %s', [Args.Response.StatusCode, Args.Response.ContentAsText])); FUnauthorizedAccessProc(Format('%d: %s',[Args.Response.StatusCode, Args.Response.ContentAsText]));
end; end;
procedure TDMConnection.AuthConnectionError(Error: TXDataWebConnectionError); procedure TDMConnection.AuthConnectionError(Error: TXDataWebConnectionError);
var
errorMsg: string;
begin begin
ShowErrorModal(Error.ToString); errorMsg := Error.ErrorMessage;
if errorMsg = '' then
errorMsg := 'Connection error';
if errorMsg = 'Error connecting to XData server' then
ShowMessage( 'Error connecting to emT3XDataServer' + sLineBreak + 'Please contact EM Systems support' )
else if Assigned(FUnauthorizedAccessProc) then
FUnauthorizedAccessProc(errorMsg)
else
ShowMessage(errorMsg);
end; end;
procedure TDMConnection.InitApp(SuccessProc: TSuccessProc; procedure TDMConnection.InitApp(SuccessProc: TSuccessProc;
UnauthorizedAccessProc: TUnauthorizedAccessProc); UnauthorizedAccessProc: TUnauthorizedAccessProc);
...@@ -81,12 +107,12 @@ begin ...@@ -81,12 +107,12 @@ begin
LoadConfig(@ConfigLoaded); LoadConfig(@ConfigLoaded);
end; end;
procedure TDMConnection.SetClientConfig(Callback: TVersionCheckCallback); procedure TDMConnection.SetClientConfig(Callback: TVersionCheckCallback);
begin begin
XDataWebClient1.Connection := AuthConnection; XDataWebClient1.Connection := AuthConnection;
XDataWebClient1.RawInvoke( XDataWebClient1.RawInvoke('IAuthService.VerifyVersion', [clientVersion],
'IAuthService.VerifyVersion', [clientVersion],
procedure(Response: TXDataClientResponse) procedure(Response: TXDataClientResponse)
var var
jsonResult: TJSObject; jsonResult: TJSObject;
...@@ -103,12 +129,9 @@ begin ...@@ -103,12 +129,9 @@ begin
Callback(False, error) Callback(False, error)
else else
Callback(True, ''); Callback(True, '');
end, end);
procedure(Error: TXDataClientError)
begin
Callback(False, Error.ErrorMessage);
end
);
end; end;
end. end.
emT3Web/Utils.pas
...@@ -10,13 +10,9 @@ procedure HideStatusMessage(const AElementId: string); ...@@ -10,13 +10,9 @@ procedure HideStatusMessage(const AElementId: string);
procedure ShowSpinner(SpinnerID: string); procedure ShowSpinner(SpinnerID: string);
procedure HideSpinner(SpinnerID: string); procedure HideSpinner(SpinnerID: string);
procedure ShowErrorModal(msg: 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 ShowToast(const MessageText: string; const ToastType: string = 'success');
procedure ShowConfirmationModal(msg, leftLabel, rightLabel: string; ConfirmProc: TProc<Boolean>); procedure ShowConfirmationModal(msg, leftLabel, rightLabel: string; ConfirmProc: TProc<Boolean>);
procedure ShowNotificationModal(msg: string); procedure ShowNotificationModal(msg: string);
// function FormatDollarValue(ValueStr: string): string;
implementation implementation
...@@ -153,28 +149,6 @@ begin ...@@ -153,28 +149,6 @@ begin
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>); procedure ShowConfirmationModal(msg, leftLabel, rightLabel: string; ConfirmProc: TProc<Boolean>);
begin begin
asm asm
...@@ -211,49 +185,6 @@ begin ...@@ -211,49 +185,6 @@ begin
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'); procedure ShowToast(const MessageText: string; const ToastType: string = 'success');
var var
ParsedText, ToastKind, MsgPrefix: string; ParsedText, ToastKind, MsgPrefix: string;
...@@ -318,35 +249,5 @@ begin ...@@ -318,35 +249,5 @@ begin
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. end.
emT3Web/View.Home.dfm deleted 100644 → 0
object FHome: TFHome
Width = 640
Height = 480
CSSLibrary = cssBootstrap
ElementFont = efCSS
object edtCode: TWebEdit
Left = 380
Top = 198
Width = 121
Height = 22
TabStop = False
ElementClassName = 'form-control'
ElementID = 'edt_code'
ElementFont = efCSS
HeightStyle = ssAuto
HeightPercent = 100.000000000000000000
ShowFocus = False
WidthPercent = 100.000000000000000000
end
object edtTaskId: TWebEdit
Left = 104
Top = 198
Width = 121
Height = 22
TabStop = False
ChildOrder = 1
ElementClassName = 'form-control'
ElementID = 'edt_task_id'
ElementFont = efCSS
HeightStyle = ssAuto
HeightPercent = 100.000000000000000000
ShowFocus = False
WidthPercent = 100.000000000000000000
end
object edtUserId: TWebEdit
Left = 240
Top = 198
Width = 121
Height = 22
TabStop = False
ChildOrder = 2
ElementClassName = 'form-control'
ElementID = 'edt_user_id'
ElementFont = efCSS
HeightStyle = ssAuto
HeightPercent = 100.000000000000000000
ShowFocus = False
WidthPercent = 100.000000000000000000
end
end
emT3Web/View.Home.html deleted 100644 → 0
<div class="container-fluid py-3">
<div class="card shadow-sm">
<div class="card-body">
<h4 class="mb-3">Home Form</h4>
<div class="mb-3">
<label for="edt_task_id" class="form-label">Task Id</label>
<input id="edt_task_id" type="text" class="form-control">
</div>
<div class="mb-3">
<label for="edt_user_id" class="form-label">User Id</label>
<input id="edt_user_id" type="text" class="form-control">
</div>
<div class="mb-3">
<label for="edt_code" class="form-label">Code</label>
<input id="edt_code" type="text" class="form-control">
</div>
</div>
</div>
</div>
emT3Web/View.Home.pas deleted 100644 → 0
unit View.Home;
interface
uses
System.SysUtils, System.Classes, JS, Web, WEBLib.Graphics, WEBLib.Controls,
WEBLib.Forms, WEBLib.Dialogs, Vcl.Controls, Vcl.StdCtrls, WEBLib.StdCtrls;
type
TFHome = class(TWebForm)
edtCode: TWebEdit;
edtTaskId: TWebEdit;
edtUserId: TWebEdit;
private
FTaskId: string;
FUserId: string;
FCode: string;
public
class function CreateForm(AElementID, ATaskId, AUserId, ACode: string): TWebForm;
procedure InitializeForm;
end;
var
FHome: TFHome;
implementation
{$R *.dfm}
class function TFHome.CreateForm(AElementID, ATaskId, AUserId, ACode: string): TWebForm;
procedure AfterCreate(AForm: TObject);
begin
TFHome(AForm).FTaskId := ATaskId;
TFHome(AForm).FUserId := AUserId;
TFHome(AForm).FCode := ACode;
TFHome(AForm).InitializeForm;
end;
begin
Application.CreateForm(TFHome, AElementID, Result, @AfterCreate);
end;
procedure TFHome.InitializeForm;
begin
console.log('TFHome.InitializeForm fired');
console.log('TaskId=' + FTaskId);
console.log('UserId=' + FUserId);
console.log('Code=' + FCode);
edtTaskId.Text := FTaskId;
edtUserId.Text := FUserId;
edtCode.Text := FCode;
end;
end.
emT3Web/View.Login.dfm deleted 100644 → 0
This source diff could not be displayed because it is too large. You can view the blob instead.
emT3Web/View.Login.html deleted 100644 → 0
<nav class="navbar navbar-light bg-light login-navbar">
<div class="container-fluid">
<a class="navbar-brand" href="#">Koehler-Gibson Orders</a>
</div>
</nav>
<div class="container mt-5">
<div class="row justify-content-center">
<div class="col-auto">
<img id="kgpicture" style="width: 250px; height: 250px;">
</div>
<div class="col-md-6 col-lg-4">
<div class="card login-card">
<div class="card-header">
<h3 id="view.login.title" class="fs-6 card-title">Please Sign In</h3>
</div>
<div class="card-body">
<div role="form">
<div id="view.login.message" class="alert alert-danger">
<button id="view.login.message.button" type="button" class="btn-close" aria-label="Close"></button>
<span id="view.login.message.label"></span>
</div>
<fieldset>
<div class="mb-3">
<input id="view.login.edtusername" class="form-control" type="text" autofocus placeholder="Username">
</div>
<div class="mb-3">
<input id="view.login.edtpassword" class="form-control" type="password" placeholder="Password">
</div>
<div class="mb-3">
<button id="view.login.btnlogin" class="btn btn-primary w-100">Login</button>
</div>
<div class="text-end text-muted small mt-1">
<span id="lbl_client_version"></span>
</div>
</fieldset>
</div>
</div>
</div>
</div>
</div>
</div>
emT3Web/View.Login.pas deleted 100644 → 0
unit View.Login;
interface
uses
System.SysUtils, System.Classes, Web, WEBLib.Graphics, WEBLib.Controls, WEBLib.Forms, WEBLib.Dialogs,
Vcl.Controls, Vcl.StdCtrls, WEBLib.StdCtrls, WEBLib.JSON,
JS, XData.Web.Connection, WEBLib.ExtCtrls,
App.Types, ConnectionModule, XData.Web.Client, Vcl.Imaging.pngimage;
type
TFViewLogin = class(TWebForm)
WebLabel1: TWebLabel;
edtUsername: TWebEdit;
edtPassword: TWebEdit;
btnLogin: TWebButton;
pnlMessage: TWebPanel;
lblMessage: TWebLabel;
btnCloseNotification: TWebButton;
XDataWebClient: TXDataWebClient;
WebImageControl1: TWebImageControl;
lblClientVersion: TWebLabel;
procedure btnCloseNotificationClick(Sender: TObject);
procedure WebFormShow(Sender: TObject);
private
FLoginProc: TSuccessProc;
FMessage: string;
procedure ShowNotification(Notification: string);
procedure HideNotification;
public
class procedure Display(LoginProc: TSuccessProc); overload;
class procedure Display(LoginProc: TSuccessProc; AMsg: string); overload;
end;
var
FViewLogin: TFViewLogin;
implementation
uses
Auth.Service;
{$R *.dfm}
class procedure TFViewLogin.Display(LoginProc: TSuccessProc);
begin
TFViewLogin.Display(LoginProc, '');
end;
class procedure TFViewLogin.Display(LoginProc: TSuccessProc; AMsg: string);
procedure FormCreate(AForm: TObject);
begin
TFViewLogin(AForm).FMessage := AMsg;
end;
begin
if Assigned(FViewLogin) then
FViewLogin.Free;
FViewLogin := TFViewLogin.CreateNew(@FormCreate);
FViewLogin.FLoginProc := LoginProc;
end;
procedure TFViewLogin.HideNotification;
begin
pnlMessage.ElementHandle.classList.add('d-none');
pnlMessage.Visible := False;
end;
procedure TFViewLogin.ShowNotification(Notification: string);
begin
if Notification <> '' then
begin
lblMessage.Caption := Notification;
pnlMessage.ElementHandle.classList.remove('d-none');
pnlMessage.Visible := True;
end;
end;
procedure TFViewLogin.btnCloseNotificationClick(Sender: TObject);
begin
HideNotification;
end;
procedure TFViewLogin.WebFormShow(Sender: TObject);
begin
console.log(DMConnection.clientVersion);
FViewLogin.lblClientVersion.Caption := 'v' + DMConnection.clientVersion;
if FMessage <> '' then
ShowNotification(FMessage)
else
HideNotification;
end;
end.
emT3Web/View.Main.dfm
...@@ -10,50 +10,80 @@ object FViewMain: TFViewMain ...@@ -10,50 +10,80 @@ object FViewMain: TFViewMain
Font.Style = [] Font.Style = []
ParentFont = False ParentFont = False
OnCreate = WebFormCreate OnCreate = WebFormCreate
object wllblLogout: TWebLinkLabel object lblUsername: TWebLabel
Left = 501 Left = 536
Top = 33 Top = 4
Width = 49
Height = 14
Caption = 'Username'
ElementID = 'lbl_username'
ElementPosition = epRelative
HeightPercent = 100.000000000000000000
Transparent = False
WidthPercent = 100.000000000000000000
end
object lblUserProfile: TWebLinkLabel
Left = 529
Top = 21
Width = 59
Height = 14
ElementID = 'lbl_user_profile'
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
Caption = ' User Profile'
end
object lblLogout: TWebLinkLabel
Left = 547
Top = 55
Width = 36 Width = 36
Height = 14 Height = 14
ElementID = 'dropdown.menu.logout' ElementID = 'lbl_logout'
HeightPercent = 100.000000000000000000 HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000 WidthPercent = 100.000000000000000000
OnClick = wllblLogoutClick OnClick = lblLogoutClick
Caption = ' Logout' Caption = ' Logout'
end end
object lblVersion: TWebLabel object lblHome: TWebLinkLabel
Left = 396 Left = 556
Top = 33 Top = 38
Width = 47 Width = 27
Height = 14 Height = 14
Caption = 'lblVersion' ElementID = 'lbl_home'
ElementID = 'view.main.version'
ElementFont = efCSS
ElementPosition = epRelative
HeightStyle = ssAuto
HeightPercent = 100.000000000000000000 HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000 WidthPercent = 100.000000000000000000
Caption = 'Home'
end end
object lblAppTitle: TWebLabel object lblAppTitle: TWebLabel
Left = 57 Left = 57
Top = 33 Top = 33
Width = 48 Width = 48
Height = 14 Height = 14
Caption = 'emT3web' Caption = 'emT3Web'
ElementID = 'view.main.apptitle' ElementID = 'lbl_app_title'
ElementPosition = epRelative
HeightPercent = 100.000000000000000000
Transparent = False
WidthPercent = 100.000000000000000000
end
object lblVersion: TWebLabel
Left = 536
Top = 71
Width = 47
Height = 14
Caption = 'lblVersion'
ElementID = 'lbl_version'
ElementFont = efCSS ElementFont = efCSS
ElementPosition = epRelative ElementPosition = epRelative
HeightStyle = ssAuto HeightStyle = ssAuto
HeightPercent = 100.000000000000000000 HeightPercent = 100.000000000000000000
Transparent = False
WidthPercent = 100.000000000000000000 WidthPercent = 100.000000000000000000
end end
object WebPanel1: TWebPanel object pnlMain: TWebPanel
Left = 77 Left = 62
Top = 112 Top = 92
Width = 1322 Width = 393
Height = 0 Height = 219
ElementID = 'main.webpanel' ElementID = 'pnl_main'
HeightStyle = ssAuto HeightStyle = ssAuto
WidthStyle = ssAuto WidthStyle = ssAuto
ChildOrder = 3 ChildOrder = 3
...@@ -68,67 +98,9 @@ object FViewMain: TFViewMain ...@@ -68,67 +98,9 @@ object FViewMain: TFViewMain
Role = 'null' Role = 'null'
TabOrder = 0 TabOrder = 0
end end
object WebMemo1: TWebMemo object xdwcMain: TXDataWebClient
Left = 77
Top = 479
Width = 471
Height = 83
ElementID = 'main.debugmemo'
ElementPosition = epRelative
Enabled = False
HeightPercent = 100.000000000000000000
Lines.Strings = (
'WebMemo1')
Role = 'null'
SelLength = 0
SelStart = 0
ShowFocus = False
Visible = False
WidthPercent = 100.000000000000000000
end
object WebMessageDlg1: TWebMessageDlg
Left = 47
Top = 232
Width = 24
Height = 24
Buttons = []
CustomButtons = <>
DialogText.Strings = (
'Warning'
'Error'
'Information'
'Confirm'
'Custom'
'OK'
'Cancel'
'Yes'
'No'
'Abort'
'Retry'
'Ignore'
'All'
'Yes to all'
'No to all'
'Help'
'Close')
Opacity = 0.200000000000000000
end
object edtTaskIdMain: TWebEdit
Left = 220
Top = 170
Width = 121
Height = 22
ChildOrder = 6
ElementClassName = 'form-control'
ElementID = 'edt_task_id_main'
ElementFont = efCSS
HeightStyle = ssAuto
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
end
object XDataWebClient: TXDataWebClient
Connection = DMConnection.ApiConnection Connection = DMConnection.ApiConnection
Left = 44 Left = 76
Top = 280 Top = 332
end end
end end
emT3Web/View.Main.html
<div id="wrapper" class="d-flex flex-column vh-100"> <div id="div_wrapper">
<nav class="navbar navbar-expand navbar-light bg-light" style="margin-bottom: 0px"> <nav class="navbar navbar-expand-lg bg-body-tertiary border-bottom shadow-sm">
<div class="container-fluid"> <div class="container-fluid">
<div class="d-flex align-items-center"> <div class="d-flex align-items-center gap-2">
<a id="view.main.apptitle" class="navbar-brand" href="index.html">emT3web</a> <a id="lbl_app_title" class="navbar-brand fw-semibold" href="index.html">emT3Web</a>
<span id="view.main.version" class="small text-muted ms-2"></span> <span id="lbl_version" class="badge text-bg-light border text-muted fw-normal"></span>
</div> </div>
<li class="nav-item ms-2 me-2 d-flex align-items-center">
<input id="edt_task_id_main" type="text" class="form-control form-control-sm" placeholder="Task Id">
</li>
<div class="collapse navbar-collapse show" id="navbarNavDropdown"> <div class="collapse navbar-collapse show" id="pnl_navbar_nav_dropdown">
<ul class="navbar-nav ms-auto"> <ul class="navbar-nav ms-auto">
<li class="nav-item dropdown"> <li class="nav-item dropdown">
<a class="nav-link dropdown-toggle" id="navbarDropdownMenuLink" role="button" data-bs-toggle="dropdown" aria-expanded="false"> <a class="nav-link dropdown-toggle d-flex align-items-center gap-2" id="lnk_navbar_dropdown_menu_link"
<i class="fa fa-user fa-fw"></i><span class="panel-title" id="view.main.username">Username</span> role="button" data-bs-toggle="dropdown" aria-expanded="false">
<i class="fa fa-user fa-fw"></i>
<span id="lbl_username" class="fw-semibold">Username</span>
</a> </a>
<ul class="dropdown-menu dropdown-menu-end" aria-labelledby="navbarDropdownMenuLink">
<ul class="dropdown-menu dropdown-menu-end shadow-sm" aria-labelledby="lnk_navbar_dropdown_menu_link">
<li>
<a class="dropdown-item d-flex align-items-center gap-2" id="lbl_home" href="#">
<i class="fa fa-home fa-fw"></i><span>Home</span>
</a>
</li>
<li>
<a class="dropdown-item d-flex align-items-center gap-2" id="lbl_user_profile" href="#">
<i class="fa fa-user fa-fw"></i><span>User Profile</span>
</a>
</li>
<li><hr class="dropdown-divider"></li>
<li> <li>
<a class="dropdown-item" id="dropdown.menu.logout" href="#"> <a class="dropdown-item d-flex align-items-center gap-2 text-danger" id="lbl_logout" href="#">
<i class="fa fa-sign-out fa-fw"></i><span> Logout</span> <i class="fa fa-sign-out fa-fw"></i><span>Logout</span>
</a> </a>
</li> </li>
</ul> </ul>
</li> </li>
</ul> </ul>
</div> </div>
</div> </div>
</nav> </nav>
<!-- Toast wrapper directly under navbar --> <!-- Toast -->
<div id="toast-wrapper" class="position-fixed top-0 start-0 mt-5 ms-4" style="z-index: 1080; min-width: 300px; max-width: 500px"> <div id="pnl_toast_wrapper" class="position-fixed top-0 start-0 mt-5 ms-4"
<div id="bootstrapToast" class="toast align-items-center text-white bg-success border-0 shadow" role="alert" aria-live="assertive" aria-atomic="true"> style="z-index: 1080; min-width: 300px; max-width: 500px;">
<div id="toast_bootstrap" class="toast align-items-center text-white bg-success border-0 shadow" role="alert"
aria-live="assertive" aria-atomic="true">
<div class="d-flex"> <div class="d-flex">
<div class="toast-body" id="bootstrapToastBody">Success message</div> <div class="toast-body" id="lbl_bootstrap_toast_body">
<button type="button" class="btn-close btn-close-white me-2 m-auto" data-bs-dismiss="toast" aria-label="Close"></button> Success message
</div>
<button type="button" class="btn-close btn-close-white me-2 m-auto" data-bs-dismiss="toast"
aria-label="Close"></button>
</div> </div>
</div> </div>
</div> </div>
<div class="container-fluid d-flex flex-column flex-grow-1" style="min-height: 0">
<div id="main.webpanel" class="flex-grow-1 d-flex flex-column" style="min-height: 0"></div> <!-- Main Panel (where all forms display) -->
<div class="container-fluid py-3 d-flex flex-column overflow-hidden" style="height: calc(100vh - 57px);">
<div id="pnl_main" class="flex-grow-1 min-h-0 overflow-hidden"></div>
</div> </div>
</div>
<div id="spinner" class="position-absolute top-50 start-50 translate-middle d-none"> <!-- Spinner Modal -->
<div class="lds-roller"> <div id="div_spinner" class="position-absolute top-50 start-50 translate-middle d-none">
<div></div> <div class="lds-roller">
<div></div> <div></div><div></div><div></div><div></div>
<div></div> <div></div><div></div><div></div><div></div>
<div></div> </div>
<div></div>
<div></div>
<div></div>
<div></div>
</div> </div>
</div>
<div class="modal fade" id="main_errormodal" tabindex="-1" aria-labelledby="main_lblmodal" aria-hidden="true"> <!-- Error Modal -->
<div class="modal-dialog"> <div class="modal fade" id="mdl_error" tabindex="-1" aria-labelledby="lbl_modal_title" aria-hidden="true">
<div class="modal-content shadow-lg"> <div class="modal-dialog">
<div class="modal-header"> <div class="modal-content shadow-lg">
<h5 class="modal-title" id="main_lblmodal">Error</h5> <div class="modal-header">
<button type="button" class="btn-close" data-bs-dismiss="modal" aria-label="Close"></button> <h5 class="modal-title" id="lbl_modal_title">Error</h5>
</div> <button type="button" class="btn-close" data-bs-dismiss="modal" aria-label="Close"></button>
<div class="modal-body fs-6 fw-bold" id="main_lblmodal_body"> </div>
Please contact EMSystems to solve the issue. <div class="modal-body fs-6 fw-bold" id="lbl_modal_body">
</div> Please contact EMSystems to solve the issue.
<div class="modal-footer justify-content-center"> </div>
<button type="button" id="btn_modal_restart" class="btn btn-primary"> <div class="modal-footer justify-content-center">
Restart <button type="button" id="btn_modal_restart" class="btn btn-primary">Back to Orders</button>
</button> </div>
</div> </div>
</div> </div>
</div> </div>
</div>
<div class="modal fade" id="main_confirmation_modal" tabindex="-1" aria-hidden="true"> <!-- Confirmation Modal -->
<div class="modal-dialog"> <div class="modal fade" id="mdl_confirmation" tabindex="-1" aria-hidden="true">
<div class="modal-content shadow-lg"> <div class="modal-dialog">
<div class="modal-header"> <div class="modal-content shadow-lg">
<h5 class="modal-title">Confirm</h5> <div class="modal-header">
<button type="button" class="btn-close" data-bs-dismiss="modal" aria-label="Close"></button> <h5 class="modal-title">Confirm</h5>
</div> <button type="button" class="btn-close" data-bs-dismiss="modal" aria-label="Close"></button>
<div class="modal-body fw-bold" id="main_modal_body">Placeholder text</div> </div>
<div class="modal-footer justify-content-center"> <div class="modal-body fw-bold" id="lbl_confirmation_body">
<button type="button" class="btn btn-primary me-3" id="btn_confirm_left"> Placeholder text
Cancel </div>
</button> <div class="modal-footer justify-content-center">
<button type="button" class="btn btn-secondary" id="btn_confirm_right"> <button type="button" class="btn btn-primary me-3" id="btn_confirm_left">Cancel</button>
Confirm <button type="button" class="btn btn-secondary" id="btn_confirm_right">Confirm</button>
</button> </div>
</div> </div>
</div> </div>
</div> </div>
</div>
<div class="modal fade" id="main_notification_modal" tabindex="-1" aria-labelledby="main_lblmodal" aria-hidden="true"> <!-- Notification Modal -->
<div class="modal-dialog"> <div class="modal fade" id="mdl_notification" tabindex="-1" aria-labelledby="lbl_notification_title"
<div class="modal-content shadow-lg"> aria-hidden="true">
<div class="modal-header"> <div class="modal-dialog">
<h5 class="modal-title" id="main_notification_modal">Error</h5> <div class="modal-content shadow-lg">
<button type="button" class="btn-close" data-bs-dismiss="modal" aria-label="Close"></button> <div class="modal-header">
</div> <h5 class="modal-title" id="lbl_notification_title">Info</h5>
<div class="modal-body fs-6 fw-bold" id="main_notification_modal_body">Please contact EMSystems to solve the issue.</div> <button type="button" class="btn-close" data-bs-dismiss="modal" aria-label="Close"></button>
<div class="modal-footer justify-content-center"> </div>
<button type="button" id="btn_modal_close" class="btn btn-primary"> <div class="modal-body fs-6 fw-bold" id="lbl_notification_body">
Close Please contact EMSystems to solve the issue.
</button> </div>
<div class="modal-footer justify-content-center">
<button type="button" id="btn_modal_close" class="btn btn-primary">Close</button>
</div>
</div> </div>
</div> </div>
</div> </div>
</div> </div>
emT3Web/View.Main.pas
...@@ -3,37 +3,29 @@ unit View.Main; ...@@ -3,37 +3,29 @@ unit View.Main;
interface interface
uses uses
System.SysUtils, System.Classes, JS, Web, WEBLib.Graphics, WEBLib.Controls, System.SysUtils, System.Classes, JS, Web,
WEBLib.Forms, WEBLib.Dialogs, WEBLib.ExtCtrls, Vcl.Controls, Vcl.StdCtrls, WEBLib.Controls, WEBLib.Forms, WEBLib.ExtCtrls, WEBLib.StdCtrls,
WEBLib.StdCtrls, Data.DB, XData.Web.JsonDataset, XData.Web.Dataset, App.Types, ConnectionModule, XData.Web.Client, WEBLib.Dialogs, Vcl.StdCtrls,
App.Types, ConnectionModule, XData.Web.Client, WEBLib.Menus, Utils, View.Home; Vcl.Controls, Vcl.Graphics;
type type
TFViewMain = class(TWebForm) TFViewMain = class(TWebForm)
wllblLogout: TWebLinkLabel; pnlMain: TWebPanel;
WebPanel1: TWebPanel; lblUsername: TWebLabel;
WebMessageDlg1: TWebMessageDlg; lblUserProfile: TWebLinkLabel;
WebMemo1: TWebMemo; lblHome: TWebLinkLabel;
XDataWebClient: TXDataWebClient; lblLogout: TWebLinkLabel;
lblVersion: TWebLabel; lblVersion: TWebLabel;
lblAppTitle: TWebLabel; lblAppTitle: TWebLabel;
edtTaskIdMain: TWebEdit; xdwcMain: TXDataWebClient;
procedure WebFormCreate(Sender: TObject); procedure WebFormCreate(Sender: TObject);
procedure mnuLogoutClick(Sender: TObject); procedure lblLogoutClick(Sender: TObject);
procedure wllblLogoutClick(Sender: TObject); private
private FChildForm: TWebForm;
{ Private declarations }
FTasksHtmlForm: TWebForm;
FLogoutProc: TLogoutProc; FLogoutProc: TLogoutProc;
procedure ConfirmLogout; procedure ShowForm(aFormClass: TWebFormClass);
procedure LoadTasksHtmlForm;
procedure LoadHomeForm;
public public
{ Public declarations } class procedure Display(logoutProc: TLogoutProc);
FUserId: string;
FTaskId: string;
FCode: string;
class procedure Display(LogoutProc: TLogoutProc; const AUserId, ATaskId, ACode: string);
end; end;
var var
...@@ -43,92 +35,43 @@ implementation ...@@ -43,92 +35,43 @@ implementation
uses uses
Auth.Service, Auth.Service,
View.Test,
View.TasksHTML; View.TasksHTML;
{$R *.dfm} {$R *.dfm}
class procedure TFViewMain.Display(LogoutProc: TLogoutProc; const AUserId, ATaskId, ACode: string);
begin
if Assigned(FViewMain) then
FViewMain.Free;
FViewMain := TFViewMain.CreateNew;
FViewMain.FLogoutProc := LogoutProc;
FViewMain.FUserId := AUserId;
FViewMain.FTaskId := ATaskId;
FViewMain.FCode := ACode;
console.log('Main form values assigned after create');
console.log('UserId=' + FViewMain.FUserId);
console.log('TaskId=' + FViewMain.FTaskId);
console.log('Code=' + FViewMain.FCode);
end;
procedure TFViewMain.WebFormCreate(Sender: TObject); procedure TFViewMain.WebFormCreate(Sender: TObject);
var
userName: string;
begin begin
console.log('TFViewMain.WebFormCreate fired'); userName := JS.toString(AuthService.TokenPayload.Properties['user_name']);
lblAppTitle.Caption := 'emT3web'; lblUsername.Caption := userName;
lblVersion.Caption := 'v' + DMConnection.clientVersion; lblVersion.Caption := 'v' + DMConnection.clientVersion;
console.log('Main form values assigned in webformcreate'); ShowForm(TFTasksHTML);
console.log('UserId=' + FViewMain.FUserId);
console.log('TaskId=' + FViewMain.FTaskId);
console.log('Code=' + FViewMain.FCode);
LoadHomeForm;
// LoadTasksHtmlForm;
end; end;
procedure TFViewMain.lblLogoutClick(Sender: TObject);
procedure TFViewMain.mnuLogoutClick(Sender: TObject);
begin begin
ConfirmLogout; if Assigned(FLogoutProc) then
FLogoutProc('');
end; end;
procedure TFViewMain.ShowForm(aFormClass: TWebFormClass);
procedure TFViewMain.wllblLogoutClick(Sender: TObject);
begin begin
ConfirmLogout; if Assigned(FChildForm) then
FChildForm.Free;
Application.CreateForm(aFormClass, pnlMain.ElementID, FChildForm);
end; end;
class procedure TFViewMain.Display(logoutProc: TLogoutProc);
procedure TFViewMain.ConfirmLogout;
begin begin
ShowConfirmationModal( if Assigned(FViewMain) then
'End this session?.', FViewMain.Free;
'Yes', FViewMain := TFViewMain.CreateNew;
'No', FViewMain.FLogoutProc := logoutProc;
procedure(confirmed: Boolean)
begin
if confirmed and Assigned(FLogoutProc) then
FLogoutProc('');
end
);
end;
procedure TFViewMain.LoadTasksHtmlForm;
begin
if Assigned(FTasksHtmlForm) then
FTasksHtmlForm.Free;
console.log('About to create TFTasksHTML, host=' + WebPanel1.ElementID);
console.log('Main form task id is: ' + FTaskId);
FTasksHtmlForm := TFTasksHTML.CreateForm(WebPanel1.ElementID, FTaskId);
end; end;
procedure TFViewMain.LoadHomeForm; end.
begin
if Assigned(FTasksHtmlForm) then
FTasksHtmlForm.Free;
console.log('About to create TFHome, host=' + WebPanel1.ElementID);
console.log('Main form task id is: ' + FTaskId);
console.log('Main form user id is: ' + FUserId);
console.log('Main form code is: ' + FCode);
FTasksHtmlForm := TFHome.CreateForm(WebPanel1.ElementID, FTaskId, FUserId, FCode);
end;
end.
emT3Web/View.TasksHTML.dfm
...@@ -12,6 +12,7 @@ object FTasksHTML: TFTasksHTML ...@@ -12,6 +12,7 @@ object FTasksHTML: TFTasksHTML
Caption = 'Reload' Caption = 'Reload'
ElementID = 'btn_reload' ElementID = 'btn_reload'
HeightPercent = 100.000000000000000000 HeightPercent = 100.000000000000000000
TabStop = False
WidthPercent = 100.000000000000000000 WidthPercent = 100.000000000000000000
OnClick = btnReloadClick OnClick = btnReloadClick
end end
...@@ -24,9 +25,25 @@ object FTasksHTML: TFTasksHTML ...@@ -24,9 +25,25 @@ object FTasksHTML: TFTasksHTML
ChildOrder = 1 ChildOrder = 1
ElementID = 'btn_add_row' ElementID = 'btn_add_row'
HeightPercent = 100.000000000000000000 HeightPercent = 100.000000000000000000
TabStop = False
WidthPercent = 100.000000000000000000 WidthPercent = 100.000000000000000000
OnClick = btnAddRowClick OnClick = btnAddRowClick
end end
object btnDeleteRow: TWebButton
Left = 78
Top = 150
Width = 96
Height = 25
Caption = 'Delete Row'
ChildOrder = 2
ElementID = 'btn_delete_row'
ElementFont = efCSS
HeightStyle = ssAuto
HeightPercent = 100.000000000000000000
TabStop = False
WidthPercent = 100.000000000000000000
OnClick = btnDeleteRowClick
end
object xdwcTasks: TXDataWebClient object xdwcTasks: TXDataWebClient
Connection = DMConnection.ApiConnection Connection = DMConnection.ApiConnection
Left = 506 Left = 506
...@@ -38,6 +55,9 @@ object FTasksHTML: TFTasksHTML ...@@ -38,6 +55,9 @@ object FTasksHTML: TFTasksHTML
object xdwdsTaskstaskID: TStringField object xdwdsTaskstaskID: TStringField
FieldName = 'taskId' FieldName = 'taskId'
end end
object xdwdsTasksitemNum: TIntegerField
FieldName = 'itemNum'
end
object xdwdsTasksapplication: TStringField object xdwdsTasksapplication: TStringField
FieldName = 'application' FieldName = 'application'
end end
...@@ -68,7 +88,7 @@ object FTasksHTML: TFTasksHTML ...@@ -68,7 +88,7 @@ object FTasksHTML: TFTasksHTML
object xdwdsTasksnotes: TStringField object xdwdsTasksnotes: TStringField
FieldName = 'notes' FieldName = 'notes'
end end
object xdwdsTaskstaskItemId: TStringField object xdwdsTaskstaskItemId: TIntegerField
FieldName = 'taskItemId' FieldName = 'taskItemId'
end end
end end
......
emT3Web/View.TasksHTML.html
<div class="container-fluid p-2 d-flex flex-column h-100"> <div class="container-fluid p-2 d-flex flex-column h-100 overflow-hidden">
<div class="d-flex align-items-center justify-content-between mb-2 flex-shrink-0"> <div class="d-flex align-items-center justify-content-between mb-2 flex-shrink-0">
<h5 class="mb-0" id="lbl_project_name"></h5> <h5 class="mb-0" id="lbl_project_name"></h5>
<div class="d-flex gap-2">
<button id="btn_add_row" class="btn btn-sm btn-outline-success">Add Row</button> <div class="d-flex align-items-center gap-3">
<button id="btn_reload" class="btn btn-sm btn-outline-primary">Reload</button> <div id="lbl_total_rows"></div>
<div class="d-flex gap-2">
<button id="btn_add_row" class="btn btn-sm btn-success">Add Row</button>
<button id="btn_delete_row" class="btn btn-sm btn-danger">Delete Row</button>
<button id="btn_reload" class="btn btn-sm btn-primary">Reload</button>
</div>
</div> </div>
</div> </div>
<div id="tasks_table_host" class="flex-grow-1 min-vh-0"></div> <div id="tasks_table_host" class="flex-grow-1 min-h-0 overflow-auto"></div>
</div>
<div class="offcanvas offcanvas-end" tabindex="-1" id="offcanvasNameManager" aria-labelledby="nm_title">
<div class="offcanvas-header">
<h5 class="offcanvas-title" id="nm_title">Add Item</h5>
<button type="button" class="btn-close" data-bs-dismiss="offcanvas" aria-label="Close"></button>
</div>
<div class="offcanvas-body">
<div id="nm_existing_list" class="list-group mb-3"></div>
<div id="nm_add_wrap" class="d-none mb-3">
<input id="nm_name_input" type="text" class="form-control" maxlength="100">
<div id="nm_name_invalid" class="invalid-feedback d-none"></div>
<div class="d-flex justify-content-end mt-2">
<button id="btn_nm_save" type="button" class="btn btn-success">Save</button>
</div>
</div>
<button id="btn_nm_add_another" type="button" class="btn btn-secondary">
Add another item
</button>
</div>
</div>
</div>
emT3Web/css/app.css
/* Note: Base layout */ is-invalid .form-check-input {
html, body{ border: 1px solid #dc3545 !important;
height:100%;
margin:0;
} }
#wrapper{ .is-invalid .form-check-label {
height:100vh; color: #dc3545 !important;
display:flex;
flex-direction:column;
min-height:0;
} }
/* Note: Embedded forms must be allowed to shrink inside flex containers */ .btn-primary {
#main\.webpanel{ background-color: #286090 !important;
min-height:0; border-color: #286090 !important;
flex:1 1 auto; color: #fff !important;
display:flex;
flex-direction:column;
} }
#main\.webpanel > *{ .btn-primary:hover {
min-height:0; background-color: #204d74 !important;
border-color: #204d74 !important;
} }
/* Note: Primary button color */ @keyframes slideInLeft {
.btn-primary{ from {
background-color:#286090 !important; transform: translateX(-120%);
border-color:#286090 !important; opacity: 0;
color:#fff !important; }
to {
transform: translateX(0);
opacity: 1;
}
} }
.btn-primary:hover{ .toast.slide-in {
background-color:#204d74 !important; animation: slideInLeft 0.4s ease-out forwards;
border-color:#204d74 !important;
} }
/* Note: Navbar tweaks */ #spinner {
#view\.main\.apptitle{ position: fixed !important;
display:flex; z-index: 9999 !important;
align-items:center; top: 50%;
left: 50%;
transform: translate(-50%, -50%);
} }
/* This hides the up and down arrows on the item_num box, comment or remove it to add them back */
.navbar-nav .nav-link.active{ input[data-field="itemNum"]::-webkit-outer-spin-button,
color:#fff !important; input[data-field="itemNum"]::-webkit-inner-spin-button {
background-color:#004F84 !important; -webkit-appearance: none;
font-weight:700; margin: 0;
} }
.navbar-nav .nav-link:hover{ input[data-field="itemNum"] {
color:#fff !important; -moz-appearance: textfield;
background-color:#286090 !important; appearance: textfield;
} }
.navbar-toggler{ .tasks-vscroll {
display:none; height: 100%;
overflow: auto;
} }
/* Note: Dropdown menu items */ .tasks-vscroll thead th {
.dropdown-menu a{ position: sticky;
display:flex; top: 0;
align-items:center; z-index: 2;
width:100%; background: var(--bs-body-bg);
padding:.5rem 1rem;
color:#000;
text-decoration:none;
} }
.dropdown-menu a:hover{ .tasks-vscroll thead th.th-resize {
background-color:#204d74; z-index: 3;
color:#fff;
} }
.dropdown-menu a span{ span.card {
flex-grow:1; border: none;
} }
/* Note: Login card (used on login view) */
.login-card{
display:inline-block;
width:300px;
padding:0;
border-radius:10px;
box-shadow:0 4px 8px rgba(0,0,0,.1);
background-color:#fff;
}
/* Note: Validation helpers */
.is-invalid .form-check-input{
border:1px solid #dc3545 !important;
}
.is-invalid .form-check-label{
color:#dc3545 !important;
}
/* Note: Toast animation */
@keyframes slideInLeft{
from{transform:translateX(-120%);opacity:0;}
to{transform:translateX(0);opacity:1;}
}
.toast.slide-in{
animation:slideInLeft .4s ease-out forwards;
}
/* Note: Spinner overlay */
#spinner{
position:fixed !important;
z-index:9999 !important;
top:50%;
left:50%;
transform:translate(-50%,-50%);
}
/* Note: TasksHTML (table experiment) */
#tasks_table_host{
height:100%;
min-height:0;
}
#tasks_table_host .tasks-vscroll{
height:100%;
overflow-y:auto;
overflow-x:hidden;
}
#tasks_table_host .tasks-hscroll{
overflow-x:auto;
}
#tasks_table_host .tasks-hscroll table{
width:max-content;
min-width:100%;
table-layout:fixed;
}
#tasks_table_host thead th{
position:sticky;
top:0;
z-index:2;
background:var(--bs-body-bg);
}
#tasks_table_host td,
#tasks_table_host th{
padding:.25rem;
}
#tasks_table_host .nowrap-cell{white-space:nowrap;}
#tasks_table_host .wrap-cell{white-space:normal;word-break:break-word;}
#tasks_table_host .cell-input,
#tasks_table_host .cell-textarea{
border:0;
background:transparent;
border-radius:0;
padding:0;
margin:0;
box-shadow:none;
}
#tasks_table_host .cell-input:focus,
#tasks_table_host .cell-textarea:focus{
outline:0;
box-shadow:inset 0 -2px 0 var(--bs-primary);
}
#tasks_table_host .cell-textarea{
resize:none;
overflow:hidden;
white-space:pre-wrap;
}
/* Note: TasksDataGrid (TWebDataGrid experiment) */
#data_grid_tasks{
height:100%;
min-height:0;
}
#data_grid_tasks .ag-cell{
line-height:1.25;
padding-top:4px;
padding-bottom:4px;
}
#data_grid_tasks .ag-cell-inline-editing textarea{
line-height:1.25;
padding:4px 6px;
resize:none;
height:100%;
box-sizing:border-box;
}
emT3Web/emT3web.dpr
program emT3web; program emT3Web;
{$R *.dres}
uses uses
System.Classes,
Vcl.Forms, Vcl.Forms,
System.SysUtils,
JS,
Web,
XData.Web.Connection, XData.Web.Connection,
WEBLib.Dialogs, WEBLib.Dialogs,
Auth.Service in 'Auth.Service.pas', Auth.Service in 'Auth.Service.pas',
App.Types in 'App.Types.pas', App.Types in 'App.Types.pas',
ConnectionModule in 'ConnectionModule.pas' {DMConnection: TWebDataModule}, ConnectionModule in 'ConnectionModule.pas' {DMConnection: TWebDataModule},
View.Login in 'View.Login.pas' {FViewLogin: TWebForm} {*.html},
App.Config in 'App.Config.pas', App.Config in 'App.Config.pas',
View.Main in 'View.Main.pas' {FViewMain: TWebForm} {*.html}, View.Main in 'View.Main.pas' {FViewMain: TWebForm} {*.html},
Utils in 'Utils.pas', Utils in 'Utils.pas',
View.Test in 'View.Test.pas' {FTest: TWebForm} {*.html},
View.TasksHTML in 'View.TasksHTML.pas' {FTasksHTML: TWebForm} {*.html}, View.TasksHTML in 'View.TasksHTML.pas' {FTasksHTML: TWebForm} {*.html},
View.Home in 'View.Home.pas' {FHome: TWebForm} {*.html}; uNameManager in 'uNameManager.pas';
{$R *.res} {$R *.res}
procedure DisplayAccessDeniedModal(const ErrorMessage: string); procedure DoLogout(AMsg: string = ''); forward;
procedure DisplayMainView;
procedure ConnectProc;
begin
TFViewMain.Display(@DoLogout);
end;
begin begin
asm if not DMConnection.ApiConnection.Connected then
var dlg = document.createElement("dialog"); DMConnection.ApiConnection.Open(@ConnectProc)
dlg.classList.add("shadow", "rounded", "border", "p-4"); else
dlg.style.maxWidth = "500px"; ConnectProc;
dlg.style.width = "90%"; end;
dlg.style.fontFamily = "system-ui, sans-serif";
dlg.innerHTML = procedure Login(userId: string; taskId: string; urlCode: string);
"<h5 class='fw-bold mb-3 text-danger'>emT3web</h5>" + procedure LoginSuccess;
"<p class='mb-3' style='white-space: pre-wrap;'>" + ErrorMessage + "</p>" + begin
"<div class='text-end'>" + DisplayMainView;
"<button id='actionBtn' class='btn btn-primary'></button></div>"; end;
document.body.appendChild(dlg); procedure LoginError(AMsg: string);
dlg.showModal(); begin
ShowMessage('Login Error: ' + AMsg);
var btn = document.getElementById("actionBtn");
if (
(ErrorMessage.indexOf("Version mismatch") >= 0) ||
(ErrorMessage.indexOf("old version") >= 0)
) {
btn.textContent = "Reload";
btn.addEventListener("click", function () {
location.reload(true);
});
} else {
btn.textContent = "Close";
btn.addEventListener("click", function () {
dlg.close();
dlg.remove();
});
}
end; end;
begin
AuthService.Login( userId, taskId, urlCode,
@LoginSuccess,
@LoginError
);
end; end;
procedure DisplayLoginView(AMessage: string = '');
procedure DoLogin();
var
userIdParam: string;
taskIdParam: string;
codeParam: string;
begin begin
userIdParam := Application.Parameters.Values['user_id'];
taskIdParam := Application.Parameters.Values['task_id'];
codeParam := Application.Parameters.Values['url_code'];
AuthService.Logout; AuthService.Logout;
DMConnection.ApiConnection.Connected := False; DMConnection.ApiConnection.Connected := False;
if Assigned(FViewMain) then if Assigned(FViewMain) then
FViewMain.Free; FViewMain.Free;
Login( userIdParam, taskIdParam, codeParam );
if AMessage = '' then
DisplayAccessDeniedModal('Access requires a valid emt3 link. Please reopen from emt3.')
else
DisplayAccessDeniedModal(AMessage);
end; end;
procedure DisplayMainView(const AUserId, ATaskId, ACode: string);
procedure DoLogout(AMsg: string);
begin begin
TFViewMain.Display(@DisplayLoginView, AUserId, ATaskId, ACode); AuthService.Logout;
ShowMessage('Logout successful: ' + AMsg);
end; end;
procedure UnauthorizedAccessProc(AMessage: string); procedure UnauthorizedAccessProc(AMessage: string);
begin begin
DisplayLoginView(AMessage); ShowMessage('UnauthorizedAccessProc: ' + AMessage);
end; end;
procedure StartApplication; procedure StartApplication;
var var
userIdParam: string; ClientVer: string;
taskIdParam: string; dialogMsg: TStringList;
codeParam: string;
begin begin
userIdParam := Application.Parameters.Values['user_id']; ClientVer := TDMConnection.clientVersion;
taskIdParam := Application.Parameters.Values['task_id']; DMConnection.InitApp(
codeParam := Application.Parameters.Values['code']; procedure
DMConnection.SetClientConfig(
procedure(Success: Boolean; ErrorMessage: string)
begin begin
if not Success then DMConnection.SetClientConfig(
begin procedure(Success: Boolean; ErrorMessage: string)
DisplayAccessDeniedModal(ErrorMessage); begin
Exit; if Success then
end;
if AuthService.Authenticated and (not AuthService.TokenExpired) then
begin
DisplayMainView(userIdParam, taskIdParam, codeParam);
Exit;
end;
if (userIdParam <> '') and (taskIdParam <> '') and (codeParam <> '') then
begin
AuthService.Login(
userIdParam, taskIdParam, codeParam,
procedure
begin begin
DisplayMainView(userIdParam, taskIdParam, codeParam); DoLogin();
end,
procedure(LoginError: string)
begin
DisplayLoginView('Invalid or expired link.' + sLineBreak + LoginError);
end end
); else
Exit; begin
end; asm
var dlg = document.createElement("dialog");
DisplayLoginView; dlg.classList.add("shadow", "rounded", "border", "p-4");
end dlg.style.maxWidth = "500px";
dlg.style.width = "90%";
dlg.style.fontFamily = "system-ui, sans-serif";
dlg.innerHTML =
"<h5 class='fw-bold mb-3 text-danger'>emT3 web app</h5>" +
"<p class='mb-3' style='white-space: pre-wrap;'>" + ErrorMessage + "</p>" +
"<div class='text-end'>" +
"<button id='refreshBtn' class='btn btn-primary'>Reload</button></div>";
document.body.appendChild(dlg);
dlg.showModal();
document.getElementById("refreshBtn").addEventListener("click", function () {
var base = location.origin + location.pathname;
location.replace(base + "?ver=" + ClientVer + "&r=" + Date.now() + location.hash);
});
end;
end;
end);
end,
@UnauthorizedAccessProc
); );
end; end;
begin begin
Application.Initialize; Application.Initialize;
Application.MainFormOnTaskbar := True; Application.MainFormOnTaskbar := True;
Application.CreateForm(TDMConnection, DMConnection); Application.CreateForm(TDMConnection, DMConnection);
DMConnection.InitApp(@StartApplication, @UnauthorizedAccessProc); StartApplication;
Application.Run; Application.Run;
end. end.
emT3Web/emT3web.dproj
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003"> <Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup> <PropertyGroup>
<ProjectGuid>{DB6F5DBF-7E4B-45DA-AFFA-6C8DF15BA740}</ProjectGuid> <ProjectGuid>{DB6F5DBF-7E4B-45DA-AFFA-6C8DF15BA740}</ProjectGuid>
<ProjectVersion>20.3</ProjectVersion> <ProjectVersion>20.4</ProjectVersion>
<FrameworkType>VCL</FrameworkType> <FrameworkType>VCL</FrameworkType>
<MainSource>emT3web.dpr</MainSource> <MainSource>emT3Web.dpr</MainSource>
<Base>True</Base> <Base>True</Base>
<Config Condition="'$(Config)'==''">Debug</Config> <Config Condition="'$(Config)'==''">Debug</Config>
<Platform Condition="'$(Platform)'==''">Win32</Platform> <Platform Condition="'$(Platform)'==''">Win32</Platform>
<TargetedPlatforms>1</TargetedPlatforms> <TargetedPlatforms>1</TargetedPlatforms>
<AppType>Application</AppType> <AppType>Application</AppType>
<ProjectName Condition="'$(ProjectName)'==''">emT3web</ProjectName> <ProjectName Condition="'$(ProjectName)'==''">emT3Web</ProjectName>
</PropertyGroup> </PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Base' or '$(Base)'!=''"> <PropertyGroup Condition="'$(Config)'=='Base' or '$(Base)'!=''">
<Base>true</Base> <Base>true</Base>
...@@ -58,7 +58,7 @@ ...@@ -58,7 +58,7 @@
<DCC_Namespace>System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace)</DCC_Namespace> <DCC_Namespace>System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace)</DCC_Namespace>
<Icon_MainIcon>$(BDS)\bin\delphi_PROJECTICON.ico</Icon_MainIcon> <Icon_MainIcon>$(BDS)\bin\delphi_PROJECTICON.ico</Icon_MainIcon>
<Icns_MainIcns>$(BDS)\bin\delphi_PROJECTICNS.icns</Icns_MainIcns> <Icns_MainIcns>$(BDS)\bin\delphi_PROJECTICNS.icns</Icns_MainIcns>
<SanitizedProjectName>emT3web</SanitizedProjectName> <SanitizedProjectName>emT3Web</SanitizedProjectName>
<VerInfo_Locale>1046</VerInfo_Locale> <VerInfo_Locale>1046</VerInfo_Locale>
<TMSWebProject>2</TMSWebProject> <TMSWebProject>2</TMSWebProject>
<VerInfo_Keys>CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.802;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;LastCompiledTime=2018/07/25 12:57:53</VerInfo_Keys> <VerInfo_Keys>CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.802;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;LastCompiledTime=2018/07/25 12:57:53</VerInfo_Keys>
...@@ -100,9 +100,9 @@ ...@@ -100,9 +100,9 @@
<VerInfo_MinorVer>9</VerInfo_MinorVer> <VerInfo_MinorVer>9</VerInfo_MinorVer>
<VerInfo_Release>8</VerInfo_Release> <VerInfo_Release>8</VerInfo_Release>
<TMSUseJSDebugger>2</TMSUseJSDebugger> <TMSUseJSDebugger>2</TMSUseJSDebugger>
<TMSWebBrowser>1</TMSWebBrowser>
<TMSWebSingleInstance>1</TMSWebSingleInstance> <TMSWebSingleInstance>1</TMSWebSingleInstance>
<TMSWebOutputPath>..\emT3XDataServer\bin</TMSWebOutputPath> <TMSWebBrowser>1</TMSWebBrowser>
<TMSWebOutputPath>..\emT3XDataServer\bin\static</TMSWebOutputPath>
</PropertyGroup> </PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2)'!=''"> <PropertyGroup Condition="'$(Cfg_2)'!=''">
<DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols> <DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols>
...@@ -129,25 +129,22 @@ ...@@ -129,25 +129,22 @@
<Form>DMConnection</Form> <Form>DMConnection</Form>
<DesignClass>TWebDataModule</DesignClass> <DesignClass>TWebDataModule</DesignClass>
</DCCReference> </DCCReference>
<DCCReference Include="View.Login.pas">
<Form>FViewLogin</Form>
<DesignClass>TWebForm</DesignClass>
</DCCReference>
<DCCReference Include="App.Config.pas"/> <DCCReference Include="App.Config.pas"/>
<DCCReference Include="View.Main.pas"> <DCCReference Include="View.Main.pas">
<Form>FViewMain</Form> <Form>FViewMain</Form>
<DesignClass>TWebForm</DesignClass> <DesignClass>TWebForm</DesignClass>
</DCCReference> </DCCReference>
<DCCReference Include="Utils.pas"/> <DCCReference Include="Utils.pas"/>
<DCCReference Include="View.TasksHTML.pas"> <DCCReference Include="View.Test.pas">
<Form>FTasksHTML</Form> <Form>FTest</Form>
<DesignClass>TWebForm</DesignClass> <DesignClass>TWebForm</DesignClass>
</DCCReference> </DCCReference>
<DCCReference Include="View.Home.pas"> <DCCReference Include="View.TasksHTML.pas">
<Form>FHome</Form> <Form>FTasksHTML</Form>
<FormType>dfm</FormType> <FormType>dfm</FormType>
<DesignClass>TWebForm</DesignClass> <DesignClass>TWebForm</DesignClass>
</DCCReference> </DCCReference>
<DCCReference Include="uNameManager.pas"/>
<None Include="index.html"/> <None Include="index.html"/>
<None Include="css\app.css"/> <None Include="css\app.css"/>
<None Include="config\config.json"/> <None Include="config\config.json"/>
...@@ -170,22 +167,27 @@ ...@@ -170,22 +167,27 @@
<BorlandProject> <BorlandProject>
<Delphi.Personality> <Delphi.Personality>
<Source> <Source>
<Source Name="MainSource">emT3web.dpr</Source> <Source Name="MainSource">emT3Web.dpr</Source>
</Source> </Source>
<Excluded_Packages/> <Excluded_Packages>
<Excluded_Packages Name="$(BDSBIN)\bcboffice2k370.bpl">Embarcadero C++Builder Office 2000 Servers Package</Excluded_Packages>
<Excluded_Packages Name="$(BDSBIN)\bcbofficexp370.bpl">Embarcadero C++Builder Office XP Servers Package</Excluded_Packages>
<Excluded_Packages Name="$(BDSBIN)\dcloffice2k370.bpl">Microsoft Office 2000 Sample Automation Server Wrapper Components</Excluded_Packages>
<Excluded_Packages Name="$(BDSBIN)\dclofficexp370.bpl">Microsoft Office XP Sample Automation Server Wrapper Components</Excluded_Packages>
</Excluded_Packages>
</Delphi.Personality> </Delphi.Personality>
<Deployment Version="5"> <Deployment Version="5">
<DeployFile LocalName="Win32\Debug\emT3web.exe" Configuration="Debug" Class="ProjectOutput"> <DeployFile LocalName="Win32\Debug\emT3Web.exe" Configuration="Debug" Class="ProjectOutput">
<Platform Name="Win32"> <Platform Name="Win32">
<RemoteName>emT3web.exe</RemoteName> <RemoteName>emT3Web.exe</RemoteName>
<Overwrite>true</Overwrite> <Overwrite>true</Overwrite>
</Platform> </Platform>
</DeployFile> </DeployFile>
<DeployFile LocalName="Win32\Debug\webCharms.exe" Configuration="Debug" Class="ProjectOutput"/> <DeployFile LocalName="Win32\Debug\webCharms.exe" Configuration="Debug" Class="ProjectOutput"/>
<DeployFile LocalName="Win32\Debug\webKGOrders.exe" Configuration="Debug" Class="ProjectOutput"/> <DeployFile LocalName="Win32\Debug\webKGOrders.exe" Configuration="Debug" Class="ProjectOutput"/>
<DeployFile LocalName="Win32\Release\emT3web.exe" Configuration="Release" Class="ProjectOutput"> <DeployFile LocalName="Win32\Release\emT3Web.exe" Configuration="Release" Class="ProjectOutput">
<Platform Name="Win32"> <Platform Name="Win32">
<RemoteName>emT3web.exe</RemoteName> <RemoteName>emT3Web.exe</RemoteName>
<Overwrite>true</Overwrite> <Overwrite>true</Overwrite>
</Platform> </Platform>
</DeployFile> </DeployFile>
...@@ -909,6 +911,9 @@ ...@@ -909,6 +911,9 @@
<Platform Name="Win64x"> <Platform Name="Win64x">
<Operation>1</Operation> <Operation>1</Operation>
</Platform> </Platform>
<Platform Name="WinARM64EC">
<Operation>1</Operation>
</Platform>
</DeployClass> </DeployClass>
<DeployClass Name="ProjectiOSDeviceDebug"> <DeployClass Name="ProjectiOSDeviceDebug">
<Platform Name="iOSDevice32"> <Platform Name="iOSDevice32">
...@@ -979,6 +984,10 @@ ...@@ -979,6 +984,10 @@
<RemoteDir>Assets</RemoteDir> <RemoteDir>Assets</RemoteDir>
<Operation>1</Operation> <Operation>1</Operation>
</Platform> </Platform>
<Platform Name="WinARM64EC">
<RemoteDir>Assets</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass> </DeployClass>
<DeployClass Name="UWP_DelphiLogo44"> <DeployClass Name="UWP_DelphiLogo44">
<Platform Name="Win32"> <Platform Name="Win32">
...@@ -989,6 +998,10 @@ ...@@ -989,6 +998,10 @@
<RemoteDir>Assets</RemoteDir> <RemoteDir>Assets</RemoteDir>
<Operation>1</Operation> <Operation>1</Operation>
</Platform> </Platform>
<Platform Name="WinARM64EC">
<RemoteDir>Assets</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass> </DeployClass>
<DeployClass Name="iOS_AppStore1024"> <DeployClass Name="iOS_AppStore1024">
<Platform Name="iOSDevice64"> <Platform Name="iOSDevice64">
...@@ -1203,6 +1216,7 @@ ...@@ -1203,6 +1216,7 @@
<ProjectRoot Platform="Win32" Name="$(PROJECTNAME)"/> <ProjectRoot Platform="Win32" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="Win64" Name="$(PROJECTNAME)"/> <ProjectRoot Platform="Win64" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="Win64x" Name="$(PROJECTNAME)"/> <ProjectRoot Platform="Win64x" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="WinARM64EC" Name="$(PROJECTNAME)"/>
</Deployment> </Deployment>
<Platforms> <Platforms>
<Platform value="Win32">True</Platform> <Platform value="Win32">True</Platform>
......
emT3Web/index.html
<!DOCTYPE html> <!DOCTYPE html>
<html> <html>
<head> <head>
<meta http-equiv="Content-Type" content="text/html; charset=utf-8"/> <meta http-equiv="Content-Type" content="text/html; charset=utf-8"/>
<meta content="width=device-width, initial-scale=1" name="viewport"/> <meta content="width=device-width, initial-scale=1" name="viewport"/>
<noscript>Your browser does not support JavaScript!</noscript> <link href="data:;base64,=" rel="icon"/>
<link href="data:;base64,=" rel="icon"/> <title>emT3Web</title>
<title>Em Systems - emT3 Web</title> <link href="https://cdnjs.cloudflare.com/ajax/libs/flag-icon-css/2.3.1/css/flag-icon.min.css" rel="stylesheet"/>
<link href="https://fonts.googleapis.com/icon?family=Material+Icons" rel="stylesheet"/>
<link href="https://cdnjs.cloudflare.com/ajax/libs/flag-icon-css/2.3.1/css/flag-icon.min.css" rel="stylesheet"/> <link href="https://cdnjs.cloudflare.com/ajax/libs/font-awesome/5.15.0/css/all.min.css" rel="stylesheet"/>
<link href="https://fonts.googleapis.com/icon?family=Material+Icons" rel="stylesheet"/> <link href="css/app.css" rel="stylesheet"/>
<link href="https://cdnjs.cloudflare.com/ajax/libs/font-awesome/5.15.0/css/all.min.css" rel="stylesheet"/> <link href="css/spinner.css" rel="stylesheet"/>
<link href="css/app.css" rel="stylesheet" type="text/css"/>
<link href="css/spinner.css" rel="stylesheet" type="text/css"/> <script crossorigin="anonymous" integrity="sha256-eKhayi8LEQwp4NKxN+CfCh+3qOVUtJn3QNZ0TciWLP4=" src="https://code.jquery.com/jquery-3.7.1.js"></script>
<link crossorigin="anonymous" href="https://cdn.jsdelivr.net/npm/bootstrap@5.3.8/dist/css/bootstrap.min.css" rel="stylesheet"/>
<script crossorigin="anonymous" integrity="sha256-eKhayi8LEQwp4NKxN+CfCh+3qOVUtJn3QNZ0TciWLP4=" src="https://code.jquery.com/jquery-3.7.1.js"></script> <script src="https://cdn.jsdelivr.net/npm/bootstrap@5.3.8/dist/js/bootstrap.bundle.min.js"></script>
<script src="https://cdn.jsdelivr.net/npm/bootstrap@5.0.1/dist/js/bootstrap.bundle.min.js" type="text/javascript"></script>
<link crossorigin="anonymous" href="https://cdn.jsdelivr.net/npm/bootstrap@5.0.1/dist/css/bootstrap.min.css" rel="stylesheet"/> <script src="$(ProjectName).js"></script>
<script src="$(ProjectName).js" type="text/javascript"></script> </head>
</head> <body>
<body> <noscript>Your browser does not support JavaScript!</noscript>
</body> <script>rtl.run();</script>
</body>
<script type="text/javascript">rtl.run();</script>
</html> </html>
emT3WebApp/App.Config.pas deleted 100644 → 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']);
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.
emT3WebApp/App.Types.pas deleted 100644 → 0
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.
emT3WebApp/Auth.Service.pas deleted 100644 → 0
unit Auth.Service;
interface
uses
SysUtils, Web, JS,
XData.Web.Client;
const
TOKEN_NAME = 'EMT3_WEB_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, AClientVersion: 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, AClientVersion: 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 = '') then
begin
AError('Please enter a username and a password');
Exit;
end;
FClient.RawInvoke(
'IAuthService.Login', [AUser, APassword, AClientVersion],
@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
const parts = AToken.split('.');
if (parts.length === 3) { // <- strict compare
// JWTs use url-safe base64; convert before atob
Result = atob(parts[1].replace(/-/g,'+').replace(/_/g,'/'));
}
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.
emT3WebApp/ConnectionModule.dfm deleted 100644 → 0
object DMConnection: TDMConnection
Height = 264
Width = 395
object ApiConnection: TXDataWebConnection
URL = 'http://localhost:2004/emsys/emt3/api'
OnError = ApiConnectionError
OnRequest = ApiConnectionRequest
OnResponse = ApiConnectionResponse
Left = 48
Top = 80
end
object AuthConnection: TXDataWebConnection
URL = 'http://localhost:2004/emsys/emt3/auth'
OnError = AuthConnectionError
Left = 48
Top = 16
end
object XDataWebClient1: TXDataWebClient
Connection = AuthConnection
Left = 269
Top = 164
end
end
emT3WebApp/ConnectionModule.pas deleted 100644 → 0
unit ConnectionModule;
interface
uses
System.SysUtils, System.Classes, WEBLib.Modules, XData.Web.Connection,
App.Types, App.Config, XData.Web.Client, WEBLib.Dialogs;
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.8.2';
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;
{%CLASSGROUP 'Vcl.Controls.TControl'}
{$R *.dfm}
procedure TDMConnection.ApiConnectionError(Error: TXDataWebConnectionError);
var
errorMsg: string;
begin
errorMsg := Error.ErrorMessage;
if errorMsg = '' then
errorMsg := 'Connection error';
if Assigned(FUnauthorizedAccessProc) then
FUnauthorizedAccessProc(errorMsg)
else
ShowMessage(errorMsg);
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);
var
errorMsg: string;
begin
errorMsg := Error.ErrorMessage;
if errorMsg = '' then
errorMsg := 'Connection error';
if Assigned(FUnauthorizedAccessProc) then
FUnauthorizedAccessProc(errorMsg)
else
ShowMessage(errorMsg);
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.
emT3WebApp/Utils.pas deleted 100644 → 0
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);
procedure ShowToast(const MessageText: string; const ToastType: string = 'success');
procedure ShowConfirmationModal(msg, leftLabel, rightLabel: string; ConfirmProc: TProc<Boolean>);
procedure ShowNotificationModal(msg: 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;
procedure ShowNotificationModal(msg: string);
begin
asm
var modal = document.getElementById('main_notification_modal');
var label = document.getElementById('main_notification_modal_body');
var closeBtn = document.getElementById('btn_modal_close');
if (label) label.innerText = msg;
// Ensure modal is a direct child of <body>
if (modal && modal.parentNode !== document.body) {
document.body.appendChild(modal);
}
// Button simply closes the modal
if (closeBtn) {
closeBtn.onclick = function () {
var existing = bootstrap.Modal.getInstance(modal);
if (existing) {
existing.hide();
}
};
}
// Show the Bootstrap modal
var bsModal = new bootstrap.Modal(modal, { keyboard: false });
bsModal.show();
end;
end;
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;
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-primary');
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-primary');
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;
end.
emT3WebApp/View.Main.dfm deleted 100644 → 0
object FViewMain: TFViewMain
Width = 1322
Height = 764
CSSLibrary = cssBootstrap
ElementFont = efCSS
Font.Charset = ANSI_CHARSET
Font.Color = clBlack
Font.Height = -11
Font.Name = 'Arial'
Font.Style = []
ParentFont = False
OnCreate = WebFormCreate
object lblUsername: TWebLabel
Left = 536
Top = 4
Width = 49
Height = 14
Caption = 'Username'
ElementID = 'lbl_username'
ElementPosition = epRelative
HeightPercent = 100.000000000000000000
Transparent = False
WidthPercent = 100.000000000000000000
end
object lblUserProfile: TWebLinkLabel
Left = 529
Top = 21
Width = 59
Height = 14
ElementID = 'lbl_user_profile'
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
Caption = ' User Profile'
end
object lblLogout: TWebLinkLabel
Left = 547
Top = 55
Width = 36
Height = 14
ElementID = 'lbl_logout'
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
OnClick = lblLogoutClick
Caption = ' Logout'
end
object lblHome: TWebLinkLabel
Left = 556
Top = 38
Width = 27
Height = 14
ElementID = 'lbl_home'
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
Caption = 'Home'
end
object lblAppTitle: TWebLabel
Left = 57
Top = 33
Width = 48
Height = 14
Caption = 'emT3Web'
ElementID = 'lbl_app_title'
ElementPosition = epRelative
HeightPercent = 100.000000000000000000
Transparent = False
WidthPercent = 100.000000000000000000
end
object lblVersion: TWebLabel
Left = 536
Top = 71
Width = 47
Height = 14
Caption = 'lblVersion'
ElementID = 'lbl_version'
ElementFont = efCSS
ElementPosition = epRelative
HeightStyle = ssAuto
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
end
object pnlMain: TWebPanel
Left = 62
Top = 92
Width = 393
Height = 219
ElementID = 'pnl_main'
HeightStyle = ssAuto
WidthStyle = ssAuto
ChildOrder = 3
ElementFont = efCSS
ElementPosition = epIgnore
Font.Charset = ANSI_CHARSET
Font.Color = clBlack
Font.Height = -11
Font.Name = 'Arial'
Font.Style = []
ParentFont = False
Role = 'null'
TabOrder = 0
end
object xdwcMain: TXDataWebClient
Connection = DMConnection.ApiConnection
Left = 76
Top = 332
end
end
emT3WebApp/View.Main.html deleted 100644 → 0
<div id="div_wrapper">
<nav class="navbar navbar-expand-lg bg-body-tertiary border-bottom shadow-sm">
<div class="container-fluid">
<div class="d-flex align-items-center gap-2">
<a id="lbl_app_title" class="navbar-brand fw-semibold" href="index.html">emT3Web</a>
<span id="lbl_version" class="badge text-bg-light border text-muted fw-normal"></span>
</div>
<div class="collapse navbar-collapse show" id="pnl_navbar_nav_dropdown">
<ul class="navbar-nav ms-auto">
<li class="nav-item dropdown">
<a class="nav-link dropdown-toggle d-flex align-items-center gap-2" id="lnk_navbar_dropdown_menu_link"
role="button" data-bs-toggle="dropdown" aria-expanded="false">
<i class="fa fa-user fa-fw"></i>
<span id="lbl_username" class="fw-semibold">Username</span>
</a>
<ul class="dropdown-menu dropdown-menu-end shadow-sm" aria-labelledby="lnk_navbar_dropdown_menu_link">
<li>
<a class="dropdown-item d-flex align-items-center gap-2" id="lbl_home" href="#">
<i class="fa fa-home fa-fw"></i><span>Home</span>
</a>
</li>
<li>
<a class="dropdown-item d-flex align-items-center gap-2" id="lbl_user_profile" href="#">
<i class="fa fa-user fa-fw"></i><span>User Profile</span>
</a>
</li>
<li><hr class="dropdown-divider"></li>
<li>
<a class="dropdown-item d-flex align-items-center gap-2 text-danger" id="lbl_logout" href="#">
<i class="fa fa-sign-out fa-fw"></i><span>Logout</span>
</a>
</li>
</ul>
</li>
</ul>
</div>
</div>
</nav>
<!-- Toast -->
<div id="pnl_toast_wrapper" class="position-fixed top-0 start-0 mt-5 ms-4"
style="z-index: 1080; min-width: 300px; max-width: 500px;">
<div id="toast_bootstrap" class="toast align-items-center text-white bg-success border-0 shadow" role="alert"
aria-live="assertive" aria-atomic="true">
<div class="d-flex">
<div class="toast-body" id="lbl_bootstrap_toast_body">
Success message
</div>
<button type="button" class="btn-close btn-close-white me-2 m-auto" data-bs-dismiss="toast"
aria-label="Close"></button>
</div>
</div>
</div>
<!-- Main Panel (where all forms display) -->
<div class="container-fluid py-3 d-flex flex-column overflow-hidden" style="height: calc(100vh - 57px);">
<div id="pnl_main" class="flex-grow-1 min-h-0 overflow-hidden"></div>
</div>
<!-- Spinner Modal -->
<div id="div_spinner" class="position-absolute top-50 start-50 translate-middle d-none">
<div class="lds-roller">
<div></div><div></div><div></div><div></div>
<div></div><div></div><div></div><div></div>
</div>
</div>
<!-- Error Modal -->
<div class="modal fade" id="mdl_error" tabindex="-1" aria-labelledby="lbl_modal_title" aria-hidden="true">
<div class="modal-dialog">
<div class="modal-content shadow-lg">
<div class="modal-header">
<h5 class="modal-title" id="lbl_modal_title">Error</h5>
<button type="button" class="btn-close" data-bs-dismiss="modal" aria-label="Close"></button>
</div>
<div class="modal-body fs-6 fw-bold" id="lbl_modal_body">
Please contact EMSystems to solve the issue.
</div>
<div class="modal-footer justify-content-center">
<button type="button" id="btn_modal_restart" class="btn btn-primary">Back to Orders</button>
</div>
</div>
</div>
</div>
<!-- Confirmation Modal -->
<div class="modal fade" id="mdl_confirmation" tabindex="-1" aria-hidden="true">
<div class="modal-dialog">
<div class="modal-content shadow-lg">
<div class="modal-header">
<h5 class="modal-title">Confirm</h5>
<button type="button" class="btn-close" data-bs-dismiss="modal" aria-label="Close"></button>
</div>
<div class="modal-body fw-bold" id="lbl_confirmation_body">
Placeholder text
</div>
<div class="modal-footer justify-content-center">
<button type="button" class="btn btn-primary me-3" id="btn_confirm_left">Cancel</button>
<button type="button" class="btn btn-secondary" id="btn_confirm_right">Confirm</button>
</div>
</div>
</div>
</div>
<!-- Notification Modal -->
<div class="modal fade" id="mdl_notification" tabindex="-1" aria-labelledby="lbl_notification_title"
aria-hidden="true">
<div class="modal-dialog">
<div class="modal-content shadow-lg">
<div class="modal-header">
<h5 class="modal-title" id="lbl_notification_title">Info</h5>
<button type="button" class="btn-close" data-bs-dismiss="modal" aria-label="Close"></button>
</div>
<div class="modal-body fs-6 fw-bold" id="lbl_notification_body">
Please contact EMSystems to solve the issue.
</div>
<div class="modal-footer justify-content-center">
<button type="button" id="btn_modal_close" class="btn btn-primary">Close</button>
</div>
</div>
</div>
</div>
</div>
emT3WebApp/View.Main.pas deleted 100644 → 0
unit View.Main;
interface
uses
System.SysUtils, System.Classes, JS, Web,
WEBLib.Controls, WEBLib.Forms, WEBLib.ExtCtrls, WEBLib.StdCtrls,
App.Types, ConnectionModule, XData.Web.Client, WEBLib.Dialogs, Vcl.StdCtrls,
Vcl.Controls, Vcl.Graphics;
type
TFViewMain = class(TWebForm)
pnlMain: TWebPanel;
lblUsername: TWebLabel;
lblUserProfile: TWebLinkLabel;
lblHome: TWebLinkLabel;
lblLogout: TWebLinkLabel;
lblVersion: TWebLabel;
lblAppTitle: TWebLabel;
xdwcMain: TXDataWebClient;
procedure WebFormCreate(Sender: TObject);
procedure lblLogoutClick(Sender: TObject);
private
FChildForm: TWebForm;
FLogoutProc: TLogoutProc;
procedure ShowForm(aFormClass: TWebFormClass);
public
class procedure Display(logoutProc: TLogoutProc);
end;
var
FViewMain: TFViewMain;
implementation
uses
Auth.Service,
View.Test,
View.TasksHTML;
{$R *.dfm}
procedure TFViewMain.WebFormCreate(Sender: TObject);
var
userName: string;
begin
userName := JS.toString(AuthService.TokenPayload.Properties['user_name']);
lblUsername.Caption := userName;
lblVersion.Caption := 'v' + DMConnection.clientVersion;
ShowForm(TFTasksHTML);
end;
procedure TFViewMain.lblLogoutClick(Sender: TObject);
begin
if Assigned(FLogoutProc) then
FLogoutProc('');
end;
procedure TFViewMain.ShowForm(aFormClass: TWebFormClass);
begin
if Assigned(FChildForm) then
FChildForm.Free;
Application.CreateForm(aFormClass, pnlMain.ElementID, FChildForm);
end;
class procedure TFViewMain.Display(logoutProc: TLogoutProc);
begin
if Assigned(FViewMain) then
FViewMain.Free;
FViewMain := TFViewMain.CreateNew;
FViewMain.FLogoutProc := logoutProc;
end;
end.
emT3WebApp/View.TasksHTML.dfm deleted 100644 → 0
object FTasksHTML: TFTasksHTML
Width = 640
Height = 480
CSSLibrary = cssBootstrap
ElementFont = efCSS
OnCreate = WebFormCreate
object btnReload: TWebButton
Left = 78
Top = 88
Width = 96
Height = 25
Caption = 'Reload'
ElementID = 'btn_reload'
HeightPercent = 100.000000000000000000
TabStop = False
WidthPercent = 100.000000000000000000
OnClick = btnReloadClick
end
object btnAddRow: TWebButton
Left = 78
Top = 119
Width = 96
Height = 25
Caption = 'Add Row'
ChildOrder = 1
ElementID = 'btn_add_row'
HeightPercent = 100.000000000000000000
TabStop = False
WidthPercent = 100.000000000000000000
OnClick = btnAddRowClick
end
object btnDeleteRow: TWebButton
Left = 78
Top = 150
Width = 96
Height = 25
Caption = 'Delete Row'
ChildOrder = 2
ElementID = 'btn_delete_row'
ElementFont = efCSS
HeightStyle = ssAuto
HeightPercent = 100.000000000000000000
TabStop = False
WidthPercent = 100.000000000000000000
OnClick = btnDeleteRowClick
end
object xdwcTasks: TXDataWebClient
Connection = DMConnection.ApiConnection
Left = 506
Top = 92
end
object xdwdsTasks: TXDataWebDataSet
Left = 506
Top = 148
object xdwdsTaskstaskID: TStringField
FieldName = 'taskId'
end
object xdwdsTasksitemNum: TIntegerField
FieldName = 'itemNum'
end
object xdwdsTasksapplication: TStringField
FieldName = 'application'
end
object xdwdsTasksversion: TStringField
FieldName = 'version'
end
object xdwdsTaskstaskDate: TStringField
FieldName = 'taskDate'
end
object xdwdsTasksreportedBy: TStringField
FieldName = 'reportedBy'
end
object xdwdsTasksassignedTo: TStringField
FieldName = 'assignedTo'
end
object xdwdsTasksstatus: TStringField
FieldName = 'status'
end
object xdwdsTasksstatusDate: TStringField
FieldName = 'statusDate'
end
object xdwdsTasksformSection: TStringField
FieldName = 'formSection'
end
object xdwdsTasksissue: TStringField
FieldName = 'issue'
end
object xdwdsTasksnotes: TStringField
FieldName = 'notes'
end
object xdwdsTaskstaskItemId: TIntegerField
FieldName = 'taskItemId'
end
end
end
emT3WebApp/View.TasksHTML.html deleted 100644 → 0
<div class="container-fluid p-2 d-flex flex-column h-100 overflow-hidden">
<div class="d-flex align-items-center justify-content-between mb-2 flex-shrink-0">
<h5 class="mb-0" id="lbl_project_name"></h5>
<div class="d-flex align-items-center gap-3">
<div id="lbl_total_rows"></div>
<div class="d-flex gap-2">
<button id="btn_add_row" class="btn btn-sm btn-success">Add Row</button>
<button id="btn_delete_row" class="btn btn-sm btn-danger">Delete Row</button>
<button id="btn_reload" class="btn btn-sm btn-primary">Reload</button>
</div>
</div>
</div>
<div id="tasks_table_host" class="flex-grow-1 min-h-0 overflow-auto"></div>
<div class="offcanvas offcanvas-end" tabindex="-1" id="offcanvasNameManager" aria-labelledby="nm_title">
<div class="offcanvas-header">
<h5 class="offcanvas-title" id="nm_title">Add Item</h5>
<button type="button" class="btn-close" data-bs-dismiss="offcanvas" aria-label="Close"></button>
</div>
<div class="offcanvas-body">
<div id="nm_existing_list" class="list-group mb-3"></div>
<div id="nm_add_wrap" class="d-none mb-3">
<input id="nm_name_input" type="text" class="form-control" maxlength="100">
<div id="nm_name_invalid" class="invalid-feedback d-none"></div>
<div class="d-flex justify-content-end mt-2">
<button id="btn_nm_save" type="button" class="btn btn-success">Save</button>
</div>
</div>
<button id="btn_nm_add_another" type="button" class="btn btn-secondary">
Add another item
</button>
</div>
</div>
</div>
emT3WebApp/config/__history/config.json.~1~ deleted 100644 → 0
{
"AuthUrl" : "http://localhost:2001/emsys/template/auth/",
"ApiUrl" : "http://localhost:2001/emsys/template/api/"
}
emT3WebApp/config/config.json deleted 100644 → 0
{
"AuthUrl" : "http://localhost:2001/emsys/emt3/auth/",
"ApiUrl" : "http://localhost:2001/emsys/emt3/api/"
}
emT3WebApp/css/app.css deleted 100644 → 0
is-invalid .form-check-input {
border: 1px solid #dc3545 !important;
}
.is-invalid .form-check-label {
color: #dc3545 !important;
}
.btn-primary {
background-color: #286090 !important;
border-color: #286090 !important;
color: #fff !important;
}
.btn-primary:hover {
background-color: #204d74 !important;
border-color: #204d74 !important;
}
@keyframes slideInLeft {
from {
transform: translateX(-120%);
opacity: 0;
}
to {
transform: translateX(0);
opacity: 1;
}
}
.toast.slide-in {
animation: slideInLeft 0.4s ease-out forwards;
}
#spinner {
position: fixed !important;
z-index: 9999 !important;
top: 50%;
left: 50%;
transform: translate(-50%, -50%);
}
/* This hides the up and down arrows on the item_num box, comment or remove it to add them back */
input[data-field="itemNum"]::-webkit-outer-spin-button,
input[data-field="itemNum"]::-webkit-inner-spin-button {
-webkit-appearance: none;
margin: 0;
}
input[data-field="itemNum"] {
-moz-appearance: textfield;
appearance: textfield;
}
.tasks-vscroll {
height: 100%;
overflow: auto;
}
.tasks-vscroll thead th {
position: sticky;
top: 0;
z-index: 2;
background: var(--bs-body-bg);
}
.tasks-vscroll thead th.th-resize {
z-index: 3;
}
span.card {
border: none;
}
emT3WebApp/css/spinner.css deleted 100644 → 0
.lds-roller {
display: inline-block;
position: relative;
width: 80px;
height: 80px;
}
.lds-roller div {
animation: lds-roller 1.2s cubic-bezier(0.5, 0, 0.5, 1) infinite;
transform-origin: 40px 40px;
}
.lds-roller div:after {
content: " ";
display: block;
position: absolute;
width: 10px;
height: 10px;
border-radius: 50%;
background: #204d74;
margin: -5px 0 0 -5px;
}
.lds-roller div:nth-child(1) {
animation-delay: -0.036s;
}
.lds-roller div:nth-child(1):after {
top: 63px;
left: 63px;
}
.lds-roller div:nth-child(2) {
animation-delay: -0.072s;
}
.lds-roller div:nth-child(2):after {
top: 68px;
left: 56px;
}
.lds-roller div:nth-child(3) {
animation-delay: -0.108s;
}
.lds-roller div:nth-child(3):after {
top: 71px;
left: 48px;
}
.lds-roller div:nth-child(4) {
animation-delay: -0.144s;
}
.lds-roller div:nth-child(4):after {
top: 72px;
left: 40px;
}
.lds-roller div:nth-child(5) {
animation-delay: -0.18s;
}
.lds-roller div:nth-child(5):after {
top: 71px;
left: 32px;
}
.lds-roller div:nth-child(6) {
animation-delay: -0.216s;
}
.lds-roller div:nth-child(6):after {
top: 68px;
left: 24px;
}
.lds-roller div:nth-child(7) {
animation-delay: -0.252s;
}
.lds-roller div:nth-child(7):after {
top: 63px;
left: 17px;
}
.lds-roller div:nth-child(8) {
animation-delay: -0.288s;
}
.lds-roller div:nth-child(8):after {
top: 56px;
left: 12px;
}
@keyframes lds-roller {
0% {
transform: rotate(0deg);
}
100% {
transform: rotate(360deg);
}
}
emT3WebApp/emT3WebApp.dpr deleted 100644 → 0
program emT3WebApp;
uses
Vcl.Forms,
XData.Web.Connection,
WEBLib.Dialogs,
Auth.Service in 'Auth.Service.pas',
App.Types in 'App.Types.pas',
ConnectionModule in 'ConnectionModule.pas' {DMConnection: TWebDataModule},
App.Config in 'App.Config.pas',
View.Main in 'View.Main.pas' {FViewMain: TWebForm} {*.html},
Utils in 'Utils.pas',
View.Test in 'View.Test.pas' {FTest: TWebForm} {*.html},
View.TasksHTML in 'View.TasksHTML.pas' {FTasksHTML: TWebForm} {*.html},
uNameManager in 'uNameManager.pas';
{$R *.res}
procedure DoLogout(AMsg: string = ''); forward;
procedure DisplayMainView;
procedure ConnectProc;
begin
TFViewMain.Display(@DoLogout);
end;
begin
if not DMConnection.ApiConnection.Connected then
DMConnection.ApiConnection.Open(@ConnectProc)
else
ConnectProc;
end;
procedure Login(userId: string; taskId: string; urlCode: string);
procedure LoginSuccess;
begin
DisplayMainView;
end;
procedure LoginError(AMsg: string);
begin
ShowMessage('Login Error: ' + AMsg);
end;
begin
AuthService.Login( userId, taskId, urlCode,
@LoginSuccess,
@LoginError
);
end;
procedure DoLogin();
var
userIdParam: string;
taskIdParam: string;
codeParam: string;
begin
userIdParam := Application.Parameters.Values['user_id'];
taskIdParam := Application.Parameters.Values['task_id'];
codeParam := Application.Parameters.Values['url_code'];
AuthService.Logout;
DMConnection.ApiConnection.Connected := False;
if Assigned(FViewMain) then
FViewMain.Free;
Login( userIdParam, taskIdParam, codeParam );
end;
procedure DoLogout(AMsg: string);
begin
AuthService.Logout;
ShowMessage('Logout successful: ' + AMsg);
end;
procedure UnauthorizedAccessProc(AMessage: string);
begin
ShowMessage('UnauthorizedAccessProc: ' + AMessage);
end;
procedure StartApplication;
var
ClientVer: string;
begin
ClientVer := TDMConnection.clientVersion;
DMConnection.InitApp(
procedure
begin
DMConnection.SetClientConfig(
procedure(Success: Boolean; ErrorMessage: string)
begin
if Success then
begin
DoLogin();
end
else
begin
asm
var dlg = document.createElement("dialog");
dlg.classList.add("shadow", "rounded", "border", "p-4");
dlg.style.maxWidth = "500px";
dlg.style.width = "90%";
dlg.style.fontFamily = "system-ui, sans-serif";
dlg.innerHTML =
"<h5 class='fw-bold mb-3 text-danger'>kgOrders web app</h5>" +
"<p class='mb-3' style='white-space: pre-wrap;'>" + ErrorMessage + "</p>" +
"<div class='text-end'>" +
"<button id='refreshBtn' class='btn btn-primary'>Reload</button></div>";
document.body.appendChild(dlg);
dlg.showModal();
document.getElementById("refreshBtn").addEventListener("click", function () {
var base = location.origin + location.pathname;
location.replace(base + "?ver=" + ClientVer + "&r=" + Date.now() + location.hash);
});
end;
end;
end);
end,
@UnauthorizedAccessProc
);
end;
begin
Application.Initialize;
Application.MainFormOnTaskbar := True;
Application.CreateForm(TDMConnection, DMConnection);
StartApplication;
Application.Run;
end.
emT3WebApp/index.html deleted 100644 → 0
<!DOCTYPE html>
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=utf-8"/>
<meta content="width=device-width, initial-scale=1" name="viewport"/>
<link href="data:;base64,=" rel="icon"/>
<title>emT3Web</title>
<link href="https://cdnjs.cloudflare.com/ajax/libs/flag-icon-css/2.3.1/css/flag-icon.min.css" rel="stylesheet"/>
<link href="https://fonts.googleapis.com/icon?family=Material+Icons" rel="stylesheet"/>
<link href="https://cdnjs.cloudflare.com/ajax/libs/font-awesome/5.15.0/css/all.min.css" rel="stylesheet"/>
<link href="css/app.css" rel="stylesheet"/>
<link href="css/spinner.css" rel="stylesheet"/>
<script crossorigin="anonymous" integrity="sha256-eKhayi8LEQwp4NKxN+CfCh+3qOVUtJn3QNZ0TciWLP4=" src="https://code.jquery.com/jquery-3.7.1.js"></script>
<link crossorigin="anonymous" href="https://cdn.jsdelivr.net/npm/bootstrap@5.3.8/dist/css/bootstrap.min.css" rel="stylesheet"/>
<script src="https://cdn.jsdelivr.net/npm/bootstrap@5.3.8/dist/js/bootstrap.bundle.min.js"></script>
<script src="$(ProjectName).js"></script>
</head>
<body>
<noscript>Your browser does not support JavaScript!</noscript>
<script>rtl.run();</script>
</body>
</html>
emT3XDataServer/Source/Auth.ServiceImpl.pas
...@@ -91,7 +91,8 @@ begin ...@@ -91,7 +91,8 @@ begin
begin begin
Result.AddPair('error', Result.AddPair('error',
'Your browser is running an old version of the app.' + sLineBreak + 'Your browser is running an old version of the app.' + sLineBreak +
'Please click below to reload.'); 'Please click button to reload.' + sLineBreak + sLineBreak +
'if Error continues, then you need to Empty Cache and Hard Reload!');
end; end;
finally finally
iniFile.Free; iniFile.Free;
...@@ -99,20 +100,48 @@ begin ...@@ -99,20 +100,48 @@ begin
end; end;
function TAuthService.CheckUrlLogin(const userId, taskId, urlCode: string): Integer; function TAuthService.CheckUrlLogin(const userId, taskId, urlCode: string): Integer;
var
sql: string;
timeNow: TDateTime;
timeDiff: integer;
begin begin
Result := 0; Logger.Log(3, 'TAuthService.CheckUrlLogin(const userId, taskId, urlCode: string): Integer' );
sql := 'select u.USER_ID, u.USER_NAME, u.NAME, u.STATUS, u.EMAIL, u.ACCESS_LEVEL, ';
sql := sql + 'u.TASK_RIGHTS, u.PERSPECTIVE_ID, u.LAST_NAME, u.FIRST_NAME, w.URL_TIME, w.URL_TIME_EXP ';
sql := sql + 'from web_tasks_url w ';
sql := sql + 'join users u on u.USER_ID = w.USER_ID ';
sql := sql + 'where w.USER_ID = :USER_ID and w.TASK_ID = :TASK_ID and w.URL_CODE = :URL_CODE ';
//sql := sql + 'and TIMESTAMPDIFF(SECOND, w.URL_TIME, NOW()) between 0 and w.URL_TIME_EXP';
authDB.uqWebTasksUrl.Close; authDB.uqWebTasksUrl.Close;
authDB.uqWebTasksUrl.SQL.Text := sql;
authDB.uqWebTasksUrl.ParamByName('USER_ID').AsString := userId; authDB.uqWebTasksUrl.ParamByName('USER_ID').AsString := userId;
authDB.uqWebTasksUrl.ParamByName('TASK_ID').AsString := taskId; authDB.uqWebTasksUrl.ParamByName('TASK_ID').AsString := taskId;
authDB.uqWebTasksUrl.ParamByName('URL_CODE').AsString := urlCode; authDB.uqWebTasksUrl.ParamByName('URL_CODE').AsString := urlCode;
authDB.uqWebTasksUrl.Open; authDB.uqWebTasksUrl.Open;
if authDB.uqWebTasksUrl.IsEmpty then if authDB.uqWebTasksUrl.IsEmpty then
begin
Logger.Log(3, '--URL Login failed 0: authDB.uqWebTasksUrl.IsEmpty');
Result := 0;
Exit; Exit;
end;
if authDB.uqWebTasksUrl.FieldByName('STATUS').AsString <> 'ACTIVE' then if authDB.uqWebTasksUrlSTATUS.AsString <> 'ACTIVE' then
begin begin
Logger.Log(3, '--URL Login failed 1: authDB.uqWebTasksUrlSTATUS.AsString <> ACTIVE');
Result := 1;
Exit;
end;
timeNow := Now;
timeDiff := SecondsBetween( timeNow, authDB.uqWebTasksUrlURL_TIME.AsDateTime );
if timeDiff > authDB.uqWebTasksUrlURL_TIME_EXP.AsInteger then
begin
Logger.Log( 3, '--timeNow: ' + timeNow.ToString + ' -urlTime: ' + authDB.uqWebTasksUrlURL_TIME.AsString );
Logger.Log( 3, '--timeDiff: ' + IntToStr(timeDiff) + ' -timeExp (authDB.uqWebTasksUrlURL_TIME_EXP.AsInteger): ' + authDB.uqWebTasksUrlURL_TIME_EXP.AsString );
Logger.Log( 3, '--URL Login failed 2: timeDiff > timeExp' );
Result := 2; Result := 2;
Exit; Exit;
end; end;
...@@ -161,21 +190,27 @@ begin ...@@ -161,21 +190,27 @@ begin
if userState = 0 then if userState = 0 then
begin begin
Logger.Log(2, 'Login Error: Invalid code or expired link'); Logger.Log(2, 'Login Error: Invalid code');
raise EXDataHttpUnauthorized.Create('Invalid code or expired link'); raise EXDataHttpUnauthorized.Create('Invalid code');
end; end;
if userState = 2 then if userState = 1 then
begin begin
Logger.Log(2, 'Login Error: User not active!'); Logger.Log(2, 'Login Error: User not active!');
raise EXDataHttpUnauthorized.Create('User not active!'); raise EXDataHttpUnauthorized.Create('User not active!');
end; end;
if userState = 2 then
begin
Logger.Log(2, 'Login Error: Expired link');
raise EXDataHttpUnauthorized.Create('Expired link');
end;
jwt := TJWT.Create; jwt := TJWT.Create;
try try
jwt.Claims.JWTId := LowerCase(Copy(TUtils.GuidToVariant(TUtils.NewGuid), 2, 36)); jwt.Claims.JWTId := LowerCase(Copy(TUtils.GuidToVariant(TUtils.NewGuid), 2, 36));
jwt.Claims.IssuedAt := Now; jwt.Claims.IssuedAt := Now;
jwt.Claims.Expiration := IncHour(Now, 24); jwt.Claims.Expiration := IncHour(Now, 12);
jwt.Claims.SetClaimOfType<string>('user_id', Self.userId); jwt.Claims.SetClaimOfType<string>('user_id', Self.userId);
jwt.Claims.SetClaimOfType<string>('user_name', userName); jwt.Claims.SetClaimOfType<string>('user_name', userName);
......
emT3XDataServer/Source/Common.Config.pas
...@@ -3,7 +3,7 @@ unit Common.Config; ...@@ -3,7 +3,7 @@ unit Common.Config;
interface interface
const const
defaultServerUrl = 'http://localhost:2004/emsys/emt3'; defaultServerUrl = 'http://localhost:2001/emsys/emt3';
type type
TServerConfig = class TServerConfig = class
...@@ -78,10 +78,16 @@ begin ...@@ -78,10 +78,16 @@ begin
adminPassword := 'whatisthisusedfor'; adminPassword := 'whatisthisusedfor';
jwtTokenSecret := 'super_secret0123super_secret4567'; jwtTokenSecret := 'super_secret0123super_secret4567';
webAppFolder := 'static'; webAppFolder := 'static';
reportsFolder := 'static/'; reportsFolder := 'static\reports\';
ServerConfigStr := Bcl.Json.TJson.Serialize(ServerConfig); ServerConfigStr := Bcl.Json.TJson.Serialize(ServerConfig);
Logger.Log(1, '--ServerConfigSerialize: ' + ServerConfigStr); Logger.Log(1, '--ServerConfigSerialize: ' + ServerConfigStr);
Logger.Log(1, '--TServerConfig.Create - end'); Logger.Log(1, '--TServerConfig.Create - end');
end; end;
initialization
ServerConfig := TServerConfig.Create;
finalization
ServerConfig.Free;
end. end.
emT3XDataServer/Source/Common.Ini.pas 0 → 100644
unit Common.Ini;
interface
uses
System.SysUtils, System.IniFiles, Vcl.Forms;
type
TIniEntries = class
private
// [Settings]
FMemoLogLevel: Integer;
FFileLogLevel: Integer;
FLogFileNum: Integer;
FJWTSecret: string;
// [Database]
FDBServer: string;
FDBPort: Integer;
FDBDatabase: string;
FDBUsername: string;
FDBPassword: string;
public
constructor Create;
// Properties
property memoLogLevel: Integer read FMemoLogLevel;
property fileLogLevel: Integer read FFileLogLevel;
property logFileNum: Integer read FLogFileNum;
property dbServer: string read FDBServer;
property dbPort: Integer read FDBPort;
property dbDatabase: string read FDBDatabase;
property dbUsername: string read FDBUsername;
property dbPassword: string read FDBPassword;
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', 'ConsoleLogLevel', 3);
FFileLogLevel := iniFile.ReadInteger('Settings', 'FileLogLevel', 3);
FLogFileNum := iniFile.ReadInteger('Settings', 'LogFileNum', 0);
Inc(FLogFileNum);
iniFile.WriteInteger( 'Settings', 'LogFileNum', FlogFileNum );
// [Database]
FDBServer := iniFile.ReadString('Database', 'Server', '');
FDBPort := iniFile.ReadInteger('Database', 'Port', 0);
FDBDatabase := iniFile.ReadString('Database', 'Database', 'etask');
FDBUsername := iniFile.ReadString('Database', 'Username', 'root');
FDBPassword := iniFile.ReadString('Database', 'Password', 'emsys01');
finally
iniFile.Free;
end;
end;
end.
emT3XDataServer/Source/Main.dfm
...@@ -10,7 +10,6 @@ object FMain: TFMain ...@@ -10,7 +10,6 @@ object FMain: TFMain
Font.Height = -11 Font.Height = -11
Font.Name = 'Tahoma' Font.Name = 'Tahoma'
Font.Style = [] Font.Style = []
OnClose = FormClose
DesignSize = ( DesignSize = (
773 773
597) 597)
......
emT3XDataServer/Source/Main.pas
...@@ -20,16 +20,14 @@ type ...@@ -20,16 +20,14 @@ type
initTimer: TTimer; initTimer: TTimer;
btnAuthSwaggerUI: TButton; btnAuthSwaggerUI: TButton;
ExeInfo1: TExeInfo; ExeInfo1: TExeInfo;
procedure btnAuthSwaggerUIClick(Sender: TObject);
procedure btnApiSwaggerUIClick(Sender: TObject); procedure btnApiSwaggerUIClick(Sender: TObject);
procedure btnExitClick(Sender: TObject); procedure btnExitClick(Sender: TObject);
procedure ContactFormData(AText: String); procedure ContactFormData(AText: String);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure initTimerTimer(Sender: TObject); procedure initTimerTimer(Sender: TObject);
procedure btnAuthSwaggerUIClick(Sender: TObject);
strict private strict private
procedure StartServers; procedure StartServers;
procedure UpdateGUI;
end; end;
var var
...@@ -39,6 +37,7 @@ implementation ...@@ -39,6 +37,7 @@ implementation
uses uses
Common.Logging, Common.Logging,
Common.Ini,
Common.Config, Common.Config,
Sparkle.Utils, Sparkle.Utils,
Api.Database; Api.Database;
...@@ -61,13 +60,11 @@ begin ...@@ -61,13 +60,11 @@ begin
end); end);
end; end;
procedure TFMain.btnExitClick(Sender: TObject); procedure TFMain.btnExitClick(Sender: TObject);
begin begin
Close; Close;
end; end;
procedure TFMain.btnAuthSwaggerUIClick(Sender: TObject); procedure TFMain.btnAuthSwaggerUIClick(Sender: TObject);
begin begin
ShellExecute(Handle, 'open', PChar(TSparkleUtils.CombineUrlFast(AuthServerModule.XDataServer.BaseUrl, 'swaggerui')), nil, nil, SW_SHOWNORMAL); ShellExecute(Handle, 'open', PChar(TSparkleUtils.CombineUrlFast(AuthServerModule.XDataServer.BaseUrl, 'swaggerui')), nil, nil, SW_SHOWNORMAL);
...@@ -82,7 +79,6 @@ procedure TFMain.initTimerTimer(Sender: TObject); ...@@ -82,7 +79,6 @@ procedure TFMain.initTimerTimer(Sender: TObject);
begin begin
initTimer.Enabled := False; initTimer.Enabled := False;
Caption := Caption + ' ver ' + ExeInfo1.FileVersion; Caption := Caption + ' ver ' + ExeInfo1.FileVersion;
ServerConfig := TServerConfig.Create;
LoadServerConfig; LoadServerConfig;
StartServers; StartServers;
end; end;
...@@ -91,69 +87,66 @@ procedure TFMain.StartServers; ...@@ -91,69 +87,66 @@ procedure TFMain.StartServers;
var var
iniFile: TIniFile; iniFile: TIniFile;
iniStr: string; iniStr: string;
bStop: boolean;
devMode: boolean;
begin begin
Logger.Log( 1, '*******************************************************' ); bStop := False;
Logger.Log( 1, '* emT3XDataServer *' );
Logger.Log(1, Format(' Version: %s ', [FMain.ExeInfo1.FileVersion]));
Logger.Log( 1, '* Developed by EM Systems, Inc. *' );
Logger.Log( 1, '*******************************************************' );
Logger.Log( 1, '' );
iniFile := TIniFile.Create( ExtractFilePath(Application.ExeName) + 'emT3XDataServer.ini' );
try
Logger.Log( 1, 'iniFile: ' + ExtractFilePath(Application.ExeName) + 'emT3XDataServer.ini' );
Logger.Log( 1, '' ); iniFile := TIniFile.Create( ChangeFileExt(Application.ExeName, '.ini') );
Logger.Log(1, '--- Settings ---'); try
iniStr := iniFile.ReadString( 'Settings', 'MemoLogLevel', '' ); devMode := iniFile.ReadBool( 'Settings', 'devMode', True );
if iniStr.IsEmpty then Logger.Log( 1, 'devMode: ' + BoolToStr(devMode, True) );
Logger.Log( 1, '--Settings->memoLogLevel: Entry not found - default: 3' )
else
Logger.Log( 1, '--Settings->memoLogLevel: ' + iniStr );
iniStr := iniFile.ReadString( 'Settings', 'FileLogLevel', '' );
if iniStr.IsEmpty then
Logger.Log( 1, '--Settings->fileLogLevel: Entry not found - default: 4' )
else
Logger.Log( 1, '--Settings->fileLogLevel: ' + iniStr );
Logger.Log( 1, '' ); iniStr := iniFile.ReadString( 'Settings', 'webClientVersion', '' );
iniStr := iniFile.ReadString( 'Settings', 'LogFileNum', '' );
if iniStr.IsEmpty then if iniStr.IsEmpty then
Logger.Log( 1, '--Settings->LogFileNum: Entry not found' ) begin
Logger.Log( 1, '--Settings->WebClientVersion: Entry not found - ERROR: ini entry required!!!');
bStop := True;
end
else else
Logger.Log( 1, '--Settings->LogFileNum: ' + IntToStr(StrToInt(iniStr) - 1) ); Logger.Log( 1, '--Settings->WebClientVersion: ' + iniStr );
Logger.Log(1, '--- Database ---'); Logger.Log(1, '--- Database ---');
iniStr := IniFile.ReadString( 'Database', 'Server', '' ); iniStr := IniFile.ReadString( 'Database', 'Server', '' );
if iniStr.IsEmpty then if iniStr.IsEmpty then
Logger.Log( 1, '--Database->Server: Entry not found' ) begin
Logger.Log( 1, '----Database->Server: Entry not found - ERROR: ini entry required!!!' );
bStop := True;
end
else else
Logger.Log( 1, '--Database->Server: ' + iniStr ); Logger.Log( 1, '----Database->Server: ' + iniStr );
iniStr := iniFile.ReadString('Database', 'Database', ''); iniStr := iniFile.ReadString('Database', 'Database', '');
if iniStr.IsEmpty then if iniStr.IsEmpty then
Logger.Log( 1, '----Database->Database: Entry not found' ) Logger.Log( 1, '----Database->Database: ini entry not found - default: kg_order_entry' )
else else
Logger.Log( 1, '----Database->Database: ' + iniStr ); Logger.Log( 1, '----Database->Database: ini entry: ' + iniStr );
iniStr := iniFile.ReadString('Database', 'Username', ''); iniStr := iniFile.ReadString('Database', 'Username', '');
if iniStr.IsEmpty then if iniStr.IsEmpty then
Logger.Log( 1, '----Database->Username: Entry not found' ) Logger.Log( 1, '----Database->Username: Entry not found - default: root' )
else else
Logger.Log( 1, '----Database->Username: ' + iniStr ); Logger.Log( 1, '----Database->Username: ' + iniStr );
iniStr := iniFile.ReadString('Database', 'Password', ''); iniStr := iniFile.ReadString('Database', 'Password', '');
if iniStr.IsEmpty then if iniStr.IsEmpty then
Logger.Log( 1, '----Database->Password: Entry not found' ) Logger.Log( 1, '----Database->Password: Entry not found - default: xxxxxx' )
else else
Logger.Log( 1, '----Database->Password: xxxxxxxx' ); Logger.Log( 1, '----Database->Password: ini entry: xxxxxxxx' );
Logger.Log( 1, '' ); Logger.Log( 1, '' );
finally finally
IniFile.Free; IniFile.Free;
end; end;
if bStop then
begin
Logger.Log( 1, 'ini configuration error: Existing program!' );
if devMode then
MessageDlgPos( 'ini configuration error: Existing program!', mtConfirmation, [mbOk], 0, 250, 350 );
Close();
end;
AuthServerModule := TAuthServerModule.Create(Self); AuthServerModule := TAuthServerModule.Create(Self);
AuthServerModule.StartAuthServer(serverConfig.url, AUTH_MODEL); AuthServerModule.StartAuthServer(serverConfig.url, AUTH_MODEL);
...@@ -163,29 +156,7 @@ begin ...@@ -163,29 +156,7 @@ begin
AppServerModule := TAppServerModule.Create(Self); AppServerModule := TAppServerModule.Create(Self);
AppServerModule.StartAppServer( serverConfig.url ); AppServerModule.StartAppServer( serverConfig.url );
Logger.Log(1, 'Exe=' + Application.ExeName); Logger.Log(1, 'Exe=' + Application.ExeName);
UpdateGUI;
end; end;
procedure TFMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
ServerConfig.Free;
AuthServerModule.Free;
ApiServerModule.Free;
AppServerModule.Free;
end;
procedure TFMain.UpdateGUI;
begin
if AuthServerModule.SparkleHttpSysDispatcher.Active then
memoInfo.Lines.Add( 'AuthServer started at: ' + AuthServerModule.XDataServer.BaseUrl )
else
memoInfo.Lines.Add( 'AuthServer stopped' );
if ApiServerModule.SparkleHttpSysDispatcher.Active then
memoInfo.Lines.Add( 'ApiServer started at: ' + ApiServerModule.XDataServer.BaseUrl )
else
memoInfo.Lines.Add( 'ApiServer stopped' );
end;
end. end.
emT3XDataServer/bin/config/config.json deleted 100644 → 0
{
"AuthUrl" : "http://localhost:2001/emsys/emt3/auth/",
"ApiUrl" : "http://localhost:2001/emsys/emt3/api/"
}
emT3XDataServer/bin/css/app.css deleted 100644 → 0
/* Note: Base layout */
html, body{
height:100%;
margin:0;
}
#wrapper{
height:100vh;
display:flex;
flex-direction:column;
min-height:0;
}
/* Note: Embedded forms must be allowed to shrink inside flex containers */
#main\.webpanel{
min-height:0;
flex:1 1 auto;
display:flex;
flex-direction:column;
}
#main\.webpanel > *{
min-height:0;
}
/* Note: Primary button color */
.btn-primary{
background-color:#286090 !important;
border-color:#286090 !important;
color:#fff !important;
}
.btn-primary:hover{
background-color:#204d74 !important;
border-color:#204d74 !important;
}
/* Note: Navbar tweaks */
#view\.main\.apptitle{
display:flex;
align-items:center;
}
.navbar-nav .nav-link.active{
color:#fff !important;
background-color:#004F84 !important;
font-weight:700;
}
.navbar-nav .nav-link:hover{
color:#fff !important;
background-color:#286090 !important;
}
.navbar-toggler{
display:none;
}
/* Note: Dropdown menu items */
.dropdown-menu a{
display:flex;
align-items:center;
width:100%;
padding:.5rem 1rem;
color:#000;
text-decoration:none;
}
.dropdown-menu a:hover{
background-color:#204d74;
color:#fff;
}
.dropdown-menu a span{
flex-grow:1;
}
/* Note: Login card (used on login view) */
.login-card{
display:inline-block;
width:300px;
padding:0;
border-radius:10px;
box-shadow:0 4px 8px rgba(0,0,0,.1);
background-color:#fff;
}
/* Note: Validation helpers */
.is-invalid .form-check-input{
border:1px solid #dc3545 !important;
}
.is-invalid .form-check-label{
color:#dc3545 !important;
}
/* Note: Toast animation */
@keyframes slideInLeft{
from{transform:translateX(-120%);opacity:0;}
to{transform:translateX(0);opacity:1;}
}
.toast.slide-in{
animation:slideInLeft .4s ease-out forwards;
}
/* Note: Spinner overlay */
#spinner{
position:fixed !important;
z-index:9999 !important;
top:50%;
left:50%;
transform:translate(-50%,-50%);
}
/* Note: TasksHTML (table experiment) */
#tasks_table_host{
height:100%;
min-height:0;
}
#tasks_table_host .tasks-vscroll{
height:100%;
overflow-y:auto;
overflow-x:hidden;
}
#tasks_table_host .tasks-hscroll{
overflow-x:auto;
}
#tasks_table_host .tasks-hscroll table{
width:max-content;
min-width:100%;
table-layout:fixed;
}
#tasks_table_host thead th{
position:sticky;
top:0;
z-index:2;
background:var(--bs-body-bg);
}
#tasks_table_host td,
#tasks_table_host th{
padding:.25rem;
}
#tasks_table_host .nowrap-cell{white-space:nowrap;}
#tasks_table_host .wrap-cell{white-space:normal;word-break:break-word;}
#tasks_table_host .cell-input,
#tasks_table_host .cell-textarea{
border:0;
background:transparent;
border-radius:0;
padding:0;
margin:0;
box-shadow:none;
}
#tasks_table_host .cell-input:focus,
#tasks_table_host .cell-textarea:focus{
outline:0;
box-shadow:inset 0 -2px 0 var(--bs-primary);
}
#tasks_table_host .cell-textarea{
resize:none;
overflow:hidden;
white-space:pre-wrap;
}
/* Note: TasksDataGrid (TWebDataGrid experiment) */
#data_grid_tasks{
height:100%;
min-height:0;
}
#data_grid_tasks .ag-cell{
line-height:1.25;
padding-top:4px;
padding-bottom:4px;
}
#data_grid_tasks .ag-cell-inline-editing textarea{
line-height:1.25;
padding:4px 6px;
resize:none;
height:100%;
box-sizing:border-box;
}
emT3XDataServer/bin/css/spinner.css deleted 100644 → 0
.lds-roller {
display: inline-block;
position: relative;
width: 80px;
height: 80px;
}
.lds-roller div {
animation: lds-roller 1.2s cubic-bezier(0.5, 0, 0.5, 1) infinite;
transform-origin: 40px 40px;
}
.lds-roller div:after {
content: " ";
display: block;
position: absolute;
width: 10px;
height: 10px;
border-radius: 50%;
background: #204d74;
margin: -5px 0 0 -5px;
}
.lds-roller div:nth-child(1) {
animation-delay: -0.036s;
}
.lds-roller div:nth-child(1):after {
top: 63px;
left: 63px;
}
.lds-roller div:nth-child(2) {
animation-delay: -0.072s;
}
.lds-roller div:nth-child(2):after {
top: 68px;
left: 56px;
}
.lds-roller div:nth-child(3) {
animation-delay: -0.108s;
}
.lds-roller div:nth-child(3):after {
top: 71px;
left: 48px;
}
.lds-roller div:nth-child(4) {
animation-delay: -0.144s;
}
.lds-roller div:nth-child(4):after {
top: 72px;
left: 40px;
}
.lds-roller div:nth-child(5) {
animation-delay: -0.18s;
}
.lds-roller div:nth-child(5):after {
top: 71px;
left: 32px;
}
.lds-roller div:nth-child(6) {
animation-delay: -0.216s;
}
.lds-roller div:nth-child(6):after {
top: 68px;
left: 24px;
}
.lds-roller div:nth-child(7) {
animation-delay: -0.252s;
}
.lds-roller div:nth-child(7):after {
top: 63px;
left: 17px;
}
.lds-roller div:nth-child(8) {
animation-delay: -0.288s;
}
.lds-roller div:nth-child(8):after {
top: 56px;
left: 12px;
}
@keyframes lds-roller {
0% {
transform: rotate(0deg);
}
100% {
transform: rotate(360deg);
}
}
emT3XDataServer/bin/emT3XDataServer.ini → emT3XDataServer/bin/emT3XDataServer2.ini
[Settings] [Settings]
MemoLogLevel=4 MemoLogLevel=4
FileLogLevel=4 FileLogLevel=4
webClientVersion=0.8.2 webClientVersion=0.8.3
LogFileNum=176 LogFileNum=111
[Database] [Database]
Server=192.168.116.131
--Server=192.168.116.128 --Server=192.168.116.128
Server=192.168.102.131
--Server=192.168.75.133 --Server=192.168.75.133
--Server=192.168.159.10 --Server=192.168.159.10
Database=eTask Database=eTask
......
emT3XDataServer/bin/logs/emT3XDataServer0175.log deleted 100644 → 0
[2026-04-03 14:52:54.494][1] --TServerConfig.Create - start
[2026-04-03 14:52:54.494][1] --ServerConfigSerialize: null
[2026-04-03 14:52:54.504][1] --TServerConfig.Create - end
[2026-04-03 14:52:54.512][1] --LoadServerConfig - start
[2026-04-03 14:52:54.512][1] -- Config file: C:\Projects\emT3web\emT3XDataServer\bin\emT3XDataServer.json
[2026-04-03 14:52:54.512][1] -- Config file found.
[2026-04-03 14:52:54.528][1] --TServerConfig.Create - start
[2026-04-03 14:52:54.528][1] --ServerConfigSerialize: {"url":"http://localhost:2004/emsys/emt3","jwtTokenSecret":"super_secret0123super_secret4567","adminPassword":"whatisthisusedfor","webAppFolder":"static","reportsFolder":"static/"}
[2026-04-03 14:52:54.538][1] --TServerConfig.Create - end
[2026-04-03 14:52:54.543][1] -- localConfig loaded from config file
[2026-04-03 14:52:54.551][1] -- serverConfig.Free - called
[2026-04-03 14:52:54.556][1] -- serverConfig := localConfig - called
[2026-04-03 14:52:54.563][1] --- Server Config Values ---
[2026-04-03 14:52:54.563][1] -- url: http://localhost:2001/emsys/emt3 [from config]
[2026-04-03 14:52:54.575][1] -- adminPassword: whatisthisusedfor [default]
[2026-04-03 14:52:54.582][1] -- jwtTokenSecret: super_secret0123super_secret4567 [default]
[2026-04-03 14:52:54.589][1] -- webAppFolder: static [default]
[2026-04-03 14:52:54.596][1] -- serverConfig.reportsFolder: .\static\
[2026-04-03 14:52:54.603][1] --LoadServerConfig - end
[2026-04-03 14:52:54.612][1] *******************************************************
[2026-04-03 14:52:54.617][1] * emT3XDataServer *
[2026-04-03 14:52:54.624][1] Version: 0.8.0.0
[2026-04-03 14:52:54.634][1] * Developed by EM Systems, Inc. *
[2026-04-03 14:52:54.641][1] *******************************************************
[2026-04-03 14:52:54.656][1] iniFile: C:\Projects\emT3web\emT3XDataServer\bin\emT3XDataServer.ini
[2026-04-03 14:52:54.670][1] --- Settings ---
[2026-04-03 14:52:54.679][1] --Settings->memoLogLevel: 4
[2026-04-03 14:52:54.688][1] --Settings->fileLogLevel: 4
[2026-04-03 14:52:54.701][1] --Settings->LogFileNum: 175
[2026-04-03 14:52:54.713][1] --- Database ---
[2026-04-03 14:52:54.722][1] --Database->Server: 192.168.102.131
[2026-04-03 14:52:54.730][1] ----Database->Database: eTask
[2026-04-03 14:52:54.739][1] ----Database->Username: root
[2026-04-03 14:52:54.749][1] ----Database->Password: xxxxxxxx
[2026-04-03 14:52:54.824][1] Auth server module listening at "http://localhost:2001/emsys/emt3/auth"
[2026-04-03 14:52:54.828][1] API XDataServer.ModelName=Api
[2026-04-03 14:52:54.849][1] Api server module listening at "http://localhost:2001/emsys/emt3/api"
[2026-04-03 14:52:54.864][1] App server module listening at "http://localhost:2001/emsys/emt3/app", rootDir: static
[2026-04-03 14:52:54.868][1] Exe=C:\Projects\emT3web\emT3XDataServer\bin\emT3XDataServer.exe
emT3XDataServer/emT3XDataServer.dpr
...@@ -7,6 +7,7 @@ uses ...@@ -7,6 +7,7 @@ uses
Vcl.StdCtrls, Vcl.StdCtrls,
IniFiles, IniFiles,
Vcl.Forms, Vcl.Forms,
Vcl.Dialogs,
Api.Server.Module in 'Source\Api.Server.Module.pas' {ApiServerModule: TDataModule}, Api.Server.Module in 'Source\Api.Server.Module.pas' {ApiServerModule: TDataModule},
Main in 'Source\Main.pas' {FMain}, Main in 'Source\Main.pas' {FMain},
Common.Logging in 'Source\Common.Logging.pas', Common.Logging in 'Source\Common.Logging.pas',
...@@ -20,7 +21,8 @@ uses ...@@ -20,7 +21,8 @@ uses
Auth.ServiceImpl in 'Source\Auth.ServiceImpl.pas', Auth.ServiceImpl in 'Source\Auth.ServiceImpl.pas',
App.Server.Module in 'Source\App.Server.Module.pas' {AppServerModule: TDataModule}, App.Server.Module in 'Source\App.Server.Module.pas' {AppServerModule: TDataModule},
Api.Service in 'Source\Api.Service.pas', Api.Service in 'Source\Api.Service.pas',
Api.ServiceImpl in 'Source\Api.ServiceImpl.pas'; Api.ServiceImpl in 'Source\Api.ServiceImpl.pas',
Common.Ini in 'Source\Common.Ini.pas';
type type
TMemoLogAppender = class( TInterfacedObject, ILogAppender ) TMemoLogAppender = class( TInterfacedObject, ILogAppender )
...@@ -40,7 +42,7 @@ type ...@@ -40,7 +42,7 @@ type
FLogFile: string; FLogFile: string;
FCriticalSection: TCriticalSection; FCriticalSection: TCriticalSection;
public public
constructor Create(ALogLevel: Integer; AFilename: string); constructor Create(ALogLevel: Integer; AFilename: string; AFileNum: Integer);
destructor Destroy; override; destructor Destroy; override;
procedure Send(logLevel: Integer; Log: ILog); procedure Send(logLevel: Integer; Log: ILog);
end; end;
...@@ -85,10 +87,9 @@ begin ...@@ -85,10 +87,9 @@ begin
end; end;
{ TFileLogAppender } { TFileLogAppender }
constructor TFileLogAppender.Create(ALogLevel: integer; AFilename: string); constructor TFileLogAppender.Create(ALogLevel: integer; AFilename: string; AFileNum: integer);
var var
iniFile: TIniFile; iniFile: TIniFile;
fileNum: integer;
logsDir: string; logsDir: string;
begin begin
FLogLevel := ALogLevel; FLogLevel := ALogLevel;
...@@ -97,14 +98,7 @@ begin ...@@ -97,14 +98,7 @@ begin
if not DirectoryExists(logsDir) then if not DirectoryExists(logsDir) then
CreateDir(logsDir); CreateDir(logsDir);
iniFile := TIniFile.Create( ExtractFilePath(Application.ExeName) + 'emT3XDataServer.ini' ); FLogFile := logsDir + AFilename + Format( '%.4d', [AFileNum] ) + '.log';
try
fileNum := iniFile.ReadInteger( 'Settings', 'LogFileNum', 0 );
FLogFile := logsDir + AFilename + Format( '%.4d', [fileNum] ) + '.log';
iniFile.WriteInteger( 'Settings', 'LogFileNum', fileNum + 1 );
finally
iniFile.Free;
end;
end; end;
destructor TFileLogAppender.Destroy; destructor TFileLogAppender.Destroy;
...@@ -151,27 +145,60 @@ end; ...@@ -151,27 +145,60 @@ end;
{$R *.res} {$R *.res}
var var
iniFilename: string;
iniFile: TIniFile; iniFile: TIniFile;
memoLogLevel: Integer; //memoLogLevel: Integer;
fileLogLevel: Integer; //fileLogLevel: Integer;
//fileNum: Integer;
iniStr: string;
begin begin
ReportMemoryLeaksOnShutdown := True; ReportMemoryLeaksOnShutdown := True;
Application.Initialize; Application.Initialize;
Application.MainFormOnTaskbar := True; Application.MainFormOnTaskbar := True;
Application.CreateForm(TFMain, FMain); Application.CreateForm(TFMain, FMain);
iniFilename := ChangeFileExt( Application.ExeName, '.ini' );
iniFile := TIniFile.Create(ExtractFilePath(Application.ExeName) + 'emT3XDataServer.ini'); iniFile := TIniFile.Create( iniFilename );
try try
memoLogLevel := iniFile.ReadInteger('Settings', 'memoLogLevel', 3); LoadIniEntries;
fileLogLevel := iniFile.ReadInteger('Settings', 'fileLogLevel', 4); //memoLogLevel := iniFile.ReadInteger('Settings', 'MemoLogLevel', 3);
//fileLogLevel := iniFile.ReadInteger('Settings', 'FileLogLevel', 4);
//fileNum := iniFile.ReadInteger( 'Settings', 'LogFileNum', 0 );
Logger.AddAppender( TMemoLogAppender.Create(iniEntries.memoLogLevel, FMain.memoinfo) );
Logger.AddAppender( TFileLogAppender.Create(iniEntries.fileLogLevel, 'emT3XDataServer', iniEntries.logFileNum) );
Logger.Log( 1, '*******************************************************' );
Logger.Log( 1, '* emT3XDataServer *' );
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, 'iniFile: ' + iniFilename );
iniStr := iniFile.ReadString( 'Settings', 'MemoLogLevel', '' );
if iniStr.IsEmpty then
Logger.Log( 1, '--Settings->MemoLogLevel: ini entry not found - default: ' + IntToStr(iniEntries.memoLogLevel) )
else
Logger.Log( 1, '--Settings->MemoLogLevel: ini entry: ' + iniStr );
iniStr := iniFile.ReadString( 'Settings', 'FileLogLevel', '' );
if iniStr.IsEmpty then
Logger.Log( 1, '--Settings->FileLogLevel: ini entry not found - default: ' + IntToStr(iniEntries.fileLogLevel) )
else
Logger.Log( 1, '--Settings->FileLogLevel: ini entry: ' + iniStr );
Logger.Log( 1, '' );
iniStr := iniFile.ReadString( 'Settings', 'LogFileNum', '' );
if iniStr = '1' then
Logger.Log( 1, '--Settings->LogFileNum: ini entry not found - LogFileNum 1 added to iniFile' )
else
Logger.Log( 1, '--Settings->LogFileNum: ini entry: ' + iniStr );
finally finally
iniFile.Free; iniFile.Free;
end; end;
Logger.AddAppender(TMemoLogAppender.Create(memoLogLevel, FMain.memoinfo));
Logger.AddAppender(TFileLogAppender.Create(fileLogLevel, 'emT3XDataServer'));
Application.Run; Application.Run;
end. end.
emT3XDataServer/emT3XDataServer.dproj
...@@ -114,9 +114,10 @@ ...@@ -114,9 +114,10 @@
<VerInfo_Locale>1033</VerInfo_Locale> <VerInfo_Locale>1033</VerInfo_Locale>
<DCC_ExeOutput>.\bin</DCC_ExeOutput> <DCC_ExeOutput>.\bin</DCC_ExeOutput>
<DCC_UnitSearchPath>C:\RADTOOLS\FastMM4;$(DCC_UnitSearchPath)</DCC_UnitSearchPath> <DCC_UnitSearchPath>C:\RADTOOLS\FastMM4;$(DCC_UnitSearchPath)</DCC_UnitSearchPath>
<VerInfo_Keys>CompanyName=EM Systems;FileDescription=$(MSBuildProjectName);FileVersion=0.8.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=0.9.11;Comments=</VerInfo_Keys> <VerInfo_Keys>CompanyName=EM Systems;FileDescription=$(MSBuildProjectName);FileVersion=0.8.3.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=0.9.11;Comments=</VerInfo_Keys>
<VerInfo_MajorVer>0</VerInfo_MajorVer> <VerInfo_MajorVer>0</VerInfo_MajorVer>
<VerInfo_MinorVer>8</VerInfo_MinorVer> <VerInfo_MinorVer>8</VerInfo_MinorVer>
<VerInfo_Release>3</VerInfo_Release>
</PropertyGroup> </PropertyGroup>
<PropertyGroup Condition="'$(Cfg_1_Win64)'!=''"> <PropertyGroup Condition="'$(Cfg_1_Win64)'!=''">
<AppDPIAwarenessMode>PerMonitorV2</AppDPIAwarenessMode> <AppDPIAwarenessMode>PerMonitorV2</AppDPIAwarenessMode>
...@@ -161,12 +162,10 @@ ...@@ -161,12 +162,10 @@
<DCCReference Include="Source\Common.Config.pas"/> <DCCReference Include="Source\Common.Config.pas"/>
<DCCReference Include="Source\Auth.Server.Module.pas"> <DCCReference Include="Source\Auth.Server.Module.pas">
<Form>AuthServerModule</Form> <Form>AuthServerModule</Form>
<FormType>dfm</FormType>
<DesignClass>TDataModule</DesignClass> <DesignClass>TDataModule</DesignClass>
</DCCReference> </DCCReference>
<DCCReference Include="Source\Auth.Database.pas"> <DCCReference Include="Source\Auth.Database.pas">
<Form>AuthDatabase</Form> <Form>AuthDatabase</Form>
<FormType>dfm</FormType>
<DesignClass>TDataModule</DesignClass> <DesignClass>TDataModule</DesignClass>
</DCCReference> </DCCReference>
<DCCReference Include="Source\uLibrary.pas"/> <DCCReference Include="Source\uLibrary.pas"/>
...@@ -174,11 +173,11 @@ ...@@ -174,11 +173,11 @@
<DCCReference Include="Source\Auth.ServiceImpl.pas"/> <DCCReference Include="Source\Auth.ServiceImpl.pas"/>
<DCCReference Include="Source\App.Server.Module.pas"> <DCCReference Include="Source\App.Server.Module.pas">
<Form>AppServerModule</Form> <Form>AppServerModule</Form>
<FormType>dfm</FormType>
<DesignClass>TDataModule</DesignClass> <DesignClass>TDataModule</DesignClass>
</DCCReference> </DCCReference>
<DCCReference Include="Source\Api.Service.pas"/> <DCCReference Include="Source\Api.Service.pas"/>
<DCCReference Include="Source\Api.ServiceImpl.pas"/> <DCCReference Include="Source\Api.ServiceImpl.pas"/>
<DCCReference Include="Source\Common.Ini.pas"/>
<BuildConfiguration Include="Base"> <BuildConfiguration Include="Base">
<Key>Base</Key> <Key>Base</Key>
</BuildConfiguration> </BuildConfiguration>
......
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