Commit ce430b39 by Mac Stephens

WIP change to new VM

parent 7c54b21d
...@@ -4,7 +4,7 @@ interface ...@@ -4,7 +4,7 @@ interface
uses uses
SysUtils, Web, JS, SysUtils, Web, JS,
XData.Web.Client; XData.Web.Client, App.Types;
const const
TOKEN_NAME = 'EMSYS_TEMPLATE_TOKEN'; TOKEN_NAME = 'EMSYS_TEMPLATE_TOKEN';
...@@ -23,8 +23,8 @@ type ...@@ -23,8 +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(AUser, APassword, AClientVersion: string; ASuccess: TOnLoginSuccess; AError: TOnLoginError);
AError: TOnLoginError); procedure VerifyClientVersion(AVersion: string; ACallback: TVersionCheckCallback);
procedure Logout; procedure Logout;
function GetToken: string; function GetToken: string;
function Authenticated: Boolean; function Authenticated: Boolean;
...@@ -91,6 +91,38 @@ begin ...@@ -91,6 +91,38 @@ begin
Result := window.localStorage.getItem(TOKEN_NAME); Result := window.localStorage.getItem(TOKEN_NAME);
end; 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; procedure TAuthService.Login(AUser, APassword, AClientVersion: string; ASuccess: TOnLoginSuccess;
AError: TOnLoginError); AError: TOnLoginError);
......
...@@ -15,9 +15,4 @@ object DMConnection: TDMConnection ...@@ -15,9 +15,4 @@ object DMConnection: TDMConnection
Left = 48 Left = 48
Top = 16 Top = 16
end end
object XDataWebClient1: TXDataWebClient
Connection = AuthConnection
Left = 269
Top = 164
end
end end
...@@ -10,7 +10,6 @@ type ...@@ -10,7 +10,6 @@ type
TDMConnection = class(TWebDataModule) TDMConnection = class(TWebDataModule)
ApiConnection: TXDataWebConnection; ApiConnection: TXDataWebConnection;
AuthConnection: TXDataWebConnection; AuthConnection: TXDataWebConnection;
XDataWebClient1: TXDataWebClient;
procedure ApiConnectionError(Error: TXDataWebConnectionError); procedure ApiConnectionError(Error: TXDataWebConnectionError);
procedure ApiConnectionRequest(Args: TXDataWebConnectionRequest); procedure ApiConnectionRequest(Args: TXDataWebConnectionRequest);
procedure ApiConnectionResponse(Args: TXDataWebConnectionResponse); procedure ApiConnectionResponse(Args: TXDataWebConnectionResponse);
...@@ -22,7 +21,6 @@ type ...@@ -22,7 +21,6 @@ type
const clientVersion = '0.0.1'; const clientVersion = '0.0.1';
procedure InitApp(SuccessProc: TSuccessProc; procedure InitApp(SuccessProc: TSuccessProc;
UnauthorizedAccessProc: TUnauthorizedAccessProc); UnauthorizedAccessProc: TUnauthorizedAccessProc);
procedure SetClientConfig(Callback: TVersionCheckCallback);
end; end;
var var
...@@ -106,29 +104,4 @@ begin ...@@ -106,29 +104,4 @@ begin
end; 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. end.
...@@ -16,7 +16,7 @@ procedure ApplyReportTitle(CurrentReportType: string); ...@@ -16,7 +16,7 @@ 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; procedure ShowVersionMismatchAndReload(const ErrorText, ClientVersion: string);
implementation implementation
...@@ -330,23 +330,43 @@ begin ...@@ -330,23 +330,43 @@ begin
end; end;
// Used html number input type to restrict the input instead of this function procedure ShowVersionMismatchAndReload(const ErrorText, ClientVersion: string);
begin
// function FormatDollarValue(ValueStr: string): string; asm
// var var dlg = document.createElement('dialog');
// i: Integer; dlg.style.padding = '1rem';
// begin dlg.style.maxWidth = '520px';
// Result := ''; // Initialize the result 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 btnRow.appendChild(btn);
// for i := 1 to Length(ValueStr) do dlg.appendChild(title);
// begin dlg.appendChild(msg);
// if (Pos(ValueStr[i], '0123456789.') > 0) then dlg.appendChild(btnRow);
// begin document.body.appendChild(dlg);
// Result := Result + ValueStr[i]; dlg.showModal();
// end; end;
// end; end;
// end;
end. end.
...@@ -33,8 +33,7 @@ begin ...@@ -33,8 +33,7 @@ begin
ConnectProc; ConnectProc;
end; end;
procedure DisplayLoginView(AMessage: string = '');
procedure DisplayLoginView(AMessage: string);
begin begin
AuthService.Logout; AuthService.Logout;
DMConnection.ApiConnection.Connected := False; DMConnection.ApiConnection.Connected := False;
...@@ -43,67 +42,35 @@ begin ...@@ -43,67 +42,35 @@ begin
TFViewLogin.Display(@DisplayMainView, AMessage); TFViewLogin.Display(@DisplayMainView, AMessage);
end; end;
procedure UnauthorizedAccessProc(AMessage: string); procedure UnauthorizedAccessProc(AMessage: string);
begin begin
DisplayLoginView(AMessage); DisplayLoginView(AMessage);
end; end;
procedure AfterVerifyClientVersion(Success: Boolean; Error: string);
procedure StartApplication;
var
ClientVer: string;
begin begin
ClientVer := TDMConnection.clientVersion; if not Success then
DMConnection.InitApp(
procedure
begin
DMConnection.SetClientConfig(
procedure(Success: Boolean; ErrorMessage: string)
begin
if Success then
begin begin
ShowVersionMismatchAndReload(Error, DMConnection.clientVersion);
Exit;
end;
if (not AuthService.Authenticated) or AuthService.TokenExpired then if (not AuthService.Authenticated) or AuthService.TokenExpired then
DisplayLoginView DisplayLoginView
else else
DisplayMainView; 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();
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;
procedure StartApplication;
begin
AuthService.VerifyClientVersion(DMConnection.clientVersion, @AfterVerifyClientVersion);
end;
begin begin
Application.Initialize; Application.Initialize;
Application.MainFormOnTaskbar := True; Application.MainFormOnTaskbar := True;
Application.CreateForm(TDMConnection, DMConnection); Application.CreateForm(TDMConnection, DMConnection);
StartApplication;
Application.Run; Application.Run;
DMConnection.InitApp(@StartApplication, @UnauthorizedAccessProc);
end. end.
...@@ -912,9 +912,6 @@ ...@@ -912,9 +912,6 @@
<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">
...@@ -985,10 +982,6 @@ ...@@ -985,10 +982,6 @@
<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">
...@@ -999,10 +992,6 @@ ...@@ -999,10 +992,6 @@
<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">
......
[Settings] [Settings]
MemoLogLevel=5 MemoLogLevel=5
FileLogLevel=5 FileLogLevel=5
LogFileNum=31 LogFileNum=39
DevMode=0 DevMode=0
webClientVersion=0.0.1 webClientVersion=0.0.1
[Database] [Database]
--Server=192.168.116.129 --Server=192.168.116.129
--Server= Server=192.168.102.131
--Port= --Port=
--Database= Database=sleepdb
--Username= --Username=
--Password= --Password=
......
...@@ -53,7 +53,7 @@ begin ...@@ -53,7 +53,7 @@ begin
except except
on E: Exception do on E: Exception do
begin 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; end;
end; end;
......
...@@ -72,6 +72,7 @@ begin ...@@ -72,6 +72,7 @@ begin
end; end;
end; end;
function TAuthService.VerifyVersion(clientVersion: string): TJSONObject; function TAuthService.VerifyVersion(clientVersion: string): TJSONObject;
var var
webClientVersion: string; webClientVersion: string;
...@@ -101,6 +102,7 @@ begin ...@@ -101,6 +102,7 @@ begin
end; end;
end; end;
function TAuthService.Login(const username, password, clientVersion: string): string; function TAuthService.Login(const username, password, clientVersion: string): string;
var var
sql: string; sql: string;
......
...@@ -831,9 +831,6 @@ ...@@ -831,9 +831,6 @@
<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">
...@@ -904,10 +901,6 @@ ...@@ -904,10 +901,6 @@
<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">
...@@ -918,10 +911,6 @@ ...@@ -918,10 +911,6 @@
<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">
......
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