Skip to content

E
emWebAppTemplate
Commit ce430b39 by Mac Stephens
Options

WIP change to new VM

parent 7c54b21d
Showing with 94 additions and 127 deletions
templateWebApp/Auth.Service.pas
......@@ -4,7 +4,7 @@ interface
uses
SysUtils, Web, JS,
XData.Web.Client;
XData.Web.Client, App.Types;
const
TOKEN_NAME = 'EMSYS_TEMPLATE_TOKEN';
......@@ -23,8 +23,8 @@ type
public
constructor Create; reintroduce;
destructor Destroy; override;
procedure Login(AUser, APassword, AClientVersion: string; ASuccess: TOnLoginSuccess;
AError: TOnLoginError);
procedure Login(AUser, APassword, AClientVersion: string; ASuccess: TOnLoginSuccess; AError: TOnLoginError);
procedure VerifyClientVersion(AVersion: string; ACallback: TVersionCheckCallback);
procedure Logout;
function GetToken: string;
function Authenticated: Boolean;
......@@ -91,6 +91,38 @@ begin
Result := window.localStorage.getItem(TOKEN_NAME);
end;
procedure TAuthService.VerifyClientVersion(AVersion: string; ACallback: TVersionCheckCallback);
procedure OnLoad(Response: TXDataClientResponse);
var
JsonResult: TJSObject;
ErrorMsg: string;
begin
JsonResult := TJSObject(Response.Result);
if JsonResult.HasOwnProperty('error') then
ErrorMsg := string(JsonResult['error'])
else
ErrorMsg := '';
if ErrorMsg <> '' then
ACallback(False, ErrorMsg)
else
ACallback(True, '');
end;
procedure OnError(Error: TXDataClientError);
begin
ACallback(False, Format('%s: %s', [Error.ErrorCode, Error.ErrorMessage]));
end;
begin
FClient.RawInvoke('IAuthService.VerifyVersion', [AVersion], @OnLoad, @OnError);
end;
procedure TAuthService.Login(AUser, APassword, AClientVersion: string; ASuccess: TOnLoginSuccess;
AError: TOnLoginError);
......
templateWebApp/ConnectionModule.dfm
......@@ -15,9 +15,4 @@ object DMConnection: TDMConnection
Left = 48
Top = 16
end
object XDataWebClient1: TXDataWebClient
Connection = AuthConnection
Left = 269
Top = 164
end
end
templateWebApp/ConnectionModule.pas
......@@ -10,7 +10,6 @@ type
TDMConnection = class(TWebDataModule)
ApiConnection: TXDataWebConnection;
AuthConnection: TXDataWebConnection;
XDataWebClient1: TXDataWebClient;
procedure ApiConnectionError(Error: TXDataWebConnectionError);
procedure ApiConnectionRequest(Args: TXDataWebConnectionRequest);
procedure ApiConnectionResponse(Args: TXDataWebConnectionResponse);
......@@ -22,7 +21,6 @@ type
const clientVersion = '0.0.1';
procedure InitApp(SuccessProc: TSuccessProc;
UnauthorizedAccessProc: TUnauthorizedAccessProc);
procedure SetClientConfig(Callback: TVersionCheckCallback);
end;
var
......@@ -106,29 +104,4 @@ begin
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.
templateWebApp/Utils.pas
......@@ -16,7 +16,7 @@ procedure ApplyReportTitle(CurrentReportType: string);
procedure ShowToast(const MessageText: string; const ToastType: string = 'success');
procedure ShowConfirmationModal(msg, leftLabel, rightLabel: string; ConfirmProc: TProc<Boolean>);
procedure ShowNotificationModal(msg: string);
// function FormatDollarValue(ValueStr: string): string;
procedure ShowVersionMismatchAndReload(const ErrorText, ClientVersion: string);
implementation
......@@ -330,23 +330,43 @@ begin
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
procedure ShowVersionMismatchAndReload(const ErrorText, ClientVersion: string);
begin
asm
var dlg = document.createElement('dialog');
dlg.style.padding = '1rem';
dlg.style.maxWidth = '520px';
dlg.style.border = '1px solid #ccc';
dlg.style.borderRadius = '8px';
var title = document.createElement('h3');
title.textContent = 'template web app';
title.style.marginTop = '0';
var msg = document.createElement('pre');
msg.textContent = ErrorText;
msg.style.whiteSpace = 'pre-wrap';
msg.style.fontFamily = 'inherit';
var btnRow = document.createElement('div');
btnRow.style.display = 'flex';
btnRow.style.justifyContent = 'flex-end';
btnRow.style.marginTop = '1rem';
var btn = document.createElement('button');
btn.textContent = 'Reload';
btn.onclick = function () {
window.location.reload();
};
// // 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;
btnRow.appendChild(btn);
dlg.appendChild(title);
dlg.appendChild(msg);
dlg.appendChild(btnRow);
document.body.appendChild(dlg);
dlg.showModal();
end;
end;
end.
templateWebApp/templateWebApp.dpr
......@@ -33,8 +33,7 @@ begin
ConnectProc;
end;
procedure DisplayLoginView(AMessage: string);
procedure DisplayLoginView(AMessage: string = '');
begin
AuthService.Logout;
DMConnection.ApiConnection.Connected := False;
......@@ -43,67 +42,35 @@ begin
TFViewLogin.Display(@DisplayMainView, AMessage);
end;
procedure UnauthorizedAccessProc(AMessage: string);
begin
DisplayLoginView(AMessage);
end;
procedure StartApplication;
var
ClientVer: string;
procedure AfterVerifyClientVersion(Success: Boolean; Error: string);
begin
ClientVer := TDMConnection.clientVersion;
DMConnection.InitApp(
procedure
begin
DMConnection.SetClientConfig(
procedure(Success: Boolean; ErrorMessage: string)
begin
if Success then
begin
if (not AuthService.Authenticated) or AuthService.TokenExpired then
DisplayLoginView
else
DisplayMainView;
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();
if not Success then
begin
ShowVersionMismatchAndReload(Error, DMConnection.clientVersion);
Exit;
end;
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
);
if (not AuthService.Authenticated) or AuthService.TokenExpired then
DisplayLoginView
else
DisplayMainView;
end;
procedure StartApplication;
begin
AuthService.VerifyClientVersion(DMConnection.clientVersion, @AfterVerifyClientVersion);
end;
begin
Application.Initialize;
Application.MainFormOnTaskbar := True;
Application.CreateForm(TDMConnection, DMConnection);
StartApplication;
Application.Run;
DMConnection.InitApp(@StartApplication, @UnauthorizedAccessProc);
end.
templateWebApp/templateWebApp.dproj
......@@ -912,9 +912,6 @@
<Platform Name="Win64x">
<Operation>1</Operation>
</Platform>
<Platform Name="WinARM64EC">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectiOSDeviceDebug">
<Platform Name="iOSDevice32">
......@@ -985,10 +982,6 @@
<RemoteDir>Assets</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="WinARM64EC">
<RemoteDir>Assets</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="UWP_DelphiLogo44">
<Platform Name="Win32">
......@@ -999,10 +992,6 @@
<RemoteDir>Assets</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="WinARM64EC">
<RemoteDir>Assets</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iOS_AppStore1024">
<Platform Name="iOSDevice64">
......
templateXDataServer/bin/templateXDataServer.ini
[Settings]
MemoLogLevel=5
FileLogLevel=5
LogFileNum=31
LogFileNum=39
DevMode=0
webClientVersion=0.0.1
[Database]
--Server=192.168.116.129
--Server=
Server=192.168.102.131
--Port=
--Database=
Database=sleepdb
--Username=
--Password=
......
templateXDataServer/source/Auth.Database.pas
......@@ -53,7 +53,7 @@ begin
except
on E: Exception do
begin
Logger.Log(2, '--TAuthDatabase.DataModuleCreate -Error connecting to database: ' + E.Message);
Logger.Log(1, '--TAuthDatabase.DataModuleCreate -Error connecting to database: ' + E.Message);
end;
end;
end;
......
templateXDataServer/source/Auth.ServiceImpl.pas
......@@ -72,6 +72,7 @@ begin
end;
end;
function TAuthService.VerifyVersion(clientVersion: string): TJSONObject;
var
webClientVersion: string;
......@@ -101,6 +102,7 @@ begin
end;
end;
function TAuthService.Login(const username, password, clientVersion: string): string;
var
sql: string;
......
templateXDataServer/templateXDataServer.dproj
......@@ -831,9 +831,6 @@
<Platform Name="Win64x">
<Operation>1</Operation>
</Platform>
<Platform Name="WinARM64EC">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectiOSDeviceDebug">
<Platform Name="iOSDevice32">
......@@ -904,10 +901,6 @@
<RemoteDir>Assets</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="WinARM64EC">
<RemoteDir>Assets</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="UWP_DelphiLogo44">
<Platform Name="Win32">
......@@ -918,10 +911,6 @@
<RemoteDir>Assets</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="WinARM64EC">
<RemoteDir>Assets</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iOS_AppStore1024">
<Platform Name="iOSDevice64">
......
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