Commit 21727feb by Mac Stephens

Merge branch 'dev'

parents cdb35e6e 68ac3ea9
......@@ -4,11 +4,14 @@ emT3VCLDemo/Win64x/
emT3Web/__history/
emT3Web/__recovery/
emT3Web/config/
emT3Web/css/__history/
emT3Web/Win32/
emT3XDataServer/__history/
emT3XDataServer/__recovery/
emT3XDataServer/bin/logs/
emT3XDataServer/bin/static/
emT3XDataServer/Source/__history/
emT3XDataServer/Source/__recovery/
emT3XDataServer/Win32/
*.exe
......@@ -19,6 +22,3 @@ emT3XDataServer/Win32/
*.tvsconfig
*.txt
*.zip
emT3Web/css/__history/
......@@ -184,13 +184,13 @@
<BuildOrder>1</BuildOrder>
<PCH>true</PCH>
</PCHCompile>
<CppCompile Include="uMain.cpp">
<Form>fMain</Form>
<CppCompile Include="fMain.cpp">
<Form>frmMain</Form>
<FormType>dfm</FormType>
<DependentOn>uMain.h</DependentOn>
<DependentOn>fMain.h</DependentOn>
<BuildOrder>2</BuildOrder>
</CppCompile>
<FormResources Include="uMain.dfm"/>
<FormResources Include="fMain.dfm"/>
<BuildConfiguration Include="Base">
<Key>Base</Key>
</BuildConfiguration>
......
......@@ -4,7 +4,7 @@
#pragma hdrstop
#include <tchar.h>
//---------------------------------------------------------------------------
USEFORM("uMain.cpp", fMain);
USEFORM("fMain.cpp", frmMain);
//---------------------------------------------------------------------------
int WINAPI _tWinMain(HINSTANCE, HINSTANCE, LPTSTR, int)
{
......@@ -12,7 +12,7 @@ int WINAPI _tWinMain(HINSTANCE, HINSTANCE, LPTSTR, int)
{
Application->Initialize();
Application->MainFormOnTaskBar = true;
Application->CreateForm(__classid(TfMain), &fMain);
Application->CreateForm(__classid(TfrmMain), &frmMain);
Application->Run();
}
catch (Exception &exception)
......
......@@ -5,33 +5,35 @@
#include <System.NetEncoding.hpp>
#pragma hdrstop
#include "uMain.h"
#include "fMain.h"
//---------------------------------------------------------------------------
#pragma package(smart_init)
#pragma link "MySQLUniProvider"
#pragma link "UniProvider"
#pragma resource "*.dfm"
TfMain *fMain;
TfrmMain *frmMain;
//---------------------------------------------------------------------------
__fastcall TfMain::TfMain(TComponent* Owner)
__fastcall TfrmMain::TfrmMain(TComponent* Owner)
: TForm(Owner)
{
}
//---------------------------------------------------------------------------
void __fastcall TfMain::FormCreate(TObject *Sender)
void __fastcall TfrmMain::FormCreate(TObject *Sender)
{
Randomize();
LogLine("App started");
LogLine( "ucETask->Server: " + ucETask->Server );
LogLine( "ucETask->Database: " + ucETask->Database );
LogLine( "ucETask->Username: " + ucETask->Username );
LogLine( "ucETask->Password: " + ucETask->Password );
LogLine( "App started" );
}
//---------------------------------------------------------------------------
void __fastcall TfMain::btnOpenTaskItemsClick(TObject *Sender)
void __fastcall TfrmMain::btnOpenTaskItemsClick(TObject *Sender)
{
const UnicodeString userId = edtUserId->Text.Trim();
const UnicodeString taskId = edtTaskId->Text.Trim();
const UnicodeString baseUrl = edtWebUrl->Text.Trim();
const int expSeconds = StrToIntDef(edtExpSeconds->Text.Trim(), 60);
String userId = edtUserId->Text.Trim();
String taskId = edtTaskId->Text.Trim();
String baseUrl = edtWebUrl->Text.Trim();
int expSeconds = StrToIntDef(edtExpSeconds->Text.Trim(), 5);
if (userId.IsEmpty() || taskId.IsEmpty() || baseUrl.IsEmpty())
{
......@@ -39,14 +41,14 @@ void __fastcall TfMain::btnOpenTaskItemsClick(TObject *Sender)
return;
}
const int codeInt = 100000 + Random(900000);
const UnicodeString urlCode = IntToStr(codeInt);
int codeInt = 100000 + Random(900000);
String urlCode = IntToStr(codeInt);
LogLine("Generated URL_CODE=" + urlCode);
try
{
if (!ucETask->Connected)
if( !ucETask->Connected )
{
LogLine("Connecting to MariaDB...");
ucETask->Connect();
......@@ -75,42 +77,97 @@ void __fastcall TfMain::btnOpenTaskItemsClick(TObject *Sender)
return;
}
const UnicodeString launchUrl = BuildLaunchUrl(baseUrl, userId, taskId, urlCode);
if (launchUrl.IsEmpty())
{
String launchUrl = BuildLaunchUrl(baseUrl, userId, taskId, urlCode);
if( launchUrl.IsEmpty() ){
LogLine("Launch URL build failed");
return;
}
LogLine("Launching browser:");
LogLine(launchUrl);
LogLine( "Launching browser:" );
LogLine( launchUrl );
ShellExecute(0, L"open", launchUrl.w_str(), 0, 0, SW_SHOWNORMAL);
ShellExecute( 0, L"open", launchUrl.w_str(), 0, 0, SW_SHOWNORMAL );
}
//---------------------------------------------------------------------------
void TfMain::LogLine(const String &message)
void TfrmMain::LogLine(String message)
{
const String stamp = FormatDateTime("yyyy-mm-dd hh:nn:ss.zzz", Now());
String stamp = FormatDateTime("yyyy-mm-dd hh:nn:ss.zzz", Now());
memoLog->Lines->Add(stamp + " " + message);
memoLog->SelStart = memoLog->Text.Length();
}
//---------------------------------------------------------------------------
String TfMain::BuildLaunchUrl(const String &baseUrl, const String &userId, const String &taskId, const String &code)
String TfrmMain::BuildLaunchUrl(String baseUrl, String userId, String taskId, String code)
{
String cleanBaseUrl = baseUrl.Trim();
if (cleanBaseUrl.IsEmpty())
if( cleanBaseUrl.IsEmpty() )
return "";
String sep = cleanBaseUrl.Pos("?") > 0 ? "&" : "?";
return cleanBaseUrl + "?user_id=" + userId + "&task_id=" + taskId + "&url_code=" + code;
}
//---------------------------------------------------------------------------
void __fastcall TfrmMain::btnTaskItemsLoginClick(TObject *Sender)
{
String userId = edtUserId->Text.Trim();
String taskId = edtTaskId->Text.Trim();
String baseUrl = edtWebUrl->Text.Trim();
if( userId.IsEmpty() || taskId.IsEmpty() || baseUrl.IsEmpty() )
{
LogLine( "Missing required input (userId, taskId, or webUrl)" );
return;
}
String qUserId = TNetEncoding::URL->Encode(userId);
String qTaskId = TNetEncoding::URL->Encode(taskId);
String qCode = TNetEncoding::URL->Encode(code);
String urlCode = 'WebLogin';
return cleanBaseUrl + sep + "user_id=" + qUserId + "&task_id=" + qTaskId + "&url_code=" + qCode;
}
LogLine( "Generated URL_CODE=" + urlCode );
try
{
if( !ucETask->Connected )
{
LogLine("Connecting to MariaDB...");
ucETask->Connect();
LogLine("Connected");
}
LogLine( "Inserting row into web_tasks_url..." );
uqWebTasksUrl->Close();
uqWebTasksUrl->SQL->Text =
"insert into web_tasks_url (USER_ID, TASK_ID, URL_CODE, URL_TIME, URL_TIME_EXP) "
"values (:USER_ID, :TASK_ID, :URL_CODE, NOW(), :URL_TIME_EXP)";
uqWebTasksUrl->ParamByName("USER_ID")->AsString = userId;
uqWebTasksUrl->ParamByName("TASK_ID")->AsString = taskId;
uqWebTasksUrl->ParamByName("URL_CODE")->AsString = urlCode;
uqWebTasksUrl->ParamByName("URL_TIME_EXP")->AsInteger = 0;
uqWebTasksUrl->ExecSQL();
LogLine("Insert OK");
}
catch (const Exception &e)
{
LogLine("DB ERROR: " + e.Message);
return;
}
String launchUrl = baseUrl + "?user_id=" + userId + "&task_id=" + taskId;
if( launchUrl.IsEmpty() ){
LogLine("Launch URL build failed");
return;
}
LogLine( "Task Items Login url:" + launchUrl );
//ShellExecute( 0, L"open", launchUrl.w_str(), 0, 0, SW_SHOWNORMAL );
}
//---------------------------------------------------------------------------
void __fastcall TfrmMain::btnConnectClick(TObject *Sender)
{
ucETask->Connect();
LogLine( "Connected to database" );
}
//---------------------------------------------------------------------------
object fMain: TfMain
object frmMain: TfrmMain
Left = 0
Top = 0
Caption = 'fMain'
ClientHeight = 441
ClientWidth = 624
Caption = 'frmMain'
ClientHeight = 524
ClientWidth = 810
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
......@@ -52,12 +52,15 @@ object fMain: TfMain
OnClick = btnOpenTaskItemsClick
end
object memoLog: TMemo
Left = 20
Top = 102
Width = 581
Height = 311
Left = 0
Top = 108
Width = 810
Height = 416
Align = alBottom
Anchors = [akLeft, akTop, akRight, akBottom]
Lines.Strings = (
'')
ScrollBars = ssVertical
TabOrder = 1
end
object edtUserId: TEdit
......@@ -89,6 +92,24 @@ object fMain: TfMain
NumbersOnly = True
TabOrder = 5
end
object btnTaskItemsLogin: TButton
Left = 140
Top = 64
Width = 109
Height = 25
Caption = 'Task Items Login'
TabOrder = 6
OnClick = btnTaskItemsLoginClick
end
object btnConnect: TButton
Left = 260
Top = 64
Width = 73
Height = 25
Caption = 'Connect'
TabOrder = 7
OnClick = btnConnectClick
end
object ucETask: TUniConnection
ProviderName = 'MySQL'
Database = 'etask'
......@@ -105,7 +126,7 @@ object fMain: TfMain
'MySQL.HttpTrustServerCertificate=False'
'MySQL.ProxyPort=0')
Username = 'root'
Server = '192.168.102.131'
Server = '192.168.116.131'
LoginPrompt = False
Left = 390
Top = 342
......
//---------------------------------------------------------------------------
#ifndef uMainH
#define uMainH
#ifndef fMainH
#define fMainH
//---------------------------------------------------------------------------
#include <System.Classes.hpp>
#include <Vcl.Controls.hpp>
......@@ -14,7 +14,7 @@
#include "MySQLUniProvider.hpp"
#include "UniProvider.hpp"
//---------------------------------------------------------------------------
class TfMain : public TForm
class TfrmMain : public TForm
{
__published: // IDE-managed Components
TButton *btnOpenTaskItems;
......@@ -30,16 +30,20 @@ __published: // IDE-managed Components
TUniConnection *ucETask;
TUniQuery *uqWebTasksUrl;
TMySQLUniProvider *MySQLUniProvider1;
TButton *btnTaskItemsLogin;
TButton *btnConnect;
void __fastcall FormCreate(TObject *Sender);
void __fastcall btnOpenTaskItemsClick(TObject *Sender);
void __fastcall btnTaskItemsLoginClick(TObject *Sender);
void __fastcall btnConnectClick(TObject *Sender);
private:
void LogLine(const String &message);
String BuildLaunchUrl(const String &baseUrl, const String &userId, const String &taskId, const String &code);
void LogLine(String message);
String BuildLaunchUrl(String baseUrl, String userId, String taskId, String code);
public: // User declarations
__fastcall TfMain(TComponent* Owner);
__fastcall TfrmMain(TComponent* Owner);
};
//---------------------------------------------------------------------------
extern PACKAGE TfMain *fMain;
extern PACKAGE TfrmMain *frmMain;
//---------------------------------------------------------------------------
#endif
......@@ -4,7 +4,7 @@ interface
uses
SysUtils, Web, JS,
XData.Web.Client;
XData.Web.Client, WEBLib.Crypto;
const
TOKEN_NAME = 'EMT3_WEB_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(AUserId, ATaskId, AUrlCode: string; ASuccess: TOnLoginSuccess; AError: TOnLoginError);
[async] procedure WebLogin(AUserName, ALoginType, ALoginValue, APassword: string; ASuccess: TOnLoginSuccess; AError: TOnLoginError);
procedure Logout;
function GetToken: string;
function Authenticated: Boolean;
......@@ -91,7 +91,7 @@ begin
Result := window.localStorage.getItem(TOKEN_NAME);
end;
procedure TAuthService.Login(AUser, APassword, AClientVersion: string; ASuccess: TOnLoginSuccess;
procedure TAuthService.Login(AUserId, ATaskId, AUrlCode: string; ASuccess: TOnLoginSuccess;
AError: TOnLoginError);
procedure OnLoad(Response: TXDataClientResponse);
......@@ -109,21 +109,70 @@ procedure TAuthService.Login(AUser, APassword, AClientVersion: string; ASuccess:
end;
begin
if (AUser = '') or (APassword = '') then
if (AUserId = '') or (ATaskId = '') or (AUrlCode = '') then
begin
AError('Invalid or expired code, please try again.');
Exit;
end;
FClient.RawInvoke(
'IAuthService.Login', [AUser, APassword, AClientVersion],
'IAuthService.Login', [AUserId, ATaskId, AUrlCode],
@OnLoad, @OnError
);
end;
[async] procedure TAuthService.WebLogin(AUserName, ALoginType, ALoginValue, APassword: string; ASuccess: TOnLoginSuccess; AError: TOnLoginError);
var
sha: TWebSHAHash;
passwordHash: string;
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 (AUserName = '') or (ALoginType = '') or (APassword = '') then
begin
AError('Please enter all required login fields.');
Exit;
end;
if SameText(ALoginType, 'task_items') and (ALoginValue = '') then
begin
AError('Please enter all required login fields.');
Exit;
end;
sha := TWebSHAHash.Create(ehSHA256);
try
passwordHash := Await(string, sha.Hash(UpperCase(Trim(APassword))));
finally
sha.Free;
end;
FClient.RawInvoke(
'IAuthService.WebLogin', [AUserName, ALoginType, ALoginValue, passwordHash],
@OnLoad, @OnError
);
end;
procedure TAuthService.Logout;
begin
DeleteToken;
DMConnection.currentTaskId := '';
DMConnection.currentTimeEntryDate := '';
end;
procedure TAuthService.SetToken(AToken: string);
......
......@@ -20,7 +20,9 @@ type
FUnauthorizedAccessProc: TUnauthorizedAccessProc;
public
const clientVersion = '0.8.8';
currentTaskId: string;
currentTimeEntryDate: string;
const clientVersion = '0.9.3';
procedure InitApp(SuccessProc: TSuccessProc;
UnauthorizedAccessProc: TUnauthorizedAccessProc);
procedure SetClientConfig(Callback: TVersionCheckCallback);
......
......@@ -160,6 +160,12 @@ begin
var btnRight = document.getElementById('btn_confirm_right');
var bsModal;
console.log('confirmation modal=', modal);
console.log('confirmation body=', body);
console.log('confirmation left=', btnLeft);
console.log('confirmation right=', btnRight);
if (body) body.innerText = msg;
if (btnLeft) btnLeft.innerText = leftLabel;
if (btnRight) btnRight.innerText = rightLabel;
......
object FViewErrorPage: TFViewErrorPage
Left = 0
Top = 0
Width = 534
Height = 426
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
TabOrder = 1
object lbTitle: TWebLabel
Left = 24
Top = 24
Width = 128
Height = 13
Caption = 'Oops... an error occurred!'
ElementID = 'view.errorpage.title'
Transparent = False
end
object lbMessage: TWebLabel
Left = 24
Top = 56
Width = 42
Height = 13
Caption = 'Message'
ElementID = 'view.errorpage.message'
Transparent = False
end
end
<div class="container">
<br />
<div class="panel panel-red">
<div id="view.errorpage.title" class="panel-heading">
Error Page
</div>
<div id="view.errorpage.message" class="panel-body">
Message
</div>
<div class="panel-footer">
<a href=".">Reload web application</a>
</div>
</div>
</div>
unit View.ErrorPage;
interface
uses
System.SysUtils, System.Classes, WEBLib.Graphics, WEBLib.Controls, WEBLib.Forms, WEBLib.Dialogs,
Vcl.Controls, Vcl.StdCtrls,
XData.Web.Connection, WEBLib.StdCtrls;
type
TFViewErrorPage = class(TWebForm)
lbTitle: TWebLabel;
lbMessage: TWebLabel;
public
class procedure Display(AErrorMessage: string);
class procedure DisplayConnectionError(AError: TXDataWebConnectionError);
end;
var
FViewErrorPage: TFViewErrorPage;
implementation
{$R *.dfm}
{ TFViewErrorPage }
class procedure TFViewErrorPage.Display(AErrorMessage: string);
procedure AfterCreateProc(AForm: TObject);
begin
TFViewErrorPage(AForm).lbMessage.Caption := AErrorMessage;
end;
begin
if Assigned(FViewErrorPage) then
FViewErrorPage.Free;
FViewErrorPage := TFViewErrorPage.CreateNew(@AfterCreateProc);
end;
class procedure TFViewErrorPage.DisplayConnectionError(
AError: TXDataWebConnectionError);
begin
Display(AError.ErrorMessage + ': ' + AError.RequestUrl);
end;
end.
object FViewLogin: TFViewLogin
Width = 640
Height = 480
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
ParentFont = False
OnCreate = WebFormCreate
object WebLabel1: TWebLabel
Left = 240
Top = 112
Width = 67
Height = 13
Caption = 'Please Sign In'
ElementID = 'view.login.title'
HeightPercent = 100.000000000000000000
Transparent = False
WidthPercent = 100.000000000000000000
end
object edtUsername: TWebEdit
Left = 240
Top = 180
Width = 121
Height = 21
ElementID = 'view.login.edtusername'
HeightPercent = 100.000000000000000000
TextHint = 'Username'
WidthPercent = 100.000000000000000000
end
object edtPassword: TWebEdit
Left = 240
Top = 207
Width = 121
Height = 21
ElementID = 'view.login.edtpassword'
HeightPercent = 100.000000000000000000
PasswordChar = '*'
TabOrder = 1
TextHint = 'Password'
WidthPercent = 100.000000000000000000
end
object btnLogin: TWebButton
Left = 240
Top = 234
Width = 121
Height = 25
Caption = 'Login'
ElementID = 'view.login.btnlogin'
HeightPercent = 100.000000000000000000
TabOrder = 2
WidthPercent = 100.000000000000000000
OnClick = btnLoginClick
end
object pnlMessage: TWebPanel
Left = 240
Top = 65
Width = 121
Height = 33
ElementID = 'view.login.message'
TabOrder = 3
object lblMessage: TWebLabel
Left = 16
Top = 11
Width = 42
Height = 13
Caption = 'Message'
ElementID = 'view.login.message.label'
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
end
object btnCloseNotification: TWebButton
Left = 96
Top = 3
Width = 22
Height = 25
ElementID = 'view.login.message.button'
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
OnClick = btnCloseNotificationClick
end
end
object edtTaskId: TWebEdit
Left = 240
Top = 133
Width = 121
Height = 21
ChildOrder = 5
ElementID = 'view.login.edttaskid'
HeightPercent = 100.000000000000000000
TextHint = 'TaskId'
WidthPercent = 100.000000000000000000
end
object edtDate: TWebEdit
Left = 240
Top = 156
Width = 121
Height = 22
ChildOrder = 6
ElementID = 'view.login.edtdate'
ElementFont = efCSS
HeightPercent = 100.000000000000000000
TextHint = 'Date'
WidthPercent = 100.000000000000000000
end
object XDataWebClient: TXDataWebClient
Connection = DMConnection.AuthConnection
Left = 492
Top = 102
end
end
<nav class="navbar navbar-light bg-light login-navbar">
<div class="container-fluid">
<a class="navbar-brand">emT3web</a>
</div>
</nav>
<div class="container mt-5">
<div class="row justify-content-center">
<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 id="view.login.taskid.group" class="mb-3">
<input id="view.login.edttaskid" class="form-control" type="text" placeholder="Task Id">
</div>
<div id="view.login.date.group" class="mb-3">
<input id="view.login.edtdate" class="form-control" type="date" placeholder="Date">
</div>
<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>
</fieldset>
</div>
</div>
</div>
</div>
</div>
</div>
unit View.Login;
interface
uses
System.SysUtils, System.Classes, WEBLib.Graphics, WEBLib.Controls, WEBLib.Forms, WEBLib.Dialogs,
Vcl.Controls, Vcl.StdCtrls, WEBLib.StdCtrls, WEBLib.JSON,
JS, XData.Web.Connection, WEBLib.ExtCtrls, Web,
App.Types, ConnectionModule, XData.Web.Client;
type
TFViewLogin = class(TWebForm)
WebLabel1: TWebLabel;
edtUsername: TWebEdit;
edtPassword: TWebEdit;
btnLogin: TWebButton;
pnlMessage: TWebPanel;
lblMessage: TWebLabel;
btnCloseNotification: TWebButton;
XDataWebClient: TXDataWebClient;
edtTaskId: TWebEdit;
edtDate: TWebEdit;
procedure btnLoginClick(Sender: TObject);
procedure btnCloseNotificationClick(Sender: TObject);
procedure WebFormCreate(Sender: TObject);
private
FLoginProc: TSuccessProc;
FMessage: string;
FUserId: string;
FTaskId: string;
procedure ShowNotification(Notification: string);
procedure HideNotification;
public
class procedure Display(LoginProc: TSuccessProc); overload;
class procedure Display(LoginProc: TSuccessProc; AMsg: string); overload;
class procedure Display(LoginProc: TSuccessProc; AUserId, ATaskId, AMsg: string); overload;
end;
var
FViewLogin: TFViewLogin;
implementation
uses
Auth.Service,
View.ErrorPage;
{$R *.dfm}
procedure TFViewLogin.btnLoginClick(Sender: TObject);
var
timeEntriesParam: string;
newUrl: string;
isTimeEntriesMode: Boolean;
procedure LoginSuccess;
begin
if isTimeEntriesMode then
begin
DMConnection.currentTaskId := '';
DMConnection.currentTimeEntryDate := edtDate.Text;
if edtDate.Text <> '' then
newUrl := window.location.pathname + '?time_entries=true&date=' + edtDate.Text
else
newUrl := window.location.pathname + '?time_entries=true';
window.history.replaceState(TJSObject.new, '', newUrl);
end
else
DMConnection.currentTaskId := edtTaskId.Text;
FLoginProc;
end;
procedure LoginError(AMsg: string);
begin
ShowNotification('Login Error: ' + AMsg);
end;
begin
timeEntriesParam := Application.Parameters.Values['time_entries'];
isTimeEntriesMode :=
SameText(timeEntriesParam, 'true') or
(Application.Parameters.Values['task_id'] = '');
if isTimeEntriesMode then
begin
AuthService.WebLogin(
edtUsername.Text,
'time_entries',
edtDate.Text,
edtPassword.Text,
@LoginSuccess,
@LoginError
);
end
else
begin
AuthService.WebLogin(
edtUsername.Text,
'task_items',
edtTaskId.Text,
edtPassword.Text,
@LoginSuccess,
@LoginError
);
end;
end;
class procedure TFViewLogin.Display(LoginProc: TSuccessProc);
begin
TFViewLogin.Display(LoginProc, '', '', '');
end;
class procedure TFViewLogin.Display(LoginProc: TSuccessProc; AMsg: string);
begin
TFViewLogin.Display(LoginProc, '', '', AMsg);
end;
class procedure TFViewLogin.Display(LoginProc: TSuccessProc; AUserId, ATaskId, AMsg: string);
procedure FormCreate(AForm: TObject);
begin
TFViewLogin(AForm).FUserId := AUserId;
TFViewLogin(AForm).FTaskId := ATaskId;
TFViewLogin(AForm).FMessage := AMsg;
end;
begin
console.log('TFViewLogin.Display start AUserId=' + AUserId + ' ATaskId=' + ATaskId + ' AMsg=' + AMsg);
if Assigned(FViewLogin) then
FViewLogin.Free;
FViewLogin := TFViewLogin.CreateNew(@FormCreate);
FViewLogin.FLoginProc := LoginProc;
console.log('TFViewLogin.Display end');
end;
procedure TFViewLogin.HideNotification;
begin
pnlMessage.ElementHandle.hidden := True;
end;
procedure TFViewLogin.ShowNotification(Notification: string);
begin
if Notification <> '' then
begin
lblMessage.Caption := Notification;
pnlMessage.ElementHandle.hidden := False;
end;
end;
procedure TFViewLogin.WebFormCreate(Sender: TObject);
var
timeEntriesParam: string;
isTimeEntriesMode: Boolean;
begin
console.log('TFViewLogin.WebFormCreate FUserId=' + FUserId + ' FTaskId=' + FTaskId + ' FMessage=' + FMessage);
timeEntriesParam := Application.Parameters.Values['time_entries'];
isTimeEntriesMode :=
SameText(timeEntriesParam, 'true') or
(Application.Parameters.Values['task_id'] = '');
edtUsername.Text := FUserId;
edtTaskId.Text := FTaskId;
edtDate.Text := Application.Parameters.Values['date'];
if isTimeEntriesMode then
begin
WebLabel1.Caption := 'Time Entries Sign In';
TJSHTMLElement(document.getElementById('view.login.taskid.group')).classList.add('d-none');
TJSHTMLElement(document.getElementById('view.login.date.group')).classList.remove('d-none');
end
else
begin
WebLabel1.Caption := 'Task Items Sign In';
TJSHTMLElement(document.getElementById('view.login.taskid.group')).classList.remove('d-none');
TJSHTMLElement(document.getElementById('view.login.date.group')).classList.add('d-none');
end;
if FMessage <> '' then
ShowNotification(FMessage)
else
HideNotification;
end;
procedure TFViewLogin.btnCloseNotificationClick(Sender: TObject);
begin
HideNotification;
end;
end.
......@@ -17,18 +17,18 @@
<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="#">
<a class="dropdown-item d-flex align-items-center gap-2" id="lbl_home">
<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="#">
<a class="dropdown-item d-flex align-items-center gap-2" id="lbl_user_profile">
<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="#">
<a class="dropdown-item d-flex align-items-center gap-2 text-danger" id="lbl_logout">
<i class="fa fa-sign-out fa-fw"></i><span>Logout</span>
</a>
</li>
......@@ -87,19 +87,23 @@
</div>
<!-- Confirmation Modal -->
<div class="modal fade" id="mdl_confirmation" tabindex="-1" aria-hidden="true">
<div class="modal fade" id="main_confirmation_modal" 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">
<div class="modal-body fw-bold" id="main_modal_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>
<button type="button" class="btn btn-danger me-3" id="btn_confirm_left">
Delete
</button>
<button type="button" class="btn btn-secondary" id="btn_confirm_right">
Cancel
</button>
</div>
</div>
</div>
......
......@@ -35,19 +35,34 @@ implementation
uses
Auth.Service,
View.TaskItems;
View.TaskItems,
View.TimeEntries;
{$R *.dfm}
procedure TFViewMain.WebFormCreate(Sender: TObject);
var
userName: string;
isTimeEntriesMode: Boolean;
begin
userName := JS.toString(AuthService.TokenPayload.Properties['user_name']);
lblUsername.Caption := userName;
lblVersion.Caption := 'v' + DMConnection.clientVersion;
isTimeEntriesMode :=
SameText(Application.Parameters.Values['time_entries'], 'true') or
(Application.Parameters.Values['task_id'] = '');
if isTimeEntriesMode then
begin
lblAppTitle.Caption := 'Time Entries';
ShowForm(TFTimeEntries);
end
else
begin
lblAppTitle.Caption := 'Task Items';
ShowForm(TFTaskItems);
end;
end;
procedure TFViewMain.lblLogoutClick(Sender: TObject);
......
......@@ -58,6 +58,62 @@ object FTaskItems: TFTaskItems
WidthPercent = 100.000000000000000000
OnClick = btnInsertRowClick
end
object btnTextColor: TWebButton
Left = 282
Top = 197
Width = 96
Height = 25
Caption = 'Text Color'
ChildOrder = 4
ElementID = 'btn_text_color'
ElementFont = efCSS
HeightStyle = ssAuto
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
OnClick = btnTextColorClick
end
object btnFmtBold: TWebButton
Left = 282
Top = 228
Width = 96
Height = 25
Caption = 'Bold'
ChildOrder = 4
ElementID = 'btn_fmt_bold'
ElementFont = efCSS
HeightStyle = ssAuto
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
OnClick = btnFmtBoldClick
end
object btnFmtItalic: TWebButton
Left = 282
Top = 259
Width = 96
Height = 25
Caption = 'Italic'
ChildOrder = 4
ElementID = 'btn_fmt_italic'
ElementFont = efCSS
HeightStyle = ssAuto
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
OnClick = btnFmtItalicClick
end
object btnFmtUnderline: TWebButton
Left = 282
Top = 290
Width = 96
Height = 25
Caption = 'Underline'
ChildOrder = 4
ElementID = 'btn_fmt_underline'
ElementFont = efCSS
HeightStyle = ssAuto
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
OnClick = btnFmtUnderlineClick
end
object xdwcTasks: TXDataWebClient
Connection = DMConnection.ApiConnection
Left = 506
......
<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 gap-3">
<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 align-items-center gap-2 ms-auto flex-nowrap">
<div id="lbl_total_rows" class="me-2 text-nowrap"></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_insert_row" class="btn btn-sm btn-success">Insert Row</button>
<button id="btn_reload" class="btn btn-sm btn-primary">Reload</button>
<div class="task-toolbar d-flex align-items-center gap-1 px-2 py-1">
<button id="btn_fmt_bold" type="button" class="btn btn-sm btn-light task-toolbar-btn" title="Bold">
<i class="fas fa-bold"></i>
</button>
<button id="btn_fmt_italic" type="button" class="btn btn-sm btn-light task-toolbar-btn" title="Italic">
<i class="fas fa-italic"></i>
</button>
<button id="btn_fmt_underline" type="button" class="btn btn-sm btn-light task-toolbar-btn" title="Underline">
<i class="fas fa-underline"></i>
</button>
<div class="vr mx-1"></div>
<button id="btn_text_color" type="button" class="btn btn-sm btn-light task-toolbar-btn task-color-btn" title="Text color">
<span class="task-color-glyph">A</span>
<span id="text_color_swatch" class="task-color-swatch"></span>
<input id="issue_notes_text_color" type="color" class="task-hidden-color-input" value="#000000">
</button>
</div>
<button id="btn_add_row" class="btn btn-sm btn-success text-nowrap">Add Row</button>
<button id="btn_insert_row" class="btn btn-sm btn-success text-nowrap">Insert Row</button>
<button id="btn_delete_row" class="btn btn-sm btn-danger text-nowrap">Delete Row</button>
<button id="btn_reload" class="btn btn-sm btn-primary text-nowrap">Reload</button>
</div>
</div>
......
......@@ -31,11 +31,19 @@ type
xdwdsTaskstaskItemId: TIntegerField;
btnDeleteRow: TWebButton;
btnInsertRow: TWebButton;
btnTextColor: TWebButton;
btnFmtBold: TWebButton;
btnFmtItalic: TWebButton;
btnFmtUnderline: TWebButton;
[async] procedure btnAddRowClick(Sender: TObject);
procedure btnReloadClick(Sender: TObject);
procedure WebFormCreate(Sender: TObject);
[async] procedure btnDeleteRowClick(Sender: TObject);
[async] procedure btnInsertRowClick(Sender: TObject);
procedure btnTextColorClick(Sender: TObject);
procedure btnFmtBoldClick(Sender: TObject);
procedure btnFmtItalicClick(Sender: TObject);
procedure btnFmtUnderlineClick(Sender: TObject);
private
FTaskId: string;
FApplicationOptions: TJSArray;
......@@ -50,6 +58,8 @@ type
FPendingScrollLeft: Integer;
FPendingFocusItemNum: Integer;
FPendingFocusTaskField: string;
FActiveRichEditorId: string;
FLastSelectionRange: JSValue;
FNameManager: TNameManager;
[async] procedure LoadTasks(const ATaskId: string);
procedure RenderTable;
......@@ -90,6 +100,12 @@ type
[async] procedure HandleAddManagedName(const AFieldName: string; const ARowIndex: Integer; const ANewName: string);
[async] procedure HandleRenameManagedName(const AFieldName, AOldName, ANewName: string);
[async] procedure HandleDeleteManagedName(const AFieldName, AName: string);
procedure ColorPickerInput(Event: TJSEvent);
procedure RichEditorFocus(Event: TJSEvent);
procedure RichEditorSelectionChange(Event: TJSEvent);
procedure ApplyRichTextCommand(const commandName: string; const commandValue: string = '');
procedure UpdateToolbarState;
procedure SetToolbarButtonActive(const buttonId: string; const isActive: Boolean);
public
end;
......@@ -107,7 +123,11 @@ uses
procedure TFTaskItems.WebFormCreate(Sender: TObject);
begin
console.log('TFTaskItems.WebFormCreate fired');
FTaskId := Application.Parameters.Values['task_id'];
if FTaskId = '' then
FTaskId := DMConnection.currentTaskId;
FApplicationOptions := TJSArray.new;
FReportedByOptions := TJSArray.new;
FAssignedToOptions := TJSArray.new;
......@@ -214,6 +234,9 @@ begin
if xdwdsTasks.Eof then
Exit;
if SameText(fieldName, 'issue') or SameText(fieldName, 'notes') then
newVal := string(el.innerHTML)
else
newVal := string(TJSObject(el)['value']);
console.log('EditorInput: idx=' + IntToStr(idx) + ' field=' + fieldName + ' val=' + newVal);
......@@ -280,6 +303,13 @@ begin
el.addEventListener('input', TJSEventHandler(@EditorInput));
el.addEventListener('blur', TJSEventHandler(@EditorBlur));
el.addEventListener('keydown', TJSEventHandler(@EditorKeyDown));
if el.classList.contains('task-rich-editor') then
begin
el.addEventListener('focus', TJSEventHandler(@RichEditorFocus));
el.addEventListener('mouseup', TJSEventHandler(@RichEditorSelectionChange));
el.addEventListener('keyup', TJSEventHandler(@RichEditorSelectionChange));
end;
end;
nodes := document.querySelectorAll('.task-select');
......@@ -311,6 +341,10 @@ begin
el.addEventListener('click', TJSEventHandler(@RowClick));
end;
el := TJSHTMLElement(document.getElementById('issue_notes_text_color'));
if Assigned(el) then
el.addEventListener('input', TJSEventHandler(@ColorPickerInput));
ApplySelectedRowState;
end;
......@@ -402,6 +436,21 @@ begin
end;
end;
procedure TFTaskItems.btnFmtBoldClick(Sender: TObject);
begin
ApplyRichTextCommand('bold');
end;
procedure TFTaskItems.btnFmtItalicClick(Sender: TObject);
begin
ApplyRichTextCommand('italic');
end;
procedure TFTaskItems.btnFmtUnderlineClick(Sender: TObject);
begin
ApplyRichTextCommand('underline');
end;
[async] procedure TFTaskItems.btnInsertRowClick(Sender: TObject);
begin
Utils.ShowSpinner('spinner');
......@@ -525,7 +574,7 @@ begin
try
response := await(xdwcTasks.RawInvokeAsync(
'IApiService.AddTaskRow', [FTaskId, insertAfterItemNum]
'ITaskItemService.AddTaskRow', [FTaskId, insertAfterItemNum]
));
console.log('AddTaskRow response=' + string(TJSJSON.stringify(response.Result)));
......@@ -555,16 +604,29 @@ begin
end;
procedure TFTaskItems.btnTextColorClick(Sender: TObject);
var
colorEl: TJSHTMLElement;
begin
colorEl := TJSHTMLElement(document.getElementById('issue_notes_text_color'));
colorEl.click;
end;
procedure TFTaskItems.EnableAutoGrowTextAreas;
begin
asm
(function(){
const host = document.getElementById('tasks_table_host');
if(!host) return;
host.querySelectorAll('textarea.cell-textarea').forEach(ta => {
const fit = () => { ta.style.height = 'auto'; ta.style.height = ta.scrollHeight + 'px'; };
host.querySelectorAll('.task-rich-editor').forEach(function(editor){
const fit = function() {
editor.style.height = 'auto';
editor.style.height = editor.scrollHeight + 'px';
};
fit();
ta.addEventListener('input', fit);
editor.addEventListener('input', fit);
});
})();
end;
......@@ -599,13 +661,13 @@ var
titleText: string;
rowCount: Integer;
begin
console.log('IApiService.GetTaskItems called with task_id: ' + ATaskId);
console.log('ITaskItemService.GetTaskItems called with task_id: ' + ATaskId);
console.log('Load Tasks Fired');
Utils.ShowSpinner('spinner');
try
try
response := await(xdwcTasks.RawInvokeAsync(
'IApiService.GetTaskItems', [ATaskId]
'ITaskItemService.GetTaskItems', [ATaskId]
));
except
on E: EXDataClientRequestException do
......@@ -693,15 +755,6 @@ var
'value="' + HtmlEncode(Value) + '"' + w + '>';
end;
function TextArea(const FieldName, Value: string; const AIdx: Integer): string;
begin
Result :=
'<textarea class="form-control form-control-sm cell-textarea task-editor w-100" ' +
'style="height:31px; min-height:31px; overflow:hidden; resize:none;" ' +
'data-idx="' + IntToStr(AIdx) + '" data-field="' + FieldName + '" ' +
'rows="1">' + HtmlEncode(Value) + '</textarea>';
end;
function ItemNumInput(const Value: Integer; const AIdx: Integer): string;
begin
Result :=
......@@ -786,6 +839,21 @@ var
'</div>';
end;
function RichTextEditor(const FieldName, Value: string; const AIdx: Integer): string;
var
editorId: string;
begin
editorId := 'rtf_' + FieldName + '_' + IntToStr(AIdx);
Result :=
'<div id="' + editorId + '" ' +
'class="form-control form-control-sm task-rich-editor task-editor w-100" ' +
'contenteditable="true" ' +
'data-idx="' + IntToStr(AIdx) + '" ' +
'data-field="' + FieldName + '" ' +
'style="min-height:31px; overflow:hidden;">' + Value + '</div>';
end;
begin
host := TJSHTMLElement(document.getElementById('tasks_table_host'));
if not Assigned(host) then
......@@ -837,8 +905,8 @@ begin
TdNowrap(SelectList('status', xdwdsTasksstatus.AsString, rowIdx, FStatusOptions, False)) +
TdNowrap(DateInput('statusDate', xdwdsTasksstatusDate.AsString, rowIdx)) +
TdNowrap(TextInput('formSection', xdwdsTasksformSection.AsString, rowIdx)) +
TdWrap(TextArea('issue', xdwdsTasksissue.AsString, rowIdx)) +
TdWrap(TextArea('notes', xdwdsTasksnotes.AsString, rowIdx)) +
TdWrap(RichTextEditor('issue', xdwdsTasksissue.AsString, rowIdx)) +
TdWrap(RichTextEditor('notes', xdwdsTasksnotes.AsString, rowIdx)) +
'</tr>';
xdwdsTasks.Next;
......@@ -963,7 +1031,7 @@ begin
try
response := await(xdwcTasks.RawInvokeAsync(
'IApiService.MoveTaskRow',
'ITaskItemService.MoveTaskRow',
[
StrToIntDef(xdwdsTaskstaskId.AsString, 0),
movedTaskItemId,
......@@ -1038,7 +1106,7 @@ begin
Exit;
try
response := await(xdwcTasks.RawInvokeAsync('IApiService.SaveTaskItemField', [payload]));
response := await(xdwcTasks.RawInvokeAsync('ITaskItemService.SaveTaskItemField', [payload]));
console.log('SaveField: response=' + string(TJSJSON.stringify(response.Result)));
except
on E: EXDataClientRequestException do
......@@ -1061,7 +1129,7 @@ begin
try
response := await(xdwcTasks.RawInvokeAsync(
'IApiService.DeleteTaskRow',
'ITaskItemService.DeleteTaskRow',
[FSelectedTaskId, FSelectedTaskItemId]
));
console.log('DeleteTaskRow response=' + string(TJSJSON.stringify(response.Result)));
......@@ -1255,7 +1323,7 @@ begin
try
response := await(xdwcTasks.RawInvokeAsync(
'IApiService.AddAssignedName',
'ITaskItemService.AddAssignedName',
[FTaskId, Trim(AName)]
));
......@@ -1281,7 +1349,7 @@ begin
try
response := await(xdwcTasks.RawInvokeAsync(
'IApiService.RenameAssignedName',
'ITaskItemService.RenameAssignedName',
[FTaskId, Trim(AOldName), Trim(ANewName)]
));
......@@ -1307,7 +1375,7 @@ begin
try
response := await(xdwcTasks.RawInvokeAsync(
'IApiService.DeleteAssignedName',
'ITaskItemService.DeleteAssignedName',
[FTaskId, Trim(AName)]
));
......@@ -1368,6 +1436,7 @@ begin
await(SaveField(ARowIndex, AFieldName));
end;
[async] procedure TFTaskItems.HandleRenameManagedName(const AFieldName, AOldName, ANewName: string);
var
newOptions: TJSArray;
......@@ -1431,7 +1500,7 @@ begin
try
response := await(xdwcTasks.RawInvokeAsync(
'IApiService.AddApplicationName',
'ITaskItemService.AddApplicationName',
[FTaskId, Trim(AName)]
));
......@@ -1457,7 +1526,7 @@ begin
try
response := await(xdwcTasks.RawInvokeAsync(
'IApiService.RenameApplicationName',
'ITaskItemService.RenameApplicationName',
[FTaskId, Trim(AOldName), Trim(ANewName)]
));
......@@ -1483,7 +1552,7 @@ begin
try
response := await(xdwcTasks.RawInvokeAsync(
'IApiService.DeleteApplicationName',
'ITaskItemService.DeleteApplicationName',
[FTaskId, Trim(AName)]
));
......@@ -1510,7 +1579,7 @@ begin
try
response := await(xdwcTasks.RawInvokeAsync(
'IApiService.AddReportedName',
'ITaskItemService.AddReportedName',
[FTaskId, Trim(AName)]
));
......@@ -1536,7 +1605,7 @@ begin
try
response := await(xdwcTasks.RawInvokeAsync(
'IApiService.RenameReportedName',
'ITaskItemService.RenameReportedName',
[FTaskId, Trim(AOldName), Trim(ANewName)]
));
......@@ -1562,7 +1631,7 @@ begin
try
response := await(xdwcTasks.RawInvokeAsync(
'IApiService.DeleteReportedName',
'ITaskItemService.DeleteReportedName',
[FTaskId, Trim(AName)]
));
......@@ -1580,6 +1649,118 @@ begin
end;
procedure TFTaskItems.ColorPickerInput(Event: TJSEvent);
var
pickerEl: TJSHTMLElement;
colorValue: string;
swatchEl: TJSHTMLElement;
begin
pickerEl := TJSHTMLElement(Event.target);
colorValue := string(TJSObject(pickerEl)['value']);
swatchEl := TJSHTMLElement(document.getElementById('text_color_swatch'));
swatchEl.style.setProperty('background', colorValue);
ApplyRichTextCommand('foreColor', colorValue);
end;
procedure TFTaskItems.RichEditorFocus(Event: TJSEvent);
var
el: TJSHTMLElement;
begin
el := TJSHTMLElement(Event.target);
FActiveRichEditorId := string(el.id);
UpdateToolbarState;
end;
procedure TFTaskItems.RichEditorSelectionChange(Event: TJSEvent);
begin
asm
const sel = window.getSelection();
if (!sel || sel.rangeCount === 0) return;
const range = sel.getRangeAt(0);
const editor = document.getElementById(this.FActiveRichEditorId);
if (!editor) return;
const container = range.commonAncestorContainer;
if (editor.contains(container.nodeType === 1 ? container : container.parentNode)) {
this.FLastSelectionRange = range.cloneRange();
}
end;
UpdateToolbarState;
end;
procedure TFTaskItems.ApplyRichTextCommand(const commandName: string; const commandValue: string = '');
var
editorEl: TJSHTMLElement;
begin
if not xdwdsTasks.Active then
Exit;
if FActiveRichEditorId = '' then
Exit;
editorEl := TJSHTMLElement(document.getElementById(FActiveRichEditorId));
if not Assigned(editorEl) then
Exit;
asm
const sel = window.getSelection();
if (!sel) return;
editorEl.focus();
if (this.FLastSelectionRange) {
sel.removeAllRanges();
sel.addRange(this.FLastSelectionRange);
}
if (commandName === 'foreColor')
document.execCommand('styleWithCSS', false, true)
else
document.execCommand('styleWithCSS', false, false);
if (commandValue)
document.execCommand(commandName, false, commandValue);
else
document.execCommand(commandName, false, null);
if (sel.rangeCount > 0) {
this.FLastSelectionRange = sel.getRangeAt(0).cloneRange();
}
editorEl.setAttribute('data-unsaved-data', '1');
editorEl.dispatchEvent(new Event('input', { bubbles: true }));
end;
UpdateToolbarState;
end;
procedure TFTaskItems.SetToolbarButtonActive(const buttonId: string; const isActive: Boolean);
var
el: TJSHTMLElement;
begin
el := TJSHTMLElement(document.getElementById(buttonId));
if isActive then
el.classList.add('active')
else
el.classList.remove('active');
el.setAttribute('aria-pressed', BoolToStr(isActive, True).ToLower);
end;
procedure TFTaskItems.UpdateToolbarState;
begin
asm
this.SetToolbarButtonActive('btn_fmt_bold', document.queryCommandState('bold'));
this.SetToolbarButtonActive('btn_fmt_italic', document.queryCommandState('italic'));
this.SetToolbarButtonActive('btn_fmt_underline', document.queryCommandState('underline'));
end;
end;
end.
......
object FTimeEntries: TFTimeEntries
Width = 640
Height = 480
CSSLibrary = cssBootstrap
ElementFont = efCSS
OnCreate = WebFormCreate
object lblValidationMessage: TWebLabel
Left = 90
Top = 32
Width = 3
Height = 15
ElementID = 'lbl_validation_message'
ElementFont = efCSS
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
end
object edtWeekOf: TWebEdit
Left = 71
Top = 80
Width = 121
Height = 22
TabStop = False
ChildOrder = 1
ElementID = 'edt_week_of'
ElementFont = efCSS
HeightPercent = 100.000000000000000000
ShowFocus = False
Text = 'edtWeekOf'
WidthPercent = 100.000000000000000000
OnExit = edtWeekOfExit
end
object edtStartDate: TWebEdit
Left = 245
Top = 80
Width = 121
Height = 22
TabStop = False
ChildOrder = 2
ElementID = 'edt_start_date'
ElementFont = efCSS
HeightPercent = 100.000000000000000000
ShowFocus = False
Text = 'edtStartDate'
WidthPercent = 100.000000000000000000
end
object edtEndDate: TWebEdit
Left = 415
Top = 80
Width = 121
Height = 22
TabStop = False
ChildOrder = 3
ElementID = 'edt_end_date'
ElementFont = efCSS
HeightPercent = 100.000000000000000000
ShowFocus = False
Text = 'edtEndDate'
WidthPercent = 100.000000000000000000
end
object btnAddEntry: TWebButton
Left = 440
Top = 24
Width = 96
Height = 25
Caption = 'Add Entry'
ChildOrder = 3
ElementID = 'btn_add_entry'
ElementFont = efCSS
HeightPercent = 100.000000000000000000
TabStop = False
WidthPercent = 100.000000000000000000
OnClick = btnAddEntryClick
end
object btnDeleteEntry: TWebButton
Left = 338
Top = 24
Width = 96
Height = 25
Caption = 'Delete Entry'
ChildOrder = 5
ElementID = 'btn_delete_entry'
ElementFont = efCSS
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
OnClick = btnDeleteEntryClick
end
object btnSearchRange: TWebButton
Left = 236
Top = 24
Width = 96
Height = 25
Caption = 'Search Range'
ChildOrder = 6
ElementID = 'btn_search_range'
ElementFont = efCSS
HeightStyle = ssAuto
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
OnClick = btnSearchRangeClick
end
object btnCopyEntry: TWebButton
Left = 440
Top = 122
Width = 96
Height = 25
Caption = 'Copy'
ChildOrder = 7
ElementID = 'btn_copy_entry'
ElementFont = efCSS
HeightStyle = ssAuto
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
OnClick = btnCopyEntryClick
end
object xdwcTimeEntries: TXDataWebClient
Connection = DMConnection.ApiConnection
Left = 460
Top = 156
end
object xdwdsTimeEntries: TXDataWebDataSet
Left = 322
Top = 156
object xdwdsTimeEntriesentryId: TIntegerField
FieldName = 'entryId'
end
object xdwdsTimeEntriestaskDate: TStringField
FieldName = 'taskDate'
end
object xdwdsTimeEntriestaskId: TStringField
FieldName = 'taskId'
end
object xdwdsTimeEntriestaskDisplay: TStringField
FieldName = 'taskDisplay'
end
object xdwdsTimeEntrieshours: TFloatField
FieldName = 'hours'
end
object xdwdsTimeEntriestaskTime: TStringField
FieldName = 'taskTime'
end
object xdwdsTimeEntriescategory: TStringField
FieldName = 'category'
end
object xdwdsTimeEntriescategoryDesc: TStringField
FieldName = 'categoryDesc'
end
object xdwdsTimeEntriessummary: TStringField
FieldName = 'summary'
end
object xdwdsTimeEntriesplace: TStringField
FieldName = 'place'
end
object xdwdsTimeEntriesplaceDesc: TStringField
FieldName = 'placeDesc'
end
end
end
<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 gap-3">
<h5 class="mb-0 text-nowrap" id="lbl_time_entries_title"></h5>
<div class="d-flex align-items-center gap-2 ms-auto flex-nowrap">
<div id="lbl_time_total_rows" class="me-2 text-nowrap"></div>
<div class="d-flex align-items-center gap-2 flex-nowrap">
<label for="edt_week_of" class="form-label mb-0 text-nowrap small">Week of</label>
<input id="edt_week_of" type="date" class="form-control form-control-sm time-date-picker" />
</div>
<div class="d-flex align-items-center gap-2 flex-nowrap">
<label for="edt_start_date" class="form-label mb-0 text-nowrap small">Start</label>
<input id="edt_start_date" type="date" class="form-control form-control-sm time-date-picker" />
</div>
<div class="d-flex align-items-center gap-2 flex-nowrap">
<label for="edt_end_date" class="form-label mb-0 text-nowrap small">End</label>
<input id="edt_end_date" type="date" class="form-control form-control-sm time-date-picker" />
</div>
<button id="btn_search_range" class="btn btn-sm btn-primary text-nowrap">
Search Range
</button>
<button id="btn_add_entry" class="btn btn-sm btn-success text-nowrap">
Add Entry
</button>
<button id="btn_copy_entry" class="btn btn-sm btn-primary text-nowrap" disabled>
Copy Entry
</button>
<button id="btn_delete_entry" class="btn btn-sm btn-danger text-nowrap" disabled>
Delete Entry
</button>
</div>
</div>
<div id="lbl_validation_message" class="alert alert-danger py-1 px-2 mb-2 invisible small" style="min-height: 31px;"></div>
<div id="time_entries_table_host" class="flex-grow-1 min-h-0 overflow-auto"></div>
<div class="offcanvas offcanvas-end" tabindex="-1" id="task_picker_offcanvas" aria-labelledby="task_picker_title">
<div class="offcanvas-header">
<h5 class="offcanvas-title" id="task_picker_title">Find Task</h5>
<button type="button" class="btn-close" data-bs-dismiss="offcanvas" aria-label="Close"></button>
</div>
<div class="offcanvas-body">
<div class="mb-3">
<label for="task_picker_customer" class="form-label">Customer</label>
<select id="task_picker_customer" class="form-select form-select-sm">
<option value=""></option>
</select>
</div>
<div class="mb-3">
<label for="task_picker_project" class="form-label">Project</label>
<select id="task_picker_project" class="form-select form-select-sm" disabled>
<option value=""></option>
</select>
</div>
<div class="mb-3">
<label for="task_picker_task" class="form-label">Task</label>
<select id="task_picker_task" class="form-select form-select-sm" disabled>
<option value=""></option>
</select>
</div>
<div id="task_picker_status" class="alert alert-danger py-1 px-2 mb-3 d-none small"></div>
<div class="d-flex justify-content-end gap-2">
<button type="button" class="btn btn-outline-secondary btn-sm" data-bs-dismiss="offcanvas">
Cancel
</button>
<button type="button" class="btn btn-primary btn-sm" id="btn_task_picker_save" disabled>
Save
</button>
</div>
</div>
</div>
</div>
unit View.TimeEntries;
interface
uses
System.SysUtils, System.Classes, System.DateUtils, JS, Web, WEBLib.Graphics, WEBLib.Controls,
WEBLib.Forms, WEBLib.Dialogs, Vcl.Controls, Vcl.StdCtrls, WEBLib.StdCtrls, WEBLib.ExtCtrls, System.StrUtils,
XData.Web.Client, ConnectionModule, XData.Web.JsonDataset, Data.DB, XData.Web.Dataset, uTaskPickerOffCanvas;
type
TFTimeEntries = class(TWebForm)
edtWeekOf: TWebEdit;
edtStartDate: TWebEdit;
edtEndDate: TWebEdit;
xdwcTimeEntries: TXDataWebClient;
xdwdsTimeEntries: TXDataWebDataSet;
xdwdsTimeEntriesentryId: TIntegerField;
xdwdsTimeEntriestaskDate: TStringField;
xdwdsTimeEntriestaskId: TStringField;
xdwdsTimeEntriestaskDisplay: TStringField;
xdwdsTimeEntrieshours: TFloatField;
xdwdsTimeEntriestaskTime: TStringField;
xdwdsTimeEntriescategory: TStringField;
xdwdsTimeEntriessummary: TStringField;
xdwdsTimeEntriescategoryDesc: TStringField;
btnAddEntry: TWebButton;
lblValidationMessage: TWebLabel;
xdwdsTimeEntriesplace: TStringField;
xdwdsTimeEntriesplaceDesc: TStringField;
btnDeleteEntry: TWebButton;
btnSearchRange: TWebButton;
btnCopyEntry: TWebButton;
procedure WebFormCreate(Sender: TObject);
procedure btnAddEntryClick(Sender: TObject);
procedure btnDeleteEntryClick(Sender: TObject);
procedure edtWeekOfExit(Sender: TObject);
[async] procedure btnSearchRangeClick(Sender: TObject);
procedure btnCopyEntryClick(Sender: TObject);
private
FUserId: string;
FUserName: string;
FStartDate: string;
FEndDate: string;
FTaskOptions: TJSArray;
FCategoryOptions: TJSArray;
FPlaceOptions: TJSArray;
FUpdatingDates: Boolean;
FPendingScrollTop: Integer;
FPendingScrollLeft: Integer;
FActiveRowIndex: Integer;
FBlockedRowIndex: Integer;
FPendingEntryId: string;
FLastMouseDownRowIndex: Integer;
FLastMouseDownTime: Double;
FTaskPickerOffCanvas: TTaskPickerOffCanvas;
FAddingNewEntry: Boolean;
FNewEntryRowIndex: Integer;
[async] procedure LoadTimeEntries;
function BeginAddEntry: Boolean;
function IsNewEntryRow(AIndex: Integer): Boolean;
procedure ResetNewEntryState;
procedure BindNewEntryButtons;
procedure NewEntrySaveClick(Event: TJSEvent);
procedure NewEntryCancelClick(Event: TJSEvent);
[async] procedure SaveNewEntry;
procedure CancelNewEntry;
procedure RenderTable;
procedure BindTableEditors;
procedure DropdownItemClick(Event: TJSEvent);
procedure EnableColumnResize;
procedure EnableAutoGrowTextAreas;
procedure GotoRowIndex(AIndex: Integer);
function HtmlEncode(const s: string): string;
function IsoToDate(const AValue: string): TDateTime;
function DateToIso(const AValue: TDateTime): string;
procedure SetWeekRangeFromAnchor(const ADateValue: string; ALoadAfterSet: Boolean);
procedure SetTotalRowsLabel(ARowCount: Integer);
procedure SetTimeEntriesLabel(const AName: string);
procedure CaptureTableScroll;
procedure RestoreTableScroll;
procedure ScrollToNewEntryRow;
procedure EditorInput(Event: TJSEvent);
procedure RowFocusOut(Event: TJSEvent);
procedure RowClick(Event: TJSEvent);
function ValidateRow(AIndex: Integer): Boolean;
procedure ApplyPendingEntryFocus;
procedure ApplyRowValidation(AIndex: Integer);
procedure ClearRowValidation(AIndex: Integer);
procedure ShowRowValidationMessage(AIndex: Integer; const AMessage: string);
procedure HideRowValidationMessage;
procedure SetTopControlsEnabled(AEnabled: Boolean);
function GetTargetRowIndex(ATarget: TJSHTMLElement): Integer;
procedure DocumentMouseDown(Event: TJSEvent);
[async] procedure TaskPickerButtonClick(Event: TJSEvent);
procedure TaskPickerTaskSelected(ARowIndex: Integer; const ATaskId, ATaskDisplay: string);
procedure ApplyActiveRowState;
procedure EditorBlur(Event: TJSEvent);
[async] procedure SaveField(AIndex: Integer; const AFieldName: string);
[async] procedure DeleteSelectedEntry;
function CopySelectedEntry: Boolean;
public
end;
var
FTimeEntries: TFTimeEntries;
implementation
uses
Auth.Service,
Utils;
{$R *.dfm}
procedure TFTimeEntries.WebFormCreate(Sender: TObject);
var
payload: TJSObject;
anchorDate: string;
begin
console.log('TFTimeEntries.WebFormCreate fired');
FTaskOptions := TJSArray.new;
FCategoryOptions := TJSArray.new;
FPlaceOptions := TJSArray.new;
FUpdatingDates := False;
FPendingScrollTop := 0;
FPendingScrollLeft := 0;
FActiveRowIndex := -1;
FBlockedRowIndex := -1;
FPendingEntryId := '';
FLastMouseDownRowIndex := -1;
FLastMouseDownTime := 0;
FAddingNewEntry := False;
FNewEntryRowIndex := -1;
FTaskPickerOffCanvas := TTaskPickerOffCanvas.Create(xdwcTimeEntries, @TaskPickerTaskSelected);
document.addEventListener('mousedown', TJSEventHandler(@DocumentMouseDown));
payload := AuthService.TokenPayload;
if Assigned(payload) then
begin
FUserId := JS.toString(payload.Properties['user_id']);
FUserName := JS.toString(payload.Properties['user_fullname']);
if FUserName = '' then
FUserName := JS.toString(payload.Properties['user_name']);
end;
SetTimeEntriesLabel(FUserName);
btnDeleteEntry.Enabled := False;
btnCopyEntry.Enabled := False;
anchorDate := DMConnection.currentTimeEntryDate;
if anchorDate = '' then
anchorDate := Application.Parameters.Values['date'];
if anchorDate = '' then
anchorDate := DateToIso(Date);
SetWeekRangeFromAnchor(anchorDate, False);
if not DMConnection.ApiConnection.Connected then
begin
DMConnection.ApiConnection.Open(
procedure
begin
LoadTimeEntries;
end
);
end
else
LoadTimeEntries;
end;
function TFTimeEntries.HtmlEncode(const s: string): string;
begin
Result := s;
Result := StringReplace(Result, '&', '&amp;', [rfReplaceAll]);
Result := StringReplace(Result, '<', '&lt;', [rfReplaceAll]);
Result := StringReplace(Result, '>', '&gt;', [rfReplaceAll]);
Result := StringReplace(Result, '"', '&quot;', [rfReplaceAll]);
Result := StringReplace(Result, '''', '&#39;', [rfReplaceAll]);
end;
function TFTimeEntries.IsoToDate(const AValue: string): TDateTime;
var
yearValue: Integer;
monthValue: Integer;
dayValue: Integer;
begin
if Length(AValue) < 10 then
Exit(Date);
yearValue := StrToIntDef(Copy(AValue, 1, 4), YearOf(Date));
monthValue := StrToIntDef(Copy(AValue, 6, 2), MonthOf(Date));
dayValue := StrToIntDef(Copy(AValue, 9, 2), DayOf(Date));
Result := EncodeDate(yearValue, monthValue, dayValue);
end;
function TFTimeEntries.DateToIso(const AValue: TDateTime): string;
begin
Result := FormatDateTime('yyyy-mm-dd', AValue);
end;
procedure TFTimeEntries.SetWeekRangeFromAnchor(const ADateValue: string; ALoadAfterSet: Boolean);
var
anchorDate: TDateTime;
weekStart: TDateTime;
weekEnd: TDateTime;
begin
anchorDate := IsoToDate(ADateValue);
weekStart := anchorDate - (DayOfTheWeek(anchorDate) - 1);
weekEnd := weekStart + 6;
FUpdatingDates := True;
try
edtWeekOf.Text := DateToIso(anchorDate);
edtStartDate.Text := DateToIso(weekStart);
edtEndDate.Text := DateToIso(weekEnd);
FStartDate := edtStartDate.Text;
FEndDate := edtEndDate.Text;
finally
FUpdatingDates := False;
end;
if ALoadAfterSet then
LoadTimeEntries;
end;
procedure TFTimeEntries.edtWeekOfExit(Sender: TObject);
begin
if FUpdatingDates then
Exit;
if edtWeekOf.Text = '' then
Exit;
SetWeekRangeFromAnchor(edtWeekOf.Text, True);
end;
procedure TFTimeEntries.GotoRowIndex(AIndex: Integer);
var
i: Integer;
begin
if (AIndex < 0) or (not xdwdsTimeEntries.Active) then
Exit;
xdwdsTimeEntries.First;
i := 0;
while (i < AIndex) and (not xdwdsTimeEntries.Eof) do
begin
xdwdsTimeEntries.Next;
Inc(i);
end;
end;
procedure TFTimeEntries.SetTotalRowsLabel(ARowCount: Integer);
var
el: TJSHTMLElement;
begin
el := TJSHTMLElement(document.getElementById('lbl_time_total_rows'));
el.innerText := 'Total Rows: ' + IntToStr(ARowCount);
end;
procedure TFTimeEntries.SetTimeEntriesLabel(const AName: string);
var
el: TJSHTMLElement;
displayName: string;
begin
displayName := Trim(AName);
if displayName = '' then
displayName := 'User';
el := TJSHTMLElement(document.getElementById('lbl_time_entries_title'));
el.innerText := displayName + '''s Time Entries';
end;
[async] procedure TFTimeEntries.LoadTimeEntries;
var
response: TXDataClientResponse;
resultObj: TJSObject;
itemsArray: TJSArray;
userNameValue: string;
rowCount: Integer;
begin
console.log('ITimeEntryService.GetTimeEntries called with user_id=' + FUserId + ' start=' + FStartDate + ' end=' + FEndDate);
if FUserId = '' then
begin
Utils.ShowErrorModal('Unable to determine logged-in user.');
Exit;
end;
Utils.ShowSpinner('spinner');
try
try
response := await(xdwcTimeEntries.RawInvokeAsync(
'ITimeEntryService.GetTimeEntries', [FUserId, FStartDate, FEndDate]
));
except
on E: EXDataClientRequestException do
begin
Utils.ShowErrorModal(E.ErrorResult.ErrorMessage);
Exit;
end;
end;
resultObj := TJSObject(response.Result);
userNameValue := string(resultObj['userName']);
if userNameValue <> '' then
SetTimeEntriesLabel(userNameValue)
else
SetTimeEntriesLabel(FUserName);
rowCount := StrToIntDef(string(resultObj['count']), 0);
SetTotalRowsLabel(rowCount);
FTaskOptions := TJSArray(resultObj['taskOptions']);
FCategoryOptions := TJSArray(resultObj['categoryOptions']);
FPlaceOptions := TJSArray(resultObj['placeOptions']);
itemsArray := TJSArray(resultObj['items']);
xdwdsTimeEntries.Close;
xdwdsTimeEntries.SetJsonData(itemsArray);
xdwdsTimeEntries.Open;
FActiveRowIndex := -1;
HideRowValidationMessage;
SetTopControlsEnabled(True);
btnDeleteEntry.Enabled := False;
btnCopyEntry.Enabled := False;
RenderTable;
finally
Utils.HideSpinner('spinner');
end;
end;
procedure TFTimeEntries.RenderTable;
var
host: TJSHTMLElement;
html: string;
rowIdx: Integer;
hoursText: string;
function Th(const s: string): string;
begin
Result := '<th scope="col">' + s + '</th>';
end;
function TdNowrap(const s: string): string;
begin
Result := '<td class="align-top nowrap-cell">' + s + '</td>';
end;
function TdWrap(const s: string): string;
begin
Result := '<td class="align-top wrap-cell">' + s + '</td>';
end;
function TextInput(const FieldName, Value: string; const AIdx: Integer): string;
begin
Result :=
'<input class="form-control form-control-sm cell-input time-editor w-100" ' +
'data-idx="' + IntToStr(AIdx) + '" data-field="' + FieldName + '" ' +
'value="' + HtmlEncode(Value) + '">';
end;
function DateInput(const FieldName, Value: string; const AIdx: Integer): string;
var
dateValue: string;
begin
dateValue := Utils.NormalizeDateValue(Value);
Result :=
'<input type="date" class="form-control form-control-sm cell-input time-editor w-100" ' +
'data-idx="' + IntToStr(AIdx) + '" data-field="' + FieldName + '" ' +
'value="' + HtmlEncode(dateValue) + '">';
end;
function HoursInput(const FieldName, Value: string; const AIdx: Integer): string;
begin
Result :=
'<input type="number" step="0.01" min="0" class="form-control form-control-sm cell-input time-editor w-100 text-end" ' +
'data-idx="' + IntToStr(AIdx) + '" data-field="' + FieldName + '" ' +
'value="' + HtmlEncode(Value) + '">';
end;
function SelectList(const FieldName, CurrentValue, CurrentDisplay: string; const AIdx: Integer; const Items: TJSArray; const ValueProp, DisplayProp: string; AAllowBlank, AShowTaskPicker: Boolean): string;
var
i: Integer;
optionObj: TJSObject;
optionValue: string;
optionDisplay: string;
triggerId: string;
begin
triggerId := 'time_dd_' + FieldName + '_' + IntToStr(AIdx);
Result := '';
if AShowTaskPicker then
Result := Result +
'<div class="input-group input-group-sm flex-nowrap w-100">';
Result := Result +
'<div class="dropdown flex-grow-1" style="min-width:0;">' +
'<button id="' + triggerId + '" class="btn btn-sm border w-100 d-flex justify-content-between align-items-center text-start time-dd-toggle btn-light' +
IfThen(AShowTaskPicker, ' rounded-end-0', '') + '" ' +
'type="button" data-bs-toggle="dropdown" aria-expanded="false" ' +
'data-idx="' + IntToStr(AIdx) + '" data-field="' + FieldName + '">' +
'<span class="time-dd-label text-truncate">' + HtmlEncode(CurrentDisplay) + '</span>' +
'<span class="dropdown-toggle dropdown-toggle-split border-0 ms-2"></span>' +
'</button>' +
'<div class="dropdown-menu w-100 p-0 pe-1 overflow-hidden">';
if AAllowBlank then
begin
Result := Result +
'<button type="button" class="dropdown-item time-dd-item" ' +
'data-idx="' + IntToStr(AIdx) + '" ' +
'data-field="' + FieldName + '" ' +
'data-value="" ' +
'data-display="" ' +
'data-trigger-id="' + triggerId + '">&nbsp;</button>';
end;
for i := 0 to Items.length - 1 do
begin
optionObj := TJSObject(Items[i]);
optionValue := string(optionObj[ValueProp]);
optionDisplay := string(optionObj[DisplayProp]);
Result := Result +
'<button type="button" class="dropdown-item time-dd-item" ' +
'data-idx="' + IntToStr(AIdx) + '" ' +
'data-field="' + FieldName + '" ' +
'data-value="' + HtmlEncode(optionValue) + '" ' +
'data-display="' + HtmlEncode(optionDisplay) + '" ' +
'data-trigger-id="' + triggerId + '">' + HtmlEncode(optionDisplay) + '</button>';
end;
Result := Result +
'</div>' +
'</div>';
if AShowTaskPicker then
begin
Result := Result +
'<button type="button" class="btn btn-outline-secondary time-task-picker-btn flex-shrink-0 text-nowrap" ' +
'data-idx="' + IntToStr(AIdx) + '" title="Find task">Find</button>' +
'</div>';
end;
end;
function SummaryTextArea(const FieldName, Value: string; const AIdx: Integer): string;
begin
Result :=
'<textarea rows="1" class="form-control form-control-sm cell-textarea time-textarea time-editor w-100" ' +
'data-idx="' + IntToStr(AIdx) + '" data-field="' + FieldName + '" ' +
'style="min-height:31px; height:31px; overflow:hidden; resize:none;">' + HtmlEncode(Value) + '</textarea>';
end;
begin
host := TJSHTMLElement(document.getElementById('time_entries_table_host'));
html :=
'<div class="time-vscroll">' +
'<div class="time-hscroll">' +
'<table class="table table-sm table-bordered align-middle mb-0 time-table" style="min-width: 1710px; table-layout: fixed;">' +
'<colgroup>' +
'<col style="width:140px">' + // Date
'<col style="width:500px">' + // Task
'<col style="width:90px">' + // Hours
'<col style="width:150px">' + // Time
'<col style="width:160px">' + // Place
'<col style="width:190px">' + // Category
'<col style="width:480px">' + // Summary
'</colgroup>' +
'<thead><tr>' +
Th('Date') +
Th('Task') +
Th('Hours') +
Th('Time') +
Th('Place') +
Th('Category') +
Th('Summary') +
'</tr></thead><tbody>';
rowIdx := 0;
xdwdsTimeEntries.First;
while not xdwdsTimeEntries.Eof do
begin
if xdwdsTimeEntrieshours.IsNull then
hoursText := ''
else
hoursText := FormatFloat('0.##', xdwdsTimeEntrieshours.AsFloat);
html := html +
'<tr class="time-row-selectable" data-idx="' + IntToStr(rowIdx) + '" data-entry-id="' + IntToStr(xdwdsTimeEntriesentryId.AsInteger) + '" data-task-id="' + xdwdsTimeEntriestaskId.AsString + '">' +
TdNowrap(DateInput('taskDate', xdwdsTimeEntriestaskDate.AsString, rowIdx)) +
TdNowrap(SelectList('taskId', xdwdsTimeEntriestaskId.AsString, xdwdsTimeEntriestaskDisplay.AsString, rowIdx, FTaskOptions, 'taskId', 'taskDisplay', False, True)) +
TdNowrap(HoursInput('hours', hoursText, rowIdx)) +
TdNowrap(TextInput('taskTime', xdwdsTimeEntriestaskTime.AsString, rowIdx)) +
TdNowrap(SelectList('place', xdwdsTimeEntriesplace.AsString, xdwdsTimeEntriesplaceDesc.AsString, rowIdx, FPlaceOptions, 'code', 'codeDesc', True, False)) +
TdNowrap(SelectList('category', xdwdsTimeEntriescategory.AsString, xdwdsTimeEntriescategoryDesc.AsString, rowIdx, FCategoryOptions, 'code', 'codeDesc', False, False)) +
TdWrap(SummaryTextArea('summary', xdwdsTimeEntriessummary.AsString, rowIdx)) +
'</tr>';
if IsNewEntryRow(rowIdx) then
begin
html := html +
'<tr class="time-new-entry-actions-row">' +
'<td colspan="7" class="p-0 border-0">' +
'<div class="position-sticky d-inline-flex py-1 ps-2" style="left:0; z-index:5; pointer-events:none;">' +
'<div class="bg-body border rounded shadow-sm p-2 d-flex gap-2" style="pointer-events:auto;">' +
'<button type="button" id="btn_time_new_save" class="btn btn-sm btn-success">Save</button>' +
'<button type="button" id="btn_time_new_cancel" class="btn btn-sm btn-outline-secondary">Cancel</button>' +
'</div>' +
'</div>' +
'</td>' +
'</tr>';
end;
xdwdsTimeEntries.Next;
Inc(rowIdx);
end;
html := html + '</tbody></table></div></div>';
SetTotalRowsLabel(rowIdx);
host.innerHTML := html;
BindNewEntryButtons;
BindTableEditors;
EnableAutoGrowTextAreas;
EnableColumnResize;
RestoreTableScroll;
ApplyPendingEntryFocus;
ApplyActiveRowState;
end;
procedure TFTimeEntries.BindNewEntryButtons;
var
btnSave: TJSHTMLElement;
btnCancel: TJSHTMLElement;
begin
btnSave := TJSHTMLElement(document.getElementById('btn_time_new_save'));
if Assigned(btnSave) then
btnSave.addEventListener('click', TJSEventHandler(@NewEntrySaveClick));
btnCancel := TJSHTMLElement(document.getElementById('btn_time_new_cancel'));
if Assigned(btnCancel) then
btnCancel.addEventListener('click', TJSEventHandler(@NewEntryCancelClick));
end;
procedure TFTimeEntries.NewEntrySaveClick(Event: TJSEvent);
begin
Event.preventDefault;
Event.stopPropagation;
SaveNewEntry;
end;
procedure TFTimeEntries.NewEntryCancelClick(Event: TJSEvent);
begin
Event.preventDefault;
Event.stopPropagation;
Utils.ShowConfirmationModal(
'Discard the new unsaved time entry?',
'Discard',
'Cancel',
procedure(AConfirmed: Boolean)
begin
if AConfirmed then
CancelNewEntry;
end
);
end;
[async] procedure TFTimeEntries.SaveNewEntry;
var
response: TXDataClientResponse;
resultObj: TJSObject;
payload: TJSObject;
begin
if not FAddingNewEntry then
Exit;
GotoRowIndex(FNewEntryRowIndex);
if xdwdsTimeEntries.Eof then
Exit;
if not ValidateRow(FNewEntryRowIndex) then
begin
ApplyRowValidation(FNewEntryRowIndex);
ShowRowValidationMessage(FNewEntryRowIndex, 'Complete required fields before saving this entry.');
SetTopControlsEnabled(False);
Exit;
end;
payload := TJSObject.new;
payload['entryId'] := '0';
payload['userId'] := FUserId;
payload['taskDate'] := xdwdsTimeEntriestaskDate.AsString;
payload['taskId'] := xdwdsTimeEntriestaskId.AsString;
payload['hours'] := xdwdsTimeEntrieshours.AsFloat;
payload['taskTime'] := xdwdsTimeEntriestaskTime.AsString;
payload['place'] := xdwdsTimeEntriesplace.AsString;
payload['category'] := xdwdsTimeEntriescategory.AsString;
payload['summary'] := xdwdsTimeEntriessummary.AsString;
Utils.ShowSpinner('spinner');
try
try
response := await(xdwcTimeEntries.RawInvokeAsync(
'ITimeEntryService.SaveTimeEntry',
[payload]
));
resultObj := TJSObject(response.Result);
FPendingEntryId := string(resultObj['value']);
except
on E: EXDataClientRequestException do
begin
console.log('SaveNewEntry ERROR: ' + E.ErrorResult.ErrorMessage);
Utils.ShowErrorModal(E.ErrorResult.ErrorMessage);
Exit;
end;
end;
ResetNewEntryState;
FActiveRowIndex := -1;
HideRowValidationMessage;
SetTopControlsEnabled(True);
btnDeleteEntry.Enabled := False;
btnCopyEntry.Enabled := False;
CaptureTableScroll;
await(LoadTimeEntries);
finally
Utils.HideSpinner('spinner');
end;
end;
procedure TFTimeEntries.CancelNewEntry;
begin
if not FAddingNewEntry then
Exit;
if xdwdsTimeEntries.Active then
begin
GotoRowIndex(FNewEntryRowIndex);
if not xdwdsTimeEntries.Eof then
xdwdsTimeEntries.Delete;
end;
ResetNewEntryState;
FActiveRowIndex := -1;
HideRowValidationMessage;
SetTopControlsEnabled(True);
btnDeleteEntry.Enabled := False;
btnCopyEntry.Enabled := False;
RenderTable;
end;
procedure TFTimeEntries.BindTableEditors;
var
nodes: TJSNodeList;
i: Integer;
el: TJSHTMLElement;
begin
console.log('BindTableEditors: wiring time entry handlers...');
nodes := document.querySelectorAll('.time-editor');
console.log('BindTableEditors: time-editor count=' + IntToStr(nodes.length));
for i := 0 to nodes.length - 1 do
begin
el := TJSHTMLElement(nodes.item(i));
el.addEventListener('input', TJSEventHandler(@EditorInput));
el.addEventListener('blur', TJSEventHandler(@EditorBlur));
end;
nodes := document.querySelectorAll('.time-dd-item');
console.log('BindTableEditors: time-dd-item count=' + IntToStr(nodes.length));
for i := 0 to nodes.length - 1 do
begin
el := TJSHTMLElement(nodes.item(i));
el.addEventListener('click', TJSEventHandler(@DropdownItemClick));
end;
nodes := document.querySelectorAll('.time-task-picker-btn');
console.log('BindTableEditors: time-task-picker-btn count=' + IntToStr(nodes.length));
for i := 0 to nodes.length - 1 do
begin
el := TJSHTMLElement(nodes.item(i));
el.addEventListener('click', TJSEventHandler(@TaskPickerButtonClick));
end;
nodes := document.querySelectorAll('.time-row-selectable');
console.log('BindTableEditors: time-row-selectable count=' + IntToStr(nodes.length));
for i := 0 to nodes.length - 1 do
begin
el := TJSHTMLElement(nodes.item(i));
el.addEventListener('click', TJSEventHandler(@RowClick));
el.addEventListener('focusout', TJSEventHandler(@RowFocusOut));
end;
end;
procedure TFTimeEntries.EditorInput(Event: TJSEvent);
var
el: TJSHTMLElement;
idx: Integer;
idxStr: string;
fieldName: string;
newVal: string;
begin
if not xdwdsTimeEntries.Active then
Exit;
el := TJSHTMLElement(Event.target);
idxStr := string(el.getAttribute('data-idx'));
fieldName := string(el.getAttribute('data-field'));
idx := StrToIntDef(idxStr, -1);
if (idx < 0) or (fieldName = '') then
Exit;
FActiveRowIndex := idx;
btnDeleteEntry.Enabled := not IsNewEntryRow(idx);
btnCopyEntry.Enabled := not IsNewEntryRow(idx);
GotoRowIndex(idx);
if xdwdsTimeEntries.Eof then
Exit;
newVal := string(TJSObject(el)['value']);
xdwdsTimeEntries.Edit;
if SameText(fieldName, 'taskDate') then
xdwdsTimeEntriestaskDate.AsString := newVal
else if SameText(fieldName, 'hours') then
begin
if Trim(newVal) = '' then
xdwdsTimeEntrieshours.Clear
else
xdwdsTimeEntrieshours.AsFloat := StrToFloatDef(newVal, 0);
end
else if SameText(fieldName, 'taskTime') then
xdwdsTimeEntriestaskTime.AsString := newVal
else if SameText(fieldName, 'summary') then
xdwdsTimeEntriessummary.AsString := newVal
else
xdwdsTimeEntries.FieldByName(fieldName).AsString := newVal;
xdwdsTimeEntries.Post;
el.setAttribute('data-unsaved-data', '1');
if IsNewEntryRow(idx) then
begin
if ValidateRow(idx) then
ClearRowValidation(idx);
SetTopControlsEnabled(False);
Exit;
end;
if ValidateRow(idx) then
begin
ClearRowValidation(idx);
SetTopControlsEnabled(True);
end
else
SetTopControlsEnabled(False);
end;
procedure TFTimeEntries.RowClick(Event: TJSEvent);
var
rowEl: TJSHTMLElement;
idx: Integer;
begin
rowEl := TJSHTMLElement(Event.currentTarget);
idx := StrToIntDef(string(rowEl.getAttribute('data-idx')), -1);
if idx < 0 then
Exit;
if FAddingNewEntry and (idx <> FNewEntryRowIndex) then
begin
Event.preventDefault;
Event.stopPropagation;
FActiveRowIndex := FNewEntryRowIndex;
btnDeleteEntry.Enabled := False;
btnCopyEntry.Enabled := False;
SetTopControlsEnabled(False);
FBlockedRowIndex := FNewEntryRowIndex;
lblValidationMessage.Caption := 'Save or cancel the new entry before selecting another row.';
lblValidationMessage.ElementHandle.classList.remove('d-none');
lblValidationMessage.ElementHandle.classList.remove('invisible');
ApplyActiveRowState;
Exit;
end;
if (FActiveRowIndex >= 0) and
(idx <> FActiveRowIndex) and
(not ValidateRow(FActiveRowIndex)) then
begin
Event.preventDefault;
Event.stopPropagation;
ApplyRowValidation(FActiveRowIndex);
ShowRowValidationMessage(FActiveRowIndex, 'Complete required fields before leaving this row.');
ApplyActiveRowState;
Exit;
end;
FActiveRowIndex := idx;
btnDeleteEntry.Enabled := not IsNewEntryRow(idx);
btnCopyEntry.Enabled := not IsNewEntryRow(idx);
ApplyActiveRowState;
end;
procedure TFTimeEntries.RowFocusOut(Event: TJSEvent);
var
rowEl: TJSHTMLElement;
idx: Integer;
begin
rowEl := TJSHTMLElement(Event.currentTarget);
window.setTimeout(
procedure
begin
idx := StrToIntDef(string(rowEl.getAttribute('data-idx')), -1);
if idx < 0 then
Exit;
if IsNewEntryRow(idx) then
Exit;
if (FLastMouseDownRowIndex = idx) and ((TJSDate.now - FLastMouseDownTime) < 500) then
Exit;
if Assigned(document.activeElement) and rowEl.contains(document.activeElement) then
Exit;
if not ValidateRow(idx) then
begin
FActiveRowIndex := idx;
btnDeleteEntry.Enabled := True;
btnCopyEntry.Enabled := True;
ApplyRowValidation(idx);
ShowRowValidationMessage(idx, 'Complete required fields before leaving this row.');
SetTopControlsEnabled(False);
Exit;
end;
ClearRowValidation(idx);
SetTopControlsEnabled(True);
end,
0
);
end;
procedure TFTimeEntries.DropdownItemClick(Event: TJSEvent);
var
el: TJSHTMLElement;
idx: Integer;
idxStr: string;
fieldName: string;
newValue: string;
newDisplay: string;
triggerId: string;
btn: TJSHTMLElement;
labelEl: TJSHTMLElement;
begin
if not xdwdsTimeEntries.Active then
Exit;
Event.preventDefault;
el := TJSHTMLElement(Event.currentTarget);
idxStr := string(el.getAttribute('data-idx'));
fieldName := string(el.getAttribute('data-field'));
newValue := string(el.getAttribute('data-value'));
newDisplay := string(el.getAttribute('data-display'));
triggerId := string(el.getAttribute('data-trigger-id'));
idx := StrToIntDef(idxStr, -1);
if (idx < 0) or (fieldName = '') then
Exit;
if FAddingNewEntry and (idx <> FNewEntryRowIndex) then
begin
Event.preventDefault;
Event.stopPropagation;
FActiveRowIndex := FNewEntryRowIndex;
btnDeleteEntry.Enabled := False;
btnCopyEntry.Enabled := False;
SetTopControlsEnabled(False);
FBlockedRowIndex := FNewEntryRowIndex;
lblValidationMessage.Caption := 'Save or cancel the new entry before changing another row.';
lblValidationMessage.ElementHandle.classList.remove('d-none');
lblValidationMessage.ElementHandle.classList.remove('invisible');
ApplyActiveRowState;
Exit;
end;
if (FActiveRowIndex >= 0) and
(idx <> FActiveRowIndex) and
(not ValidateRow(FActiveRowIndex)) then
begin
Event.preventDefault;
Event.stopPropagation;
ApplyRowValidation(FActiveRowIndex);
ShowRowValidationMessage(FActiveRowIndex, 'Complete required fields before changing another row.');
SetTopControlsEnabled(False);
ApplyActiveRowState;
Exit;
end;
GotoRowIndex(idx);
if xdwdsTimeEntries.Eof then
Exit;
xdwdsTimeEntries.Edit;
if SameText(fieldName, 'taskId') then
begin
xdwdsTimeEntriestaskId.AsString := newValue;
xdwdsTimeEntriestaskDisplay.AsString := newDisplay;
end
else if SameText(fieldName, 'place') then
begin
xdwdsTimeEntriesplace.AsString := newValue;
xdwdsTimeEntriesplaceDesc.AsString := newDisplay;
end
else if SameText(fieldName, 'category') then
begin
xdwdsTimeEntriescategory.AsString := newValue;
xdwdsTimeEntriescategoryDesc.AsString := newDisplay;
end
else
xdwdsTimeEntries.FieldByName(fieldName).AsString := newValue;
xdwdsTimeEntries.Post;
FActiveRowIndex := idx;
btnDeleteEntry.Enabled := not IsNewEntryRow(idx);
btnCopyEntry.Enabled := not IsNewEntryRow(idx);
btn := TJSHTMLElement(document.getElementById(triggerId));
if Assigned(btn) then
begin
labelEl := TJSHTMLElement(btn.querySelector('.time-dd-label'));
if Assigned(labelEl) then
labelEl.textContent := newDisplay;
btn.focus;
end;
if not IsNewEntryRow(idx) then
SaveField(idx, fieldName);
if IsNewEntryRow(idx) then
begin
if ValidateRow(idx) then
ClearRowValidation(idx);
SetTopControlsEnabled(False);
Exit;
end;
if ValidateRow(idx) then
begin
ClearRowValidation(idx);
SetTopControlsEnabled(True);
end
else
SetTopControlsEnabled(False);
end;
function TFTimeEntries.ValidateRow(AIndex: Integer): Boolean;
var
hasDate: Boolean;
hasTask: Boolean;
hasHours: Boolean;
hasCategory: Boolean;
hasSummary: Boolean;
begin
Result := False;
if not xdwdsTimeEntries.Active then
Exit;
GotoRowIndex(AIndex);
if xdwdsTimeEntries.Eof then
Exit;
hasDate := Trim(xdwdsTimeEntriestaskDate.AsString) <> '';
hasTask := Trim(xdwdsTimeEntriestaskId.AsString) <> '';
if xdwdsTimeEntrieshours.IsNull then
hasHours := False
else
hasHours := xdwdsTimeEntrieshours.AsFloat > 0;
hasCategory := Trim(xdwdsTimeEntriescategory.AsString) <> '';
hasSummary := Trim(xdwdsTimeEntriessummary.AsString) <> '';
Result := hasDate and hasTask and hasHours and hasCategory and hasSummary;
end;
procedure TFTimeEntries.ApplyPendingEntryFocus;
var
rowEl: TJSHTMLElement;
idx: Integer;
firstEditor: TJSHTMLElement;
begin
if FPendingEntryId = '' then
Exit;
rowEl := TJSHTMLElement(document.querySelector('tr[data-entry-id="' + FPendingEntryId + '"]'));
if not Assigned(rowEl) then
begin
FPendingEntryId := '';
Exit;
end;
idx := StrToIntDef(string(rowEl.getAttribute('data-idx')), -1);
if idx < 0 then
begin
FPendingEntryId := '';
Exit;
end;
FActiveRowIndex := idx;
btnDeleteEntry.Enabled := True;
btnCopyEntry.Enabled := True;
SetTopControlsEnabled(True);
ApplyActiveRowState;
firstEditor := TJSHTMLElement(rowEl.querySelector('[data-field="taskId"]'));
if not Assigned(firstEditor) then
firstEditor := TJSHTMLElement(rowEl.querySelector('[data-field="hours"]'));
if Assigned(firstEditor) then
begin
asm
firstEditor.scrollIntoView({ behavior: 'auto', block: 'nearest', inline: 'nearest' });
firstEditor.focus();
end;
end;
FPendingEntryId := '';
end;
procedure TFTimeEntries.ApplyRowValidation(AIndex: Integer);
var
rowEl: TJSHTMLElement;
hoursInvalid: Boolean;
procedure SetInvalid(const AFieldName: string; AInvalid: Boolean);
var
fieldEl: TJSHTMLElement;
begin
fieldEl := TJSHTMLElement(rowEl.querySelector('[data-field="' + AFieldName + '"]'));
if AInvalid then
fieldEl.classList.add('is-invalid')
else
fieldEl.classList.remove('is-invalid');
end;
begin
if not xdwdsTimeEntries.Active then
Exit;
GotoRowIndex(AIndex);
if xdwdsTimeEntries.Eof then
Exit;
rowEl := TJSHTMLElement(document.querySelector('tr[data-idx="' + IntToStr(AIndex) + '"]'));
if xdwdsTimeEntrieshours.IsNull then
hoursInvalid := True
else
hoursInvalid := xdwdsTimeEntrieshours.AsFloat <= 0;
SetInvalid('taskDate', Trim(xdwdsTimeEntriestaskDate.AsString) = '');
SetInvalid('taskId', Trim(xdwdsTimeEntriestaskId.AsString) = '');
SetInvalid('hours', hoursInvalid);
SetInvalid('category', Trim(xdwdsTimeEntriescategory.AsString) = '');
SetInvalid('summary', Trim(xdwdsTimeEntriessummary.AsString) = '');
end;
procedure TFTimeEntries.EnableAutoGrowTextAreas;
begin
asm
(function(){
const host = document.getElementById('time_entries_table_host');
if(!host) return;
host.querySelectorAll('.time-textarea').forEach(function(editor){
const fit = function() {
editor.style.height = 'auto';
editor.style.height = editor.scrollHeight + 'px';
};
fit();
editor.addEventListener('input', fit);
});
})();
end;
end;
procedure TFTimeEntries.ClearRowValidation(AIndex: Integer);
var
rowEl: TJSHTMLElement;
nodes: TJSNodeList;
i: Integer;
el: TJSHTMLElement;
begin
rowEl := TJSHTMLElement(document.querySelector('tr[data-idx="' + IntToStr(AIndex) + '"]'));
nodes := rowEl.querySelectorAll('.is-invalid');
for i := 0 to nodes.length - 1 do
begin
el := TJSHTMLElement(nodes.item(i));
el.classList.remove('is-invalid');
end;
SetTopControlsEnabled(True);
HideRowValidationMessage;
end;
procedure TFTimeEntries.ShowRowValidationMessage(AIndex: Integer; const AMessage: string);
var
rowEl: TJSHTMLElement;
firstInvalidEl: TJSHTMLElement;
begin
FBlockedRowIndex := AIndex;
lblValidationMessage.Caption := AMessage;
lblValidationMessage.ElementHandle.classList.remove('d-none');
lblValidationMessage.ElementHandle.classList.remove('invisible');
rowEl := TJSHTMLElement(document.querySelector('tr[data-idx="' + IntToStr(AIndex) + '"]'));
firstInvalidEl := TJSHTMLElement(rowEl.querySelector('.is-invalid'));
firstInvalidEl.focus;
ApplyActiveRowState;
end;
procedure TFTimeEntries.HideRowValidationMessage;
begin
FBlockedRowIndex := -1;
lblValidationMessage.Caption := '';
lblValidationMessage.ElementHandle.classList.add('invisible');
ApplyActiveRowState;
end;
function TFTimeEntries.GetTargetRowIndex(ATarget: TJSHTMLElement): Integer;
var
el: TJSHTMLElement;
idxText: string;
begin
Result := -1;
el := ATarget;
while Assigned(el) do
begin
if el.hasAttribute('data-idx') then
begin
idxText := string(el.getAttribute('data-idx'));
Result := StrToIntDef(idxText, -1);
if Result >= 0 then
Exit;
end;
el := TJSHTMLElement(el.parentElement);
end;
end;
procedure TFTimeEntries.DocumentMouseDown(Event: TJSEvent);
var
targetEl: TJSHTMLElement;
targetRowIndex: Integer;
begin
targetEl := TJSHTMLElement(Event.target);
targetRowIndex := GetTargetRowIndex(targetEl);
if FAddingNewEntry and
(targetRowIndex >= 0) and
(targetRowIndex <> FNewEntryRowIndex) then
begin
Event.preventDefault;
Event.stopPropagation;
FActiveRowIndex := FNewEntryRowIndex;
btnDeleteEntry.Enabled := False;
btnCopyEntry.Enabled := False;
SetTopControlsEnabled(False);
FBlockedRowIndex := FNewEntryRowIndex;
lblValidationMessage.Caption := 'Save or cancel the new entry before selecting another row.';
lblValidationMessage.ElementHandle.classList.remove('d-none');
lblValidationMessage.ElementHandle.classList.remove('invisible');
FLastMouseDownRowIndex := FNewEntryRowIndex;
FLastMouseDownTime := TJSDate.now;
ApplyActiveRowState;
Exit;
end;
if (FActiveRowIndex >= 0) and
(targetRowIndex >= 0) and
(targetRowIndex <> FActiveRowIndex) and
(not ValidateRow(FActiveRowIndex)) then
begin
Event.preventDefault;
Event.stopPropagation;
ApplyRowValidation(FActiveRowIndex);
ShowRowValidationMessage(FActiveRowIndex, 'Complete required fields before leaving this row.');
SetTopControlsEnabled(False);
FLastMouseDownRowIndex := FActiveRowIndex;
FLastMouseDownTime := TJSDate.now;
ApplyActiveRowState;
Exit;
end;
FLastMouseDownRowIndex := targetRowIndex;
FLastMouseDownTime := TJSDate.now;
end;
procedure TFTimeEntries.EnableColumnResize;
begin
asm
(function(){
const host = document.getElementById('time_entries_table_host');
if(!host) return;
const table = host.querySelector('table');
if(!table) return;
const ths = table.querySelectorAll('thead th');
const cols = table.querySelectorAll('colgroup col');
ths.forEach((th, index) => {
th.classList.add('th-resize');
if (th.querySelector('.th-resize-handle')) return;
const handle = document.createElement('div');
handle.className = 'th-resize-handle';
th.appendChild(handle);
handle.addEventListener('mousedown', function(e){
e.preventDefault();
e.stopPropagation();
const startX = e.clientX;
const startW = th.getBoundingClientRect().width;
function onMove(ev){
const w = Math.max(20, startW + (ev.clientX - startX));
th.style.width = w + 'px';
th.style.minWidth = '0';
if (cols && cols[index]) {
cols[index].style.width = w + 'px';
}
}
function onUp(){
document.removeEventListener('mousemove', onMove);
document.removeEventListener('mouseup', onUp);
}
document.addEventListener('mousemove', onMove);
document.addEventListener('mouseup', onUp);
});
});
})();
end;
end;
function TFTimeEntries.IsNewEntryRow(AIndex: Integer): Boolean;
begin
Result := FAddingNewEntry and (AIndex = FNewEntryRowIndex);
end;
procedure TFTimeEntries.ResetNewEntryState;
begin
FAddingNewEntry := False;
FNewEntryRowIndex := -1;
end;
function TFTimeEntries.BeginAddEntry: Boolean;
begin
Result := False;
if FUserId = '' then
begin
Utils.ShowErrorModal('Unable to determine logged-in user.');
Exit;
end;
if edtWeekOf.Text = '' then
begin
Utils.ShowErrorModal('Select a week/date before adding an entry.');
Exit;
end;
if FAddingNewEntry then
begin
Utils.ShowErrorModal('Save or cancel the new entry before adding another entry.');
Exit;
end;
if (FActiveRowIndex >= 0) and (not ValidateRow(FActiveRowIndex)) then
begin
ApplyRowValidation(FActiveRowIndex);
ShowRowValidationMessage(FActiveRowIndex, 'Complete required fields before adding another entry.');
SetTopControlsEnabled(False);
Exit;
end;
xdwdsTimeEntries.Append;
xdwdsTimeEntriesentryId.AsInteger := 0;
xdwdsTimeEntriestaskDate.AsString := edtWeekOf.Text;
xdwdsTimeEntriestaskId.AsString := '';
xdwdsTimeEntriestaskDisplay.AsString := '';
xdwdsTimeEntrieshours.Clear;
xdwdsTimeEntriestaskTime.AsString := '';
xdwdsTimeEntriesplace.AsString := '';
xdwdsTimeEntriesplaceDesc.AsString := '';
xdwdsTimeEntriescategory.AsString := '';
xdwdsTimeEntriescategoryDesc.AsString := '';
xdwdsTimeEntriessummary.AsString := '';
xdwdsTimeEntries.Post;
FAddingNewEntry := True;
FNewEntryRowIndex := xdwdsTimeEntries.RecordCount - 1;
FActiveRowIndex := FNewEntryRowIndex;
SetTopControlsEnabled(False);
btnDeleteEntry.Enabled := False;
btnCopyEntry.Enabled := False;
HideRowValidationMessage;
RenderTable;
ScrollToNewEntryRow;
Result := True;
end;
function TFTimeEntries.CopySelectedEntry: Boolean;
var
taskDate: string;
taskId: string;
taskDisplay: string;
hoursValue: Double;
hasHours: Boolean;
taskTime: string;
place: string;
placeDesc: string;
category: string;
categoryDesc: string;
summary: string;
begin
Result := False;
if FAddingNewEntry then
begin
Utils.ShowErrorModal('Save or cancel the new entry before copying another entry.');
Exit;
end;
if FActiveRowIndex < 0 then
begin
Utils.ShowErrorModal('Select a time entry to copy.');
Exit;
end;
if (FActiveRowIndex >= 0) and (not ValidateRow(FActiveRowIndex)) then
begin
ApplyRowValidation(FActiveRowIndex);
ShowRowValidationMessage(FActiveRowIndex, 'Complete required fields before copying this entry.');
SetTopControlsEnabled(False);
Exit;
end;
GotoRowIndex(FActiveRowIndex);
if xdwdsTimeEntries.Eof then
Exit;
taskDate := xdwdsTimeEntriestaskDate.AsString;
taskId := xdwdsTimeEntriestaskId.AsString;
taskDisplay := xdwdsTimeEntriestaskDisplay.AsString;
hasHours := not xdwdsTimeEntrieshours.IsNull;
if hasHours then
hoursValue := xdwdsTimeEntrieshours.AsFloat
else
hoursValue := 0;
taskTime := xdwdsTimeEntriestaskTime.AsString;
place := xdwdsTimeEntriesplace.AsString;
placeDesc := xdwdsTimeEntriesplaceDesc.AsString;
category := xdwdsTimeEntriescategory.AsString;
categoryDesc := xdwdsTimeEntriescategoryDesc.AsString;
summary := xdwdsTimeEntriessummary.AsString;
xdwdsTimeEntries.Append;
xdwdsTimeEntriesentryId.AsInteger := 0;
xdwdsTimeEntriestaskDate.AsString := taskDate;
xdwdsTimeEntriestaskId.AsString := taskId;
xdwdsTimeEntriestaskDisplay.AsString := taskDisplay;
if hasHours then
xdwdsTimeEntrieshours.AsFloat := hoursValue
else
xdwdsTimeEntrieshours.Clear;
xdwdsTimeEntriestaskTime.AsString := taskTime;
xdwdsTimeEntriesplace.AsString := place;
xdwdsTimeEntriesplaceDesc.AsString := placeDesc;
xdwdsTimeEntriescategory.AsString := category;
xdwdsTimeEntriescategoryDesc.AsString := categoryDesc;
xdwdsTimeEntriessummary.AsString := summary;
xdwdsTimeEntries.Post;
FAddingNewEntry := True;
FNewEntryRowIndex := xdwdsTimeEntries.RecordCount - 1;
FActiveRowIndex := FNewEntryRowIndex;
SetTopControlsEnabled(False);
btnDeleteEntry.Enabled := False;
btnCopyEntry.Enabled := False;
HideRowValidationMessage;
RenderTable;
ScrollToNewEntryRow;
Result := True;
end;
procedure TFTimeEntries.btnAddEntryClick(Sender: TObject);
begin
BeginAddEntry;
end;
procedure TFTimeEntries.btnCopyEntryClick(Sender: TObject);
begin
CopySelectedEntry;
end;
procedure TFTimeEntries.btnDeleteEntryClick(Sender: TObject);
begin
if FActiveRowIndex < 0 then
begin
Utils.ShowErrorModal('Select a time entry to delete.');
Exit;
end;
Utils.ShowConfirmationModal(
'Delete the selected time entry?',
'Delete',
'Cancel',
procedure(AConfirmed: Boolean)
begin
if AConfirmed then
DeleteSelectedEntry;
end
);
end;
[async] procedure TFTimeEntries.btnSearchRangeClick(Sender: TObject);
begin
if edtStartDate.Text = '' then
begin
Utils.ShowErrorModal('Select a start date.');
Exit;
end;
if edtEndDate.Text = '' then
begin
Utils.ShowErrorModal('Select an end date.');
Exit;
end;
if IsoToDate(edtEndDate.Text) < IsoToDate(edtStartDate.Text) then
begin
Utils.ShowErrorModal('End date cannot be before start date.');
Exit;
end;
FStartDate := edtStartDate.Text;
FEndDate := edtEndDate.Text;
await(LoadTimeEntries);
end;
procedure TFTimeEntries.CaptureTableScroll;
begin
asm
const vscroll = document.querySelector('.time-vscroll');
const hscroll = document.querySelector('.time-hscroll');
this.FPendingScrollTop = vscroll ? vscroll.scrollTop : 0;
this.FPendingScrollLeft = hscroll ? hscroll.scrollLeft : 0;
end;
end;
procedure TFTimeEntries.RestoreTableScroll;
begin
asm
const vscroll = document.querySelector('.time-vscroll');
const hscroll = document.querySelector('.time-hscroll');
if (vscroll) vscroll.scrollTop = this.FPendingScrollTop || 0;
if (hscroll) hscroll.scrollLeft = this.FPendingScrollLeft || 0;
end;
end;
procedure TFTimeEntries.ScrollToNewEntryRow;
begin
asm
const row = document.querySelector('tr[data-idx="' + this.FNewEntryRowIndex + '"]');
if (!row) return;
row.scrollIntoView({
behavior: 'auto',
block: 'nearest',
inline: 'nearest'
});
const firstEditor =
row.querySelector('[data-field="taskId"]') ||
row.querySelector('[data-field="hours"]') ||
row.querySelector('.time-editor');
if (firstEditor)
firstEditor.focus();
end;
end;
procedure TFTimeEntries.SetTopControlsEnabled(AEnabled: Boolean);
begin
edtWeekOf.Enabled := AEnabled;
edtStartDate.Enabled := AEnabled;
edtEndDate.Enabled := AEnabled;
btnSearchRange.Enabled := AEnabled;
btnAddEntry.Enabled := AEnabled;
end;
[async] procedure TFTimeEntries.TaskPickerButtonClick(Event: TJSEvent);
var
el: TJSHTMLElement;
idx: Integer;
begin
Event.preventDefault;
Event.stopPropagation;
el := TJSHTMLElement(Event.currentTarget);
idx := StrToIntDef(string(el.getAttribute('data-idx')), -1);
if idx < 0 then
Exit;
if FAddingNewEntry and (idx <> FNewEntryRowIndex) then
begin
Event.preventDefault;
Event.stopPropagation;
FActiveRowIndex := FNewEntryRowIndex;
btnDeleteEntry.Enabled := False;
btnCopyEntry.Enabled := False;
SetTopControlsEnabled(False);
FBlockedRowIndex := FNewEntryRowIndex;
lblValidationMessage.Caption := 'Save or cancel the new entry before changing another row.';
lblValidationMessage.ElementHandle.classList.remove('d-none');
lblValidationMessage.ElementHandle.classList.remove('invisible');
ApplyActiveRowState;
Exit;
end;
if (FActiveRowIndex >= 0) and
(idx <> FActiveRowIndex) and
(not ValidateRow(FActiveRowIndex)) then
begin
Event.preventDefault;
Event.stopPropagation;
ApplyRowValidation(FActiveRowIndex);
ShowRowValidationMessage(FActiveRowIndex, 'Complete required fields before changing another row.');
SetTopControlsEnabled(False);
ApplyActiveRowState;
Exit;
end;
FActiveRowIndex := idx;
btnDeleteEntry.Enabled := not IsNewEntryRow(idx);
btnCopyEntry.Enabled := not IsNewEntryRow(idx);
if not Assigned(FTaskPickerOffCanvas) then
FTaskPickerOffCanvas := TTaskPickerOffCanvas.Create(xdwcTimeEntries, @TaskPickerTaskSelected);
await(FTaskPickerOffCanvas.Open(FUserId, idx));
end;
procedure TFTimeEntries.TaskPickerTaskSelected(ARowIndex: Integer; const ATaskId, ATaskDisplay: string);
var
btn: TJSHTMLElement;
triggerId: string;
begin
if not xdwdsTimeEntries.Active then
Exit;
GotoRowIndex(ARowIndex);
if xdwdsTimeEntries.Eof then
Exit;
xdwdsTimeEntries.Edit;
xdwdsTimeEntriestaskId.AsString := ATaskId;
xdwdsTimeEntriestaskDisplay.AsString := ATaskDisplay;
xdwdsTimeEntries.Post;
FActiveRowIndex := ARowIndex;
btnDeleteEntry.Enabled := not IsNewEntryRow(ARowIndex);
btnCopyEntry.Enabled := not IsNewEntryRow(ARowIndex);
CaptureTableScroll;
RenderTable;
triggerId := 'time_dd_taskId_' + IntToStr(ARowIndex);
btn := TJSHTMLElement(document.getElementById(triggerId));
if Assigned(btn) then
btn.focus;
if not IsNewEntryRow(ARowIndex) then
SaveField(ARowIndex, 'taskId');
if IsNewEntryRow(ARowIndex) then
begin
if ValidateRow(ARowIndex) then
ClearRowValidation(ARowIndex);
SetTopControlsEnabled(False);
Exit;
end;
if ValidateRow(ARowIndex) then
begin
ClearRowValidation(ARowIndex);
SetTopControlsEnabled(True);
end
else
SetTopControlsEnabled(False);
end;
procedure TFTimeEntries.ApplyActiveRowState;
begin
asm
const activeRowIndex = this.FActiveRowIndex;
const blockedRowIndex = this.FBlockedRowIndex;
document.querySelectorAll('.time-row-selectable').forEach(function(row) {
const rowIndex = parseInt(row.getAttribute('data-idx') || '-1', 10);
row.classList.remove('table-active');
row.classList.remove('table-danger');
if ((blockedRowIndex >= 0) && (rowIndex === blockedRowIndex))
row.classList.add('table-danger');
else if ((activeRowIndex >= 0) && (rowIndex === activeRowIndex))
row.classList.add('table-active');
});
end;
end;
procedure TFTimeEntries.EditorBlur(Event: TJSEvent);
var
el: TJSHTMLElement;
idx: Integer;
idxStr: string;
fieldName: string;
begin
el := TJSHTMLElement(Event.target);
idxStr := string(el.getAttribute('data-idx'));
fieldName := string(el.getAttribute('data-field'));
if string(el.getAttribute('data-unsaved-data')) <> '1' then
begin
console.log('EditorBlur: skip (not unsaved) idx=' + idxStr + ' field=' + fieldName);
Exit;
end;
el.removeAttribute('data-unsaved-data');
idx := StrToIntDef(idxStr, -1);
if idx < 0 then
Exit;
if IsNewEntryRow(idx) then
begin
console.log('EditorBlur: skip local new row idx=' + IntToStr(idx) + ' field=' + fieldName);
Exit;
end;
console.log('EditorBlur: SAVE idx=' + IntToStr(idx) + ' field=' + fieldName);
SaveField(idx, fieldName);
end;
[async] procedure TFTimeEntries.SaveField(AIndex: Integer; const AFieldName: string);
var
response: TXDataClientResponse;
payload: TJSObject;
fieldValue: string;
begin
if not xdwdsTimeEntries.Active then
Exit;
GotoRowIndex(AIndex);
if xdwdsTimeEntries.Eof then
Exit;
if xdwdsTimeEntriesentryId.AsInteger <= 0 then
Exit;
fieldValue := '';
if SameText(AFieldName, 'taskDate') then
fieldValue := xdwdsTimeEntriestaskDate.AsString
else if SameText(AFieldName, 'taskId') then
fieldValue := xdwdsTimeEntriestaskId.AsString
else if SameText(AFieldName, 'hours') then
begin
if xdwdsTimeEntrieshours.IsNull then
fieldValue := ''
else
fieldValue := xdwdsTimeEntrieshours.AsString;
end
else if SameText(AFieldName, 'taskTime') then
fieldValue := xdwdsTimeEntriestaskTime.AsString
else if SameText(AFieldName, 'place') then
fieldValue := xdwdsTimeEntriesplace.AsString
else if SameText(AFieldName, 'category') then
fieldValue := xdwdsTimeEntriescategory.AsString
else if SameText(AFieldName, 'summary') then
fieldValue := xdwdsTimeEntriessummary.AsString
else
Exit;
payload := TJSObject.new;
payload['entryId'] := xdwdsTimeEntriesentryId.AsInteger;
payload['userId'] := FUserId;
payload['fieldName'] := AFieldName;
payload['value'] := fieldValue;
console.log('SaveField: idx=' + IntToStr(AIndex) + ' field=' + AFieldName + ' value=' + fieldValue);
try
response := await(xdwcTimeEntries.RawInvokeAsync(
'ITimeEntryService.SaveTimeEntryField',
[payload]
));
console.log('SaveField: response=' + string(TJSJSON.stringify(response.Result)));
except
on E: EXDataClientRequestException do
begin
console.log('SaveField ERROR: ' + E.ErrorResult.ErrorMessage);
Utils.ShowErrorModal(E.ErrorResult.ErrorMessage);
end;
end;
end;
[async] procedure TFTimeEntries.DeleteSelectedEntry;
var
entryId: Integer;
begin
if not xdwdsTimeEntries.Active then
Exit;
if FActiveRowIndex < 0 then
begin
Utils.ShowErrorModal('Select a time entry to delete.');
Exit;
end;
GotoRowIndex(FActiveRowIndex);
if xdwdsTimeEntries.Eof then
Exit;
entryId := xdwdsTimeEntriesentryId.AsInteger;
if entryId <= 0 then
begin
Utils.ShowErrorModal('Unable to determine the selected time entry.');
Exit;
end;
Utils.ShowSpinner('spinner');
try
try
await(xdwcTimeEntries.RawInvokeAsync(
'ITimeEntryService.DeleteTimeEntry',
[FUserId, entryId]
));
except
on E: EXDataClientRequestException do
begin
console.log('DeleteSelectedEntry ERROR: ' + E.ErrorResult.ErrorMessage);
Utils.ShowErrorModal(E.ErrorResult.ErrorMessage);
Exit;
end;
end;
FActiveRowIndex := -1;
FPendingEntryId := '';
HideRowValidationMessage;
SetTopControlsEnabled(True);
btnDeleteEntry.Enabled := False;
btnCopyEntry.Enabled := False;
CaptureTableScroll;
await(LoadTimeEntries);
finally
Utils.HideSpinner('spinner');
end;
end;
end.
is-invalid .form-check-input {
.is-invalid .form-check-input {
border: 1px solid #dc3545 !important;
}
......@@ -22,6 +22,7 @@ is-invalid .form-check-input {
transform: translateX(-120%);
opacity: 0;
}
to {
transform: translateX(0);
opacity: 1;
......@@ -39,37 +40,6 @@ is-invalid .form-check-input {
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);
white-space: nowrap;
overflow: hidden;
text-overflow: ellipsis;
}
.tasks-vscroll thead th.th-resize {
z-index: 3;
}
span.card {
border: none;
......@@ -89,155 +59,6 @@ span.card {
user-select: none;
}
.tasks-table {
table-layout: fixed;
}
.tasks-table th {
overflow: hidden;
}
.tasks-table td {
overflow: visible;
}
.nowrap-cell,
.wrap-cell {
overflow: visible;
}
.tasks-table .dropdown,
.task-dd-toggle,
.task-dd-label,
.cell-input,
.cell-textarea {
min-width: 0;
}
.dropdown-menu {
z-index: 1055;
}
.task-dd-toggle.status-cannot-duplicate {
--bs-btn-color: #41464b;
--bs-btn-bg: #e2e3e5;
--bs-btn-border-color: #c4c8cb;
--bs-btn-hover-color: #41464b;
--bs-btn-hover-bg: #d3d4d5;
--bs-btn-hover-border-color: #b9bcc0;
--bs-btn-active-color: #41464b;
--bs-btn-active-bg: #c6c7c8;
--bs-btn-active-border-color: #b9bcc0;
}
.task-dd-toggle.status-cannot-test {
--bs-btn-color: #842029;
--bs-btn-bg: #f8d7da;
--bs-btn-border-color: #f1aeb5;
--bs-btn-hover-color: #842029;
--bs-btn-hover-bg: #f1c2c7;
--bs-btn-hover-border-color: #ea9ca6;
--bs-btn-active-color: #842029;
--bs-btn-active-bg: #eaadb5;
--bs-btn-active-border-color: #e68592;
}
.task-dd-toggle.status-future-enhancement {
--bs-btn-color: #055160;
--bs-btn-bg: #cff4fc;
--bs-btn-border-color: #9eeaf9;
--bs-btn-hover-color: #055160;
--bs-btn-hover-bg: #b6effb;
--bs-btn-hover-border-color: #86e5f8;
--bs-btn-active-color: #055160;
--bs-btn-active-bg: #9eeaf9;
--bs-btn-active-border-color: #74dff6;
}
.task-dd-toggle.status-fixed-verified {
--bs-btn-color: #0f5132;
--bs-btn-bg: #d1e7dd;
--bs-btn-border-color: #a3cfbb;
--bs-btn-hover-color: #0f5132;
--bs-btn-hover-bg: #badbcc;
--bs-btn-hover-border-color: #8fc5a9;
--bs-btn-active-color: #0f5132;
--bs-btn-active-bg: #a3cfbb;
--bs-btn-active-border-color: #7db89d;
}
.task-dd-toggle.status-fixed {
--bs-btn-color: #146c43;
--bs-btn-bg: #d1e7dd;
--bs-btn-border-color: #a3cfbb;
--bs-btn-hover-color: #146c43;
--bs-btn-hover-bg: #badbcc;
--bs-btn-hover-border-color: #8fc5a9;
--bs-btn-active-color: #146c43;
--bs-btn-active-bg: #a3cfbb;
--bs-btn-active-border-color: #7db89d;
}
.task-dd-toggle.status-investigating {
--bs-btn-color: #664d03;
--bs-btn-bg: #fff3cd;
--bs-btn-border-color: #ffe69c;
--bs-btn-hover-color: #664d03;
--bs-btn-hover-bg: #ffecb5;
--bs-btn-hover-border-color: #ffdf7e;
--bs-btn-active-color: #664d03;
--bs-btn-active-bg: #ffe69c;
--bs-btn-active-border-color: #ffd966;
}
.task-dd-toggle.status-not-fixed {
--bs-btn-color: #842029;
--bs-btn-bg: #f8d7da;
--bs-btn-border-color: #f1aeb5;
--bs-btn-hover-color: #842029;
--bs-btn-hover-bg: #f1c2c7;
--bs-btn-hover-border-color: #ea9ca6;
--bs-btn-active-color: #842029;
--bs-btn-active-bg: #eaadb5;
--bs-btn-active-border-color: #e68592;
}
.task-dd-toggle.status-non-issue {
--bs-btn-color: #432874;
--bs-btn-bg: #e2d9f3;
--bs-btn-border-color: #cbbbe8;
--bs-btn-hover-color: #432874;
--bs-btn-hover-bg: #d6caee;
--bs-btn-hover-border-color: #bea9e2;
--bs-btn-active-color: #432874;
--bs-btn-active-bg: #cbbbe8;
--bs-btn-active-border-color: #b89ddd;
}
.task-dd-toggle.status-possibly-a-problem {
--bs-btn-color: #7a3e00;
--bs-btn-bg: #ffe5d0;
--bs-btn-border-color: #f7c79d;
--bs-btn-hover-color: #7a3e00;
--bs-btn-hover-bg: #ffd7b8;
--bs-btn-hover-border-color: #f2ba88;
--bs-btn-active-color: #7a3e00;
--bs-btn-active-bg: #f7c79d;
--bs-btn-active-border-color: #eeaf69;
}
.task-dd-toggle.status-default {
--bs-btn-color: #212529;
--bs-btn-bg: #f8f9fa;
--bs-btn-border-color: #dee2e6;
--bs-btn-hover-color: #212529;
--bs-btn-hover-bg: #e9ecef;
--bs-btn-hover-border-color: #ced4da;
--bs-btn-active-color: #212529;
--bs-btn-active-bg: #dee2e6;
--bs-btn-active-border-color: #ced4da;
}
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);
white-space: nowrap;
overflow: hidden;
text-overflow: ellipsis;
}
.tasks-vscroll thead th.th-resize {
z-index: 3;
}
span.card {
border: none;
}
.th-resize {
position: relative;
}
.th-resize-handle {
position: absolute;
top: 0;
right: 0;
width: 8px;
height: 100%;
cursor: col-resize;
user-select: none;
}
.tasks-table {
table-layout: fixed;
}
.tasks-table th {
overflow: hidden;
}
.tasks-table td {
overflow: visible;
}
.nowrap-cell,
.wrap-cell {
overflow: visible;
}
.tasks-table .dropdown,
.task-dd-toggle,
.task-dd-label,
.cell-input,
.cell-textarea {
min-width: 0;
}
.dropdown-menu {
z-index: 1055;
}
.task-toolbar {
border: 1px solid var(--bs-border-color);
border-radius: 0.375rem;
background: var(--bs-body-bg);
white-space: nowrap;
}
.task-toolbar-btn {
min-width: 2rem;
padding: 0.25rem 0.5rem;
}
#lbl_total_rows {
white-space: nowrap;
}
.task-rich-editor {
white-space: pre-wrap;
overflow-wrap: anywhere;
height: auto;
}
.task-rich-editor:focus {
outline: 0;
}
.task-color-btn {
position: relative;
min-width: 2rem;
height: 2rem;
padding: 0.2rem 0.45rem;
}
.task-hidden-color-input {
position: absolute;
inset: 0;
opacity: 0;
pointer-events: none;
width: 1px;
height: 1px;
border: 0;
}
.task-color-glyph {
display: inline-block;
font-weight: 600;
line-height: 1;
}
.task-color-swatch {
position: absolute;
left: 0.35rem;
right: 0.35rem;
bottom: 0.2rem;
height: 0.18rem;
border-radius: 999px;
background: #000000;
}
.time-vscroll {
height: 100%;
overflow: auto;
}
.time-vscroll thead th {
position: sticky;
top: 0;
z-index: 2;
background: var(--bs-body-bg);
}
.time-vscroll thead th.th-resize {
z-index: 3;
}
.time-table {
table-layout: fixed;
}
.time-table th,
.time-table td {
overflow: hidden;
}
.time-table .dropdown,
.time-dd-toggle,
.time-dd-label,
.cell-input,
.cell-textarea {
min-width: 0;
}
.task-dd-toggle.status-cannot-duplicate {
--bs-btn-color: #41464b;
--bs-btn-bg: #e2e3e5;
--bs-btn-border-color: #c4c8cb;
--bs-btn-hover-color: #41464b;
--bs-btn-hover-bg: #d3d4d5;
--bs-btn-hover-border-color: #b9bcc0;
--bs-btn-active-color: #41464b;
--bs-btn-active-bg: #c6c7c8;
--bs-btn-active-border-color: #b9bcc0;
}
.task-dd-toggle.status-cannot-test {
--bs-btn-color: #842029;
--bs-btn-bg: #f8d7da;
--bs-btn-border-color: #f1aeb5;
--bs-btn-hover-color: #842029;
--bs-btn-hover-bg: #f1c2c7;
--bs-btn-hover-border-color: #ea9ca6;
--bs-btn-active-color: #842029;
--bs-btn-active-bg: #eaadb5;
--bs-btn-active-border-color: #e68592;
}
.task-dd-toggle.status-future-enhancement {
--bs-btn-color: #055160;
--bs-btn-bg: #cff4fc;
--bs-btn-border-color: #9eeaf9;
--bs-btn-hover-color: #055160;
--bs-btn-hover-bg: #b6effb;
--bs-btn-hover-border-color: #86e5f8;
--bs-btn-active-color: #055160;
--bs-btn-active-bg: #9eeaf9;
--bs-btn-active-border-color: #74dff6;
}
.task-dd-toggle.status-fixed-verified {
--bs-btn-color: #0f5132;
--bs-btn-bg: #d1e7dd;
--bs-btn-border-color: #a3cfbb;
--bs-btn-hover-color: #0f5132;
--bs-btn-hover-bg: #badbcc;
--bs-btn-hover-border-color: #8fc5a9;
--bs-btn-active-color: #0f5132;
--bs-btn-active-bg: #a3cfbb;
--bs-btn-active-border-color: #7db89d;
}
.task-dd-toggle.status-fixed {
--bs-btn-color: #146c43;
--bs-btn-bg: #d1e7dd;
--bs-btn-border-color: #a3cfbb;
--bs-btn-hover-color: #146c43;
--bs-btn-hover-bg: #badbcc;
--bs-btn-hover-border-color: #8fc5a9;
--bs-btn-active-color: #146c43;
--bs-btn-active-bg: #a3cfbb;
--bs-btn-active-border-color: #7db89d;
}
.task-dd-toggle.status-investigating {
--bs-btn-color: #664d03;
--bs-btn-bg: #fff3cd;
--bs-btn-border-color: #ffe69c;
--bs-btn-hover-color: #664d03;
--bs-btn-hover-bg: #ffecb5;
--bs-btn-hover-border-color: #ffdf7e;
--bs-btn-active-color: #664d03;
--bs-btn-active-bg: #ffe69c;
--bs-btn-active-border-color: #ffd966;
}
.task-dd-toggle.status-not-fixed {
--bs-btn-color: #842029;
--bs-btn-bg: #f8d7da;
--bs-btn-border-color: #f1aeb5;
--bs-btn-hover-color: #842029;
--bs-btn-hover-bg: #f1c2c7;
--bs-btn-hover-border-color: #ea9ca6;
--bs-btn-active-color: #842029;
--bs-btn-active-bg: #eaadb5;
--bs-btn-active-border-color: #e68592;
}
.task-dd-toggle.status-non-issue {
--bs-btn-color: #432874;
--bs-btn-bg: #e2d9f3;
--bs-btn-border-color: #cbbbe8;
--bs-btn-hover-color: #432874;
--bs-btn-hover-bg: #d6caee;
--bs-btn-hover-border-color: #bea9e2;
--bs-btn-active-color: #432874;
--bs-btn-active-bg: #cbbbe8;
--bs-btn-active-border-color: #b89ddd;
}
.task-dd-toggle.status-possibly-a-problem {
--bs-btn-color: #7a3e00;
--bs-btn-bg: #ffe5d0;
--bs-btn-border-color: #f7c79d;
--bs-btn-hover-color: #7a3e00;
--bs-btn-hover-bg: #ffd7b8;
--bs-btn-hover-border-color: #f2ba88;
--bs-btn-active-color: #7a3e00;
--bs-btn-active-bg: #f7c79d;
--bs-btn-active-border-color: #eeaf69;
}
.task-dd-toggle.status-default {
--bs-btn-color: #212529;
--bs-btn-bg: #f8f9fa;
--bs-btn-border-color: #dee2e6;
--bs-btn-hover-color: #212529;
--bs-btn-hover-bg: #e9ecef;
--bs-btn-hover-border-color: #ced4da;
--bs-btn-active-color: #212529;
--bs-btn-active-bg: #dee2e6;
--bs-btn-active-border-color: #ced4da;
}
.time-vscroll {
height: 100%;
overflow: auto;
}
.time-vscroll thead th {
position: sticky;
top: 0;
z-index: 2;
background: var(--bs-body-bg);
white-space: nowrap;
overflow: hidden;
text-overflow: ellipsis;
}
.time-vscroll thead th.th-resize {
z-index: 3;
}
.time-table {
table-layout: fixed;
}
.time-table th {
overflow: hidden;
}
.time-table td {
overflow: visible;
}
.time-table .nowrap-cell,
.time-table .wrap-cell {
overflow: visible;
}
.time-table .dropdown,
.time-dd-toggle,
.time-dd-label,
.cell-input,
.cell-textarea {
min-width: 0;
}
.time-table .dropdown-menu {
z-index: 1055;
}
.time-dd-toggle.is-invalid {
border-color: var(--bs-danger) !important;
padding-right: calc(1.5em + .75rem);
}
\ No newline at end of file
......@@ -2,6 +2,7 @@ program emT3Web;
uses
System.Classes,
System.SysUtils,
Vcl.Forms,
XData.Web.Connection,
WEBLib.Dialogs,
......@@ -13,10 +14,15 @@ uses
Utils in 'Utils.pas',
View.TaskItems in 'View.TaskItems.pas' {FTaskItems: TWebForm} {*.html},
uNameOffCanvas in 'uNameOffCanvas.pas',
uDropdownHelpers in 'uDropdownHelpers.pas';
uDropdownHelpers in 'uDropdownHelpers.pas',
View.Login in 'View.Login.pas' {FViewLogin: TWebForm} {*.html},
View.ErrorPage in 'View.ErrorPage.pas' {FViewErrorPage: TWebForm} {*.html},
View.TimeEntries in 'View.TimeEntries.pas' {FTimeEntries: TWebForm} {*.html},
uTaskPickerOffCanvas in 'uTaskPickerOffCanvas.pas';
{$R *.res}
procedure DisplayLoginView(AUserId: string = ''; ATaskId: string = ''; AMessage: string = ''); forward;
procedure DoLogout(AMsg: string = ''); forward;
procedure DisplayMainView;
......@@ -42,48 +48,108 @@ procedure Login(userId: string; taskId: string; urlCode: string);
procedure LoginError(AMsg: string);
begin
if (Pos('401:', AMsg) = 1) or
(Pos('Invalid url parameters', AMsg) > 0) or
(Pos('Expired link', AMsg) > 0) then
DisplayLoginView(userId, taskId)
else
ShowAppDialog('' + AMsg);
end;
begin
AuthService.Login( userId, taskId, urlCode,
AuthService.Login(userId, taskId, urlCode,
@LoginSuccess,
@LoginError
);
end;
procedure DisplayLoginView(AUserId: string; ATaskId: string; AMessage: string);
begin
AuthService.Logout;
DMConnection.ApiConnection.Connected := False;
if Assigned(FViewMain) then
FViewMain.Free;
TFViewLogin.Display(@DisplayMainView, AUserId, ATaskId, AMessage);
end;
procedure DoLogin();
var
userIdParam: string;
taskIdParam: string;
codeParam: string;
timeEntriesParam: string;
isTimeEntriesMode: Boolean;
begin
timeEntriesParam := Application.Parameters.Values['time_entries'];
isTimeEntriesMode :=
SameText(timeEntriesParam, 'true') or
(Application.Parameters.Values['task_id'] = '');
if isTimeEntriesMode then
begin
if AuthService.Authenticated and not AuthService.TokenExpired then
begin
DisplayMainView;
Exit;
end;
DisplayLoginView('', '', '');
Exit;
end;
userIdParam := Application.Parameters.Values['user_id'];
taskIdParam := Application.Parameters.Values['task_id'];
codeParam := Application.Parameters.Values['url_code'];
if (userIdParam = '') or (taskIdParam = '') or (codeParam = '') then
begin
DisplayLoginView(userIdParam, taskIdParam);
end
else
begin
AuthService.Logout;
DMConnection.ApiConnection.Connected := False;
if Assigned(FViewMain) then
FViewMain.Free;
Login( userIdParam, taskIdParam, codeParam );
DMConnection.currentTaskId := taskIdParam;
Login(userIdParam, taskIdParam, codeParam);
end;
end;
procedure DoLogout(AMsg: string);
var
userIdParam: string;
taskIdParam: string;
timeEntriesParam: string;
isTimeEntriesMode: Boolean;
begin
AuthService.Logout;
ShowAppDialog('Logout successful ' + AMsg);
end;
timeEntriesParam := Application.Parameters.Values['time_entries'];
isTimeEntriesMode :=
SameText(timeEntriesParam, 'true') or
(Application.Parameters.Values['task_id'] = '');
if isTimeEntriesMode then
begin
DisplayLoginView('', '', AMsg);
Exit;
end;
userIdParam := Application.Parameters.Values['user_id'];
taskIdParam := Application.Parameters.Values['task_id'];
DisplayLoginView(userIdParam, taskIdParam, AMsg);
end;
procedure UnauthorizedAccessProc(AMessage: string);
begin
ShowAppDialog('UnauthorizedAccessProc: ' + AMessage);
end;
procedure StartApplication;
var
ClientVer: string;
......
......@@ -94,15 +94,15 @@
<DCC_RemoteDebug>false</DCC_RemoteDebug>
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
<VerInfo_Locale>1033</VerInfo_Locale>
<VerInfo_Keys>CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=0.8.8.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=0.9.8.0;Comments=;LastCompiledTime=2018/08/27 15:18:29</VerInfo_Keys>
<VerInfo_Keys>CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=0.9.3.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=0.9.8.0;Comments=;LastCompiledTime=2018/08/27 15:18:29</VerInfo_Keys>
<AppDPIAwarenessMode>PerMonitor</AppDPIAwarenessMode>
<VerInfo_MajorVer>0</VerInfo_MajorVer>
<VerInfo_MinorVer>8</VerInfo_MinorVer>
<VerInfo_Release>8</VerInfo_Release>
<TMSWebBrowser>5</TMSWebBrowser>
<VerInfo_MinorVer>9</VerInfo_MinorVer>
<TMSWebBrowser>1</TMSWebBrowser>
<TMSUseJSDebugger>2</TMSUseJSDebugger>
<TMSWebSingleInstance>1</TMSWebSingleInstance>
<VerInfo_Release>3</VerInfo_Release>
<TMSWebOutputPath>..\emT3XDataServer\bin\static</TMSWebOutputPath>
<TMSWebSingleInstance>1</TMSWebSingleInstance>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2)'!=''">
<DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols>
......@@ -139,15 +139,29 @@
<DCCReference Include="Utils.pas"/>
<DCCReference Include="View.TaskItems.pas">
<Form>FTaskItems</Form>
<FormType>dfm</FormType>
<DesignClass>TWebForm</DesignClass>
</DCCReference>
<DCCReference Include="uNameOffCanvas.pas"/>
<DCCReference Include="uDropdownHelpers.pas"/>
<DCCReference Include="View.Login.pas">
<Form>FViewLogin</Form>
<DesignClass>TWebForm</DesignClass>
</DCCReference>
<DCCReference Include="View.ErrorPage.pas">
<Form>FViewErrorPage</Form>
<DesignClass>TWebForm</DesignClass>
</DCCReference>
<DCCReference Include="View.TimeEntries.pas">
<Form>FTimeEntries</Form>
<DesignClass>TWebForm</DesignClass>
</DCCReference>
<DCCReference Include="uTaskPickerOffCanvas.pas"/>
<None Include="index.html"/>
<None Include="css\app.css"/>
<None Include="config\config.json"/>
<None Include="css\spinner.css"/>
<None Include="css\task-items.css"/>
<None Include="css\time-entries.css"/>
<BuildConfiguration Include="Base">
<Key>Base</Key>
</BuildConfiguration>
......@@ -228,6 +242,18 @@
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="css\task-items.css" Configuration="Debug" Class="ProjectFile">
<Platform Name="Win32">
<RemoteDir>.\</RemoteDir>
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="css\time-entries.css" Configuration="Debug" Class="ProjectFile">
<Platform Name="Win32">
<RemoteDir>.\</RemoteDir>
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="index.html" Configuration="Debug" Class="ProjectFile"/>
<DeployFile LocalName="index.html" Configuration="Debug" Class="ProjectFile">
<Platform Name="Win32">
......
......@@ -10,6 +10,8 @@
<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/task-items.css" rel="stylesheet"/>
<link href="css/time-entries.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>
......@@ -17,7 +19,7 @@
<script src="https://cdn.jsdelivr.net/npm/bootstrap@5.3.8/dist/js/bootstrap.bundle.min.js"></script>
<script src="$(ProjectName).js"></script>
</head>
<link href="css/task-items.css" rel="stylesheet"/><link href="css/time-entries.css" rel="stylesheet"/></head>
<body>
<noscript>Your browser does not support JavaScript!</noscript>
<script>rtl.run();</script>
......@@ -27,3 +29,5 @@
unit uTaskPickerOffCanvas;
interface
uses
System.SysUtils, JS, Web, XData.Web.Client;
type
TTaskPickedProc = reference to procedure(ARowIndex: Integer; const ATaskId, ATaskDisplay: string);
TTaskPickerOffCanvas = class
private
FClient: TXDataWebClient;
FUserId: string;
FRowIndex: Integer;
FOnTaskPicked: TTaskPickedProc;
FCustomers: TJSArray;
FProjects: TJSArray;
FTasks: TJSArray;
procedure BindEvents;
procedure ClearSelect(const AElementId: string; ADisabled: Boolean);
procedure FillSelect(const AElementId: string; AItems: TJSArray);
function SelectedValue(const AElementId: string): string;
function FindDisplay(AItems: TJSArray; const AValue: string): string;
procedure SetStatus(const AMessage: string);
procedure ClearStatus;
procedure SetSaveEnabled(AEnabled: Boolean);
procedure Show;
procedure Hide;
[async] procedure LoadCustomers;
[async] procedure LoadProjects(const ACustomerId: string);
[async] procedure LoadTasks(const AProjectId: string);
[async] procedure CustomerChanged(Event: TJSEvent);
[async] procedure ProjectChanged(Event: TJSEvent);
procedure TaskChanged(Event: TJSEvent);
procedure SaveClicked(Event: TJSEvent);
public
constructor Create(AClient: TXDataWebClient; AOnTaskPicked: TTaskPickedProc);
[async] procedure Open(const AUserId: string; ARowIndex: Integer);
end;
implementation
constructor TTaskPickerOffCanvas.Create(AClient: TXDataWebClient; AOnTaskPicked: TTaskPickedProc);
begin
inherited Create;
FClient := AClient;
FOnTaskPicked := AOnTaskPicked;
FCustomers := TJSArray.new;
FProjects := TJSArray.new;
FTasks := TJSArray.new;
FRowIndex := -1;
BindEvents;
end;
procedure TTaskPickerOffCanvas.BindEvents;
var
el: TJSHTMLElement;
begin
el := TJSHTMLElement(document.getElementById('task_picker_customer'));
if Assigned(el) then
el.addEventListener('change', TJSEventHandler(@CustomerChanged));
el := TJSHTMLElement(document.getElementById('task_picker_project'));
if Assigned(el) then
el.addEventListener('change', TJSEventHandler(@ProjectChanged));
el := TJSHTMLElement(document.getElementById('task_picker_task'));
if Assigned(el) then
el.addEventListener('change', TJSEventHandler(@TaskChanged));
el := TJSHTMLElement(document.getElementById('btn_task_picker_save'));
if Assigned(el) then
el.addEventListener('click', TJSEventHandler(@SaveClicked));
end;
procedure TTaskPickerOffCanvas.ClearSelect(const AElementId: string; ADisabled: Boolean);
var
selectEl: TJSHTMLSelectElement;
begin
selectEl := TJSHTMLSelectElement(document.getElementById(AElementId));
if not Assigned(selectEl) then
Exit;
selectEl.innerHTML := '<option value=""></option>';
selectEl.disabled := ADisabled;
end;
procedure TTaskPickerOffCanvas.FillSelect(const AElementId: string; AItems: TJSArray);
var
selectEl: TJSHTMLSelectElement;
optionEl: TJSHTMLOptionElement;
itemObj: TJSObject;
i: Integer;
begin
selectEl := TJSHTMLSelectElement(document.getElementById(AElementId));
if not Assigned(selectEl) then
Exit;
selectEl.innerHTML := '<option value=""></option>';
for i := 0 to AItems.length - 1 do
begin
itemObj := TJSObject(AItems[i]);
optionEl := TJSHTMLOptionElement(document.createElement('option'));
optionEl.value := string(itemObj['value']);
optionEl.text := string(itemObj['display']);
selectEl.appendChild(optionEl);
end;
selectEl.disabled := False;
end;
function TTaskPickerOffCanvas.SelectedValue(const AElementId: string): string;
var
selectEl: TJSHTMLSelectElement;
begin
Result := '';
selectEl := TJSHTMLSelectElement(document.getElementById(AElementId));
if Assigned(selectEl) then
Result := string(selectEl.value);
end;
function TTaskPickerOffCanvas.FindDisplay(AItems: TJSArray; const AValue: string): string;
var
itemObj: TJSObject;
i: Integer;
begin
Result := '';
for i := 0 to AItems.length - 1 do
begin
itemObj := TJSObject(AItems[i]);
if string(itemObj['value']) = AValue then
Exit(string(itemObj['display']));
end;
end;
procedure TTaskPickerOffCanvas.SetStatus(const AMessage: string);
var
el: TJSHTMLElement;
begin
el := TJSHTMLElement(document.getElementById('task_picker_status'));
if not Assigned(el) then
Exit;
el.innerText := AMessage;
el.classList.remove('d-none');
end;
procedure TTaskPickerOffCanvas.ClearStatus;
var
el: TJSHTMLElement;
begin
el := TJSHTMLElement(document.getElementById('task_picker_status'));
if not Assigned(el) then
Exit;
el.innerText := '';
el.classList.add('d-none');
end;
procedure TTaskPickerOffCanvas.SetSaveEnabled(AEnabled: Boolean);
var
btn: TJSHTMLButtonElement;
begin
btn := TJSHTMLButtonElement(document.getElementById('btn_task_picker_save'));
if Assigned(btn) then
btn.disabled := not AEnabled;
end;
procedure TTaskPickerOffCanvas.Show;
begin
asm
const el = document.getElementById('task_picker_offcanvas');
if (!el || !window.bootstrap) return;
const oc = bootstrap.Offcanvas.getOrCreateInstance(el);
oc.show();
end;
end;
procedure TTaskPickerOffCanvas.Hide;
begin
asm
const el = document.getElementById('task_picker_offcanvas');
if (!el || !window.bootstrap) return;
const oc = bootstrap.Offcanvas.getOrCreateInstance(el);
oc.hide();
end;
end;
[async] procedure TTaskPickerOffCanvas.LoadCustomers;
var
response: TXDataClientResponse;
resultObj: TJSObject;
begin
response := await(FClient.RawInvokeAsync(
'ITimeEntryService.GetTaskPickerCustomers',
[FUserId]
));
resultObj := TJSObject(response.Result);
FCustomers := TJSArray(resultObj['options']);
FillSelect('task_picker_customer', FCustomers);
end;
[async] procedure TTaskPickerOffCanvas.LoadProjects(const ACustomerId: string);
var
response: TXDataClientResponse;
resultObj: TJSObject;
begin
response := await(FClient.RawInvokeAsync(
'ITimeEntryService.GetTaskPickerProjects',
[FUserId, ACustomerId]
));
resultObj := TJSObject(response.Result);
FProjects := TJSArray(resultObj['options']);
FillSelect('task_picker_project', FProjects);
end;
[async] procedure TTaskPickerOffCanvas.LoadTasks(const AProjectId: string);
var
response: TXDataClientResponse;
resultObj: TJSObject;
begin
response := await(FClient.RawInvokeAsync(
'ITimeEntryService.GetTaskPickerTasks',
[FUserId, AProjectId]
));
resultObj := TJSObject(response.Result);
FTasks := TJSArray(resultObj['options']);
FillSelect('task_picker_task', FTasks);
end;
[async] procedure TTaskPickerOffCanvas.CustomerChanged(Event: TJSEvent);
var
customerId: string;
begin
ClearStatus;
SetSaveEnabled(False);
ClearSelect('task_picker_project', True);
ClearSelect('task_picker_task', True);
customerId := SelectedValue('task_picker_customer');
if customerId = '' then
Exit;
try
await(LoadProjects(customerId));
except
on E: Exception do
SetStatus('Unable to load projects.');
end;
end;
[async] procedure TTaskPickerOffCanvas.ProjectChanged(Event: TJSEvent);
var
projectId: string;
begin
ClearStatus;
SetSaveEnabled(False);
ClearSelect('task_picker_task', True);
projectId := SelectedValue('task_picker_project');
if projectId = '' then
Exit;
try
await(LoadTasks(projectId));
except
on E: Exception do
SetStatus('Unable to load tasks.');
end;
end;
procedure TTaskPickerOffCanvas.TaskChanged(Event: TJSEvent);
begin
ClearStatus;
SetSaveEnabled(SelectedValue('task_picker_task') <> '');
end;
procedure TTaskPickerOffCanvas.SaveClicked(Event: TJSEvent);
var
taskId: string;
taskDisplay: string;
begin
Event.preventDefault;
taskId := SelectedValue('task_picker_task');
if taskId = '' then
begin
SetStatus('Select a task.');
Exit;
end;
taskDisplay := FindDisplay(FTasks, taskId);
if Assigned(FOnTaskPicked) then
FOnTaskPicked(FRowIndex, taskId, taskDisplay);
Hide;
end;
[async] procedure TTaskPickerOffCanvas.Open(const AUserId: string; ARowIndex: Integer);
begin
FUserId := AUserId;
FRowIndex := ARowIndex;
ClearStatus;
SetSaveEnabled(False);
ClearSelect('task_picker_customer', True);
ClearSelect('task_picker_project', True);
ClearSelect('task_picker_task', True);
Show;
try
await(LoadCustomers);
except
on E: Exception do
SetStatus('Unable to load customers.');
end;
end;
end.
object ApiDatabase: TApiDatabase
OnCreate = DataModuleCreate
Height = 475
Width = 996
Height = 632
Width = 994
object ucETaskApi: TUniConnection
AutoCommit = False
ProviderName = 'MySQL'
Database = 'eTask'
Username = 'root'
Server = '192.168.102.133'
LoginPrompt = False
Left = 267
Top = 395
Left = 435
Top = 359
EncryptedPassword = '9AFF92FF8CFF86FF8CFFCFFFCEFF'
end
object MySQLUniProvider1: TMySQLUniProvider
Left = 416
Top = 398
Left = 546
Top = 356
end
object uqUsers: TUniQuery
Connection = ucETaskApi
......@@ -142,7 +144,7 @@ object ApiDatabase: TApiDatabase
'from task_items'
'where TASK_ID = :TASK_ID'
'order by ITEM_NUM')
Left = 56
Left = 58
Top = 26
ParamData = <
item
......@@ -282,7 +284,7 @@ object ApiDatabase: TApiDatabase
'left join project p'
' on p.PROJECT_ID = t.PROJECT_ID'
'where t.TASK_ID = :TASK_ID')
Left = 54
Left = 60
Top = 82
ParamData = <
item
......@@ -367,7 +369,7 @@ object ApiDatabase: TApiDatabase
'from task_items'
'where TASK_ITEM_ID = :TASK_ITEM_ID'
' and TASK_ID = :TASK_ID')
Left = 240
Left = 236
Top = 16
ParamData = <
item
......@@ -1085,4 +1087,277 @@ object ApiDatabase: TApiDatabase
Value = nil
end>
end
object uqAddTimeEntry: TUniQuery
Connection = ucETaskApi
SQL.Strings = (
'insert into time_items ('
' ENTRY_ID,'
' USER_ID,'
' TASK_DATE,'
' HOURS,'
' TASK_TIME,'
' CATEGORY,'
' SUMMARY,'
' CREATE_DATE,'
' CREATED_BY,'
' MODIFY_DATE,'
' MODIFIED_BY'
') values ('
' :ENTRY_ID,'
' :USER_ID,'
' :TASK_DATE,'
' null,'
' null,'
' null,'
' null,'
' now(),'
' :CREATED_BY,'
' now(),'
' :MODIFIED_BY'
')')
Left = 436
Top = 426
ParamData = <
item
DataType = ftUnknown
Name = 'ENTRY_ID'
Value = nil
end
item
DataType = ftUnknown
Name = 'USER_ID'
Value = nil
end
item
DataType = ftUnknown
Name = 'TASK_DATE'
Value = nil
end
item
DataType = ftUnknown
Name = 'CREATED_BY'
Value = nil
end
item
DataType = ftUnknown
Name = 'MODIFIED_BY'
Value = nil
end>
end
object uqSaveTimeEntry: TUniQuery
Connection = ucETaskApi
SQL.Strings = (
'UPDATE time_items'
'SET'
' TASK_DATE = :TASK_DATE,'
' TASK_ID = :TASK_ID,'
' PROJECT_ID = ('
' SELECT t.PROJECT_ID'
' FROM tasks t'
' WHERE t.TASK_ID = :TASK_ID'
' ),'
' HOURS = :HOURS,'
' TASK_TIME = :TASK_TIME,'
' PLACE = :PLACE,'
' CATEGORY = :CATEGORY,'
' SUMMARY = :SUMMARY,'
' MODIFY_DATE = now(),'
' MODIFIED_BY = :MODIFIED_BY'
'WHERE ENTRY_ID = :ENTRY_ID'
' AND USER_ID = :USER_ID')
Left = 544
Top = 424
ParamData = <
item
DataType = ftUnknown
Name = 'TASK_DATE'
Value = nil
end
item
DataType = ftUnknown
Name = 'TASK_ID'
Value = nil
end
item
DataType = ftUnknown
Name = 'HOURS'
Value = nil
end
item
DataType = ftUnknown
Name = 'TASK_TIME'
Value = nil
end
item
DataType = ftUnknown
Name = 'PLACE'
Value = nil
end
item
DataType = ftUnknown
Name = 'CATEGORY'
Value = nil
end
item
DataType = ftUnknown
Name = 'SUMMARY'
Value = nil
end
item
DataType = ftUnknown
Name = 'MODIFIED_BY'
Value = nil
end
item
DataType = ftUnknown
Name = 'ENTRY_ID'
Value = nil
end
item
DataType = ftUnknown
Name = 'USER_ID'
Value = nil
end>
end
object uqTaskPickerCustomers: TUniQuery
Connection = ucETaskApi
SQL.Strings = (
'select distinct'
' c.CUSTOMER_ID,'
' c.SHORT_NAME as CUSTOMER_SHORT_NAME'
'from user_project up'
'join project p on p.PROJECT_ID = up.PROJECT_ID'
'join customers c on c.CUSTOMER_ID = p.CUSTOMER_ID'
'where up.USER_ID = :USER_ID'
'order by c.SHORT_NAME')
Left = 402
Top = 494
ParamData = <
item
DataType = ftUnknown
Name = 'USER_ID'
Value = nil
end>
object uqTaskPickerCustomersCUSTOMER_ID: TStringField
FieldName = 'CUSTOMER_ID'
Size = 7
end
object uqTaskPickerCustomersCUSTOMER_SHORT_NAME: TStringField
FieldName = 'CUSTOMER_SHORT_NAME'
Size = 10
end
end
object uqTaskPickerProjects: TUniQuery
Connection = ucETaskApi
SQL.Strings = (
'select distinct'
' p.PROJECT_ID,'
' p.NAME as PROJECT_NAME'
'from user_project up'
'join project p on p.PROJECT_ID = up.PROJECT_ID'
'where up.USER_ID = :USER_ID'
' and p.CUSTOMER_ID = :CUSTOMER_ID'
'order by p.NAME')
Left = 544
Top = 494
ParamData = <
item
DataType = ftUnknown
Name = 'USER_ID'
Value = nil
end
item
DataType = ftUnknown
Name = 'CUSTOMER_ID'
Value = nil
end>
object uqTaskPickerProjectsPROJECT_ID: TStringField
FieldName = 'PROJECT_ID'
Required = True
Size = 7
end
object uqTaskPickerProjectsPROJECT_NAME: TStringField
FieldName = 'PROJECT_NAME'
Size = 30
end
end
object uqTaskPickerTasks: TUniQuery
Connection = ucETaskApi
SQL.Strings = (
'select distinct'
' t.TASK_ID,'
' c.SHORT_NAME as CUSTOMER_SHORT_NAME,'
' p.NAME as PROJECT_NAME,'
' t.TASK_NUM_1,'
' t.TASK_NUM_2,'
' t.TASK_NUM_3,'
' t.TASK_NUM_4,'
' t.TASK_NUM_5,'
' t.TASK_NUM_6,'
' t.SUBJECT as TASK_SUBJECT'
'from tasks t'
'join project p on p.PROJECT_ID = t.PROJECT_ID'
'join customers c on c.CUSTOMER_ID = p.CUSTOMER_ID'
'join user_project up on up.PROJECT_ID = p.PROJECT_ID'
'where up.USER_ID = :USER_ID'
' and t.PROJECT_ID = :PROJECT_ID'
'order by'
' t.TASK_NUM_1,'
' t.TASK_NUM_2,'
' t.TASK_NUM_3,'
' t.TASK_NUM_4,'
' t.TASK_NUM_5,'
' t.TASK_NUM_6,'
' t.SUBJECT')
Left = 676
Top = 502
ParamData = <
item
DataType = ftUnknown
Name = 'USER_ID'
Value = nil
end
item
DataType = ftUnknown
Name = 'PROJECT_ID'
Value = nil
end>
object uqTaskPickerTasksTASK_ID: TStringField
FieldName = 'TASK_ID'
Required = True
Size = 7
end
object uqTaskPickerTasksCUSTOMER_SHORT_NAME: TStringField
FieldName = 'CUSTOMER_SHORT_NAME'
ReadOnly = True
Size = 10
end
object uqTaskPickerTasksPROJECT_NAME: TStringField
FieldName = 'PROJECT_NAME'
ReadOnly = True
Size = 30
end
object uqTaskPickerTasksTASK_NUM_1: TIntegerField
FieldName = 'TASK_NUM_1'
end
object uqTaskPickerTasksTASK_NUM_2: TIntegerField
FieldName = 'TASK_NUM_2'
end
object uqTaskPickerTasksTASK_NUM_3: TIntegerField
FieldName = 'TASK_NUM_3'
end
object uqTaskPickerTasksTASK_NUM_4: TIntegerField
FieldName = 'TASK_NUM_4'
end
object uqTaskPickerTasksTASK_NUM_5: TIntegerField
FieldName = 'TASK_NUM_5'
end
object uqTaskPickerTasksTASK_NUM_6: TIntegerField
FieldName = 'TASK_NUM_6'
end
object uqTaskPickerTasksTASK_SUBJECT: TStringField
FieldName = 'TASK_SUBJECT'
Size = 80
end
end
end
......@@ -88,6 +88,25 @@ type
uqRenameTaskItemReportedBy: TUniQuery;
uqProjectReportedUsersTASK_ITEM_USER_ID: TStringField;
uqProjectReportedUsersNAME: TStringField;
uqAddTimeEntry: TUniQuery;
uqSaveTimeEntry: TUniQuery;
uqTaskPickerCustomers: TUniQuery;
uqTaskPickerProjects: TUniQuery;
uqTaskPickerTasks: TUniQuery;
uqTaskPickerCustomersCUSTOMER_ID: TStringField;
uqTaskPickerCustomersCUSTOMER_SHORT_NAME: TStringField;
uqTaskPickerProjectsPROJECT_ID: TStringField;
uqTaskPickerProjectsPROJECT_NAME: TStringField;
uqTaskPickerTasksTASK_ID: TStringField;
uqTaskPickerTasksCUSTOMER_SHORT_NAME: TStringField;
uqTaskPickerTasksPROJECT_NAME: TStringField;
uqTaskPickerTasksTASK_NUM_1: TIntegerField;
uqTaskPickerTasksTASK_NUM_2: TIntegerField;
uqTaskPickerTasksTASK_NUM_3: TIntegerField;
uqTaskPickerTasksTASK_NUM_4: TIntegerField;
uqTaskPickerTasksTASK_NUM_5: TIntegerField;
uqTaskPickerTasksTASK_NUM_6: TIntegerField;
uqTaskPickerTasksTASK_SUBJECT: TStringField;
procedure DataModuleCreate(Sender: TObject);
procedure uqUsersCalcFields(DataSet: TDataSet);
private
......
......@@ -53,7 +53,7 @@ uses
XData.Sys.Exceptions,
Common.Logging,
Common.Middleware.Logging,
Common.Config, Vcl.Forms, IniFiles, Api.Service;
Common.Config, Vcl.Forms, IniFiles, TaskItem.Service, TimeEntry.Service;
{%CLASSGROUP 'Vcl.Controls.TControl'}
......
object AuthDatabase: TAuthDatabase
OnCreate = DataModuleCreate
OnDestroy = DataModuleDestroy
Height = 202
Width = 578
Height = 236
Width = 327
object uqWebTasksUrl: TUniQuery
Connection = ucETaskAuth
SQL.Strings = (
......@@ -103,10 +103,9 @@ object AuthDatabase: TAuthDatabase
ProviderName = 'MySQL'
Database = 'eTask'
Username = 'root'
Server = '192.168.102.131'
Connected = True
Server = '192.168.102.133'
LoginPrompt = False
Left = 69
Left = 71
Top = 133
EncryptedPassword = '9AFF92FF8CFF86FF8CFFCFFFCEFF'
end
......@@ -128,18 +127,19 @@ object AuthDatabase: TAuthDatabase
' u.PERSPECTIVE_ID,'
' u.LAST_NAME,'
' u.FIRST_NAME,'
' u.PASSWORD,'
' w.WEB_LOGIN'
'from web_tasks_url w'
'join users u on u.USER_ID = w.USER_ID'
'where w.USER_ID = :USER_ID'
'where u.USER_NAME = :USER_NAME'
' and w.TASK_ID = :TASK_ID'
' and u.PASSWORD = :PASSWORD')
Left = 192
' and w.URL_CODE = :URL_CODE')
Left = 194
Top = 44
ParamData = <
item
DataType = ftUnknown
Name = 'USER_ID'
Name = 'USER_NAME'
Value = nil
end
item
......@@ -149,7 +149,7 @@ object AuthDatabase: TAuthDatabase
end
item
DataType = ftUnknown
Name = 'PASSWORD'
Name = 'URL_CODE'
Value = nil
end>
object uqWebLoginUSER_ID: TStringField
......@@ -192,6 +192,10 @@ object AuthDatabase: TAuthDatabase
FieldName = 'FIRST_NAME'
Size = 25
end
object uqWebLoginPASSWORD: TStringField
FieldName = 'PASSWORD'
Size = 12
end
object uqWebLoginWEB_LOGIN: TStringField
FieldName = 'WEB_LOGIN'
ReadOnly = True
......
......@@ -36,6 +36,7 @@ type
uqWebLoginPERSPECTIVE_ID: TStringField;
uqWebLoginLAST_NAME: TStringField;
uqWebLoginFIRST_NAME: TStringField;
uqWebLoginPASSWORD: TStringField;
uqWebLoginWEB_LOGIN: TStringField;
procedure DataModuleCreate(Sender: TObject);
procedure DataModuleDestroy(Sender: TObject);
......
......@@ -18,9 +18,9 @@ type
[ServiceContract, Model(AUTH_MODEL)]
IAuthService = interface(IInvokable)
['{9CFD59B2-A832-4F82-82BB-9A25FC93F305}']
function Login(const userId, taskId, urlCode: string): string;
function Login(userId, taskId, urlCode: string): string;
function VerifyVersion(ClientVersion: string): TJSONObject;
function WebLogin(const userId, taskId, password: string): string;
function WebLogin(userName, loginType, loginValue, password: string): string;
end;
implementation
......
......@@ -29,12 +29,16 @@ type
procedure AfterConstruction; override;
procedure BeforeDestruction; override;
function CheckUrlLogin(const userId, taskId, urlCode: string): Integer;
function CheckUrlLogin(userId, taskId, urlCode: string): Integer;
function CheckUserLogin(userName, taskId, password: string): Integer;
function HashPassword(const APassword: string): string;
procedure LoadUserFromUrlLoginQuery;
procedure LoadUserFromWebLoginQuery;
public
function Login(const userId, taskId, urlCode: string): string;
function Login(userId, taskId, urlCode: string): string;
function VerifyVersion(ClientVersion: string): TJSONObject;
function WebLogin(const userId, taskId, password: string): string;
function WebLogin(userName, loginType, loginValue, password: string): string;
function CheckTimeEntriesLogin(userName, password: string): Integer;
end;
implementation
......@@ -63,12 +67,14 @@ begin
end;
end;
procedure TAuthService.BeforeDestruction;
begin
authDB.Free;
inherited;
end;
function TAuthService.VerifyVersion(ClientVersion: string): TJSONObject;
var
iniFile: TIniFile;
......@@ -100,7 +106,8 @@ begin
end;
end;
function TAuthService.CheckUrlLogin(const userId, taskId, urlCode: string): Integer;
function TAuthService.CheckUrlLogin(userId, taskId, urlCode: string): Integer;
var
sql: string;
timeNow: TDateTime;
......@@ -109,7 +116,8 @@ begin
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 + 'u.TASK_RIGHTS, u.PERSPECTIVE_ID, u.LAST_NAME, u.FIRST_NAME, ';
sql := sql + 'w.URL_TIME, w.URL_TIME_EXP, w.WEB_LOGIN ';
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 ';
......@@ -151,28 +159,30 @@ begin
Result := 3;
end;
procedure TAuthService.LoadUserFromUrlLoginQuery;
var
nameValue: string;
begin
Self.userId := authDB.uqWebTasksUrl.FieldByName('USER_ID').AsString;
userName := authDB.uqWebTasksUrl.FieldByName('USER_NAME').AsString;
userStatus := authDB.uqWebTasksUrl.FieldByName('STATUS').AsString;
userEmail := authDB.uqWebTasksUrl.FieldByName('EMAIL').AsString;
userAccessLevel := authDB.uqWebTasksUrl.FieldByName('ACCESS_LEVEL').AsString;
userTaskRights := authDB.uqWebTasksUrl.FieldByName('TASK_RIGHTS').AsString;
userPerspectiveId := authDB.uqWebTasksUrl.FieldByName('PERSPECTIVE_ID').AsString;
userLastName := authDB.uqWebTasksUrl.FieldByName('LAST_NAME').AsString;
userFirstName := authDB.uqWebTasksUrl.FieldByName('FIRST_NAME').AsString;
nameValue := Trim(authDB.uqWebTasksUrl.FieldByName('NAME').AsString);
Self.userId := authDB.uqWebTasksUrlUSER_ID.AsString;
userName := authDB.uqWebTasksUrlUSER_NAME.AsString;
userStatus := authDB.uqWebTasksUrlSTATUS.AsString;
userEmail := authDB.uqWebTasksUrlEMAIL.AsString;
userAccessLevel := authDB.uqWebTasksUrlACCESS_LEVEL.AsString;
userTaskRights := authDB.uqWebTasksUrlTASK_RIGHTS.AsString;
userPerspectiveId := authDB.uqWebTasksUrlPERSPECTIVE_ID.AsString;
userLastName := authDB.uqWebTasksUrlLAST_NAME.AsString;
userFirstName := authDB.uqWebTasksUrlFIRST_NAME.AsString;
nameValue := Trim(authDB.uqWebTasksUrlNAME.AsString);
if nameValue <> '' then
userFullName := nameValue
else
userFullName := Trim(userFirstName + ' ' + userLastName);
end;
function TAuthService.Login(const userId, taskId, urlCode: string): string;
function TAuthService.Login(userId, taskId, urlCode: string): string;
var
userState: Integer;
jwt: TJWT;
......@@ -230,6 +240,227 @@ begin
end;
end;
function TAuthService.WebLogin(userName, loginType, loginValue, password: string): string;
var
userState: Integer;
jwt: TJWT;
begin
Logger.Log(3, Format('AuthService.WebLogin - UserName: %s, LoginType: %s, LoginValue: %s',
[userName, loginType, loginValue]));
try
if SameText(loginType, 'task_items') then
userState := CheckUserLogin(userName, loginValue, password)
else if SameText(loginType, 'time_entries') then
userState := CheckTimeEntriesLogin(userName, password)
else
begin
Logger.Log(2, 'Web Login Error: Invalid login type: ' + loginType);
raise EXDataHttpUnauthorized.Create('Invalid login type');
end;
except
on E: EXDataHttpUnauthorized do
raise;
on E: Exception do
begin
Logger.Log(1, 'Web Login failed due to database error: ' + E.Message);
raise EXDataHttpException.Create(500, 'Login failed: Unable to connect to the database.');
end;
end;
if userState = 0 then
begin
if SameText(loginType, 'time_entries') then
begin
Logger.Log(2, 'Web Login Error: Invalid username or password');
raise EXDataHttpUnauthorized.Create('Invalid user name or password');
end
else
begin
Logger.Log(2, 'Web Login Error: Invalid username, task id, or password');
raise EXDataHttpUnauthorized.Create('Invalid user name, task id, or password');
end;
end;
if userState = 1 then
begin
Logger.Log(2, 'Web Login Error: User not active!');
raise EXDataHttpUnauthorized.Create('User not active!');
end;
if userState = 2 then
begin
Logger.Log(2, 'Web Login Error: Web login is not enabled for this task');
raise EXDataHttpUnauthorized.Create('Web login is not enabled for this task');
end;
jwt := TJWT.Create;
try
jwt.Claims.JWTId := LowerCase(Copy(TUtils.GuidToVariant(TUtils.NewGuid), 2, 36));
jwt.Claims.IssuedAt := Now;
jwt.Claims.Expiration := IncHour(Now, 24);
jwt.Claims.SetClaimOfType<string>('user_id', Self.userId);
jwt.Claims.SetClaimOfType<string>('user_name', Self.userName);
jwt.Claims.SetClaimOfType<string>('user_fullname', userFullName);
jwt.Claims.SetClaimOfType<string>('user_status', userStatus);
jwt.Claims.SetClaimOfType<string>('user_email', userEmail);
jwt.Claims.SetClaimOfType<string>('user_access_level', userAccessLevel);
jwt.Claims.SetClaimOfType<string>('task_rights', userTaskRights);
jwt.Claims.SetClaimOfType<string>('user_perspective_id', userPerspectiveId);
jwt.Claims.SetClaimOfType<string>('first_name', userFirstName);
jwt.Claims.SetClaimOfType<string>('last_name', userLastName);
Result := TJOSE.SHA256CompactToken(serverConfig.jwtTokenSecret, jwt);
finally
jwt.Free;
end;
end;
function TAuthService.HashPassword(const APassword: string): string;
begin
Result := LowerCase(THashSHA2.GetHashString(UpperCase(Trim(APassword))));
end;
function TAuthService.CheckUserLogin(userName, taskId, password: string): Integer;
var
webLogin: string;
storedPasswordHash: string;
begin
Logger.Log(3, 'TAuthService.CheckUserLogin(userName, taskId, password: string): Integer');
authDB.uqWebLogin.Close;
authDB.uqWebLogin.ParamByName('USER_NAME').AsString := userName;
authDB.uqWebLogin.ParamByName('TASK_ID').AsString := taskId;
authDB.uqWebLogin.ParamByName('URL_CODE').AsString := '000000';
authDB.uqWebLogin.Open;
if authDB.uqWebLogin.IsEmpty then
begin
Logger.Log(3, '--Web Login failed 0: authDB.uqWebLogin.IsEmpty');
Result := 0;
Exit;
end;
storedPasswordHash := HashPassword(authDB.uqWebLogin.FieldByName('PASSWORD').AsString);
if storedPasswordHash <> LowerCase(Trim(password)) then
begin
Logger.Log(3, '--Web Login failed 0: password hash mismatch');
Result := 0;
Exit;
end;
if authDB.uqWebLoginSTATUS.AsString <> 'ACTIVE' then
begin
Logger.Log(3, '--Web Login failed 1: authDB.uqWebLoginSTATUS.AsString <> ACTIVE');
Result := 1;
Exit;
end;
webLogin := authDB.uqWebLoginWEB_LOGIN.AsString;
if webLogin <> 'T' then
begin
Logger.Log(3, '--Web Login failed 2: WEB_LOGIN <> "T"');
Result := 2;
Exit;
end;
LoadUserFromWebLoginQuery;
Result := 3;
end;
function TAuthService.CheckTimeEntriesLogin(userName, password: string): Integer;
var
q: TUniQuery;
storedPasswordHash: string;
nameValue: string;
begin
Logger.Log(3, 'TAuthService.CheckTimeEntriesLogin(userName, password: string): Integer');
q := TUniQuery.Create(nil);
try
q.Connection := authDB.uqWebLogin.Connection;
q.SQL.Text :=
'select ' +
' USER_ID, USER_NAME, NAME, STATUS, EMAIL, ACCESS_LEVEL, ' +
' TASK_RIGHTS, PERSPECTIVE_ID, LAST_NAME, FIRST_NAME, PASSWORD ' +
'from users ' +
'where USER_NAME = :USER_NAME';
q.ParamByName('USER_NAME').AsString := userName;
q.Open;
if q.IsEmpty then
begin
Logger.Log(3, '--Time Entries Login failed 0: user not found');
Result := 0;
Exit;
end;
storedPasswordHash := HashPassword(q.FieldByName('PASSWORD').AsString);
if storedPasswordHash <> LowerCase(Trim(password)) then
begin
Logger.Log(3, '--Time Entries Login failed 0: password hash mismatch');
Result := 0;
Exit;
end;
if q.FieldByName('STATUS').AsString <> 'ACTIVE' then
begin
Logger.Log(3, '--Time Entries Login failed 1: user is not active');
Result := 1;
Exit;
end;
Self.userId := q.FieldByName('USER_ID').AsString;
Self.userName := q.FieldByName('USER_NAME').AsString;
userStatus := q.FieldByName('STATUS').AsString;
userEmail := q.FieldByName('EMAIL').AsString;
userAccessLevel := q.FieldByName('ACCESS_LEVEL').AsString;
userTaskRights := q.FieldByName('TASK_RIGHTS').AsString;
userPerspectiveId := q.FieldByName('PERSPECTIVE_ID').AsString;
userLastName := q.FieldByName('LAST_NAME').AsString;
userFirstName := q.FieldByName('FIRST_NAME').AsString;
nameValue := Trim(q.FieldByName('NAME').AsString);
if nameValue <> '' then
userFullName := nameValue
else
userFullName := Trim(userFirstName + ' ' + userLastName);
Result := 3;
finally
q.Free;
end;
end;
procedure TAuthService.LoadUserFromWebLoginQuery;
var
nameValue: string;
begin
Self.userId := authDB.uqWebLOginUSER_ID.AsString;
userName := authDB.uqWebLoginUSER_NAME.AsString;
userStatus := authDB.uqWebLoginSTATUS.AsString;
userEmail := authDB.uqWebLoginEMAIL.AsString;
userAccessLevel := authDB.uqWebLoginACCESS_LEVEL.AsString;
userTaskRights := authDB.uqWebLoginTASK_RIGHTS.AsString;
userPerspectiveId := authDB.uqWebLoginPERSPECTIVE_ID.AsString;
userLastName := authDB.uqWebLoginLAST_NAME.AsString;
userFirstName := authDB.uqWebLoginFIRST_NAME.AsString;
nameValue := Trim(authDB.uqWebLoginNAME.AsString);
if nameValue <> '' then
userFullName := nameValue
else
userFullName := Trim(userFirstName + ' ' + userLastName);
end;
initialization
RegisterServiceType(TAuthService);
......
unit Main;
//Authors:
//Elias Sarraf
//Mac Stephens
//Cameron Hayes
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, Winapi.ShellApi,
System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs,
Vcl.StdCtrls, Vcl.ExtCtrls, System.Generics.Collections, System.IniFiles,
Auth.Service, Auth.Server.Module, Api.Service, Api.Server.Module, App.Server.Module,
ExeInfo;
TaskItem.Service, Auth.Server.Module, Auth.Service, Api.Server.Module, App.Server.Module,
TimeEntry.Service, TimeEntry.ServiceImpl, ExeInfo;
type
TFMain = class(TForm)
......
unit Api.Service;
unit TaskItem.Service;
interface
......@@ -115,10 +115,10 @@ type
type
[ServiceContract, Model(API_MODEL)]
IApiService = interface(IInvokable)
ITaskItemService = interface(IInvokable)
['{0EFB33D7-8C4C-4F3C-9BC3-8B4D444B5F69}']
function GetTaskItems(taskId: string): TTaskItemsResponse;
[HttpGet] function GetTaskItems(taskId: string): TTaskItemsResponse;
[HttpPost] function AddTaskRow(taskId: string; insertAfterItemNum: Integer): Boolean;
[HttpPost] function AddAssignedName(taskId: string; name: string): TTaskUserOptionsResponse;
......@@ -134,9 +134,10 @@ type
[HttpPost] function RenameApplicationName(taskId: string; oldName: string; newName: string): TTaskApplicationOptionsResponse;
[HttpPost] function DeleteApplicationName(taskId: string; name: string): TTaskApplicationOptionsResponse;
procedure MoveTaskRow(const taskId: Integer; const taskItemId: Integer; const newItemNum: Integer);
function DeleteTaskRow(const taskId: Integer; const taskItemId: Integer): Boolean;
function SaveTaskItemField(const Item: TTaskItemFieldSave): Boolean;
[HttpPost] procedure MoveTaskRow(const taskId: Integer; const taskItemId: Integer; const newItemNum: Integer);
[HttpPost] function DeleteTaskRow(const taskId: Integer; const taskItemId: Integer): Boolean;
[HttpPost] function SaveTaskItemField(const Item: TTaskItemFieldSave): Boolean;
end;
implementation
......@@ -188,6 +189,6 @@ begin
end;
initialization
RegisterServiceType(TypeInfo(IApiService));
RegisterServiceType(TypeInfo(ITaskItemService));
end.
unit Api.ServiceImpl;
unit TaskItem.ServiceImpl;
interface
uses
XData.Server.Module, XData.Service.Common,
System.Variants, System.DateUtils, Uni,
Api.Service, Api.Database, Common.Logging,
TaskItem.Service, Api.Database, Common.Logging,
System.SysUtils, JSON, System.IniFiles, DBAccess;
type
[ServiceImplementation]
TApiService = class(TInterfacedObject, IApiService)
TTaskItemService = class(TInterfacedObject, ITaskItemService)
strict private
apiDB: TApiDatabase;
private
......@@ -47,22 +47,23 @@ type
implementation
procedure TApiService.AfterConstruction;
procedure TTaskItemService.AfterConstruction;
begin
inherited;
apiDB := TApiDatabase.Create(nil);
Logger.Log(4, 'ApiService.AfterConstruction - apiDB created');
Logger.Log(4, 'TaskItemService.AfterConstruction - apiDB created');
end;
procedure TApiService.BeforeDestruction;
procedure TTaskItemService.BeforeDestruction;
begin
Logger.Log(4, 'ApiService.BeforeDestruction - freeing apiDB');
Logger.Log(4, 'TaskItemService.BeforeDestruction - freeing apiDB');
apiDB.Free;
inherited;
end;
function TApiService.GetTaskItems(taskId: string): TTaskItemsResponse;
function TTaskItemService.GetTaskItems(taskId: string): TTaskItemsResponse;
var
taskHeader: TTaskHeader;
taskUserOption: TTaskUserOption;
......@@ -70,7 +71,7 @@ var
taskApplicationOption: TTaskApplicationOption;
item: TTaskItem;
begin
Logger.Log(4, Format('ApiService.GetTaskItems - TASK_ID="%s"', [taskId]));
Logger.Log(4, Format('TaskItemService.GetTaskItems - TASK_ID="%s"', [taskId]));
Result := TTaskItemsResponse.Create;
TXDataOperationContext.Current.Handler.ManagedObjects.Add(Result);
......@@ -82,7 +83,7 @@ begin
if apiDB.uqTaskHeader.IsEmpty then
begin
Logger.Log(2, Format('ApiService.GetTaskItems - no task header found for TASK_ID="%s"', [taskId]));
Logger.Log(2, Format('TaskItemService.GetTaskItems - no task header found for TASK_ID="%s"', [taskId]));
Result.count := 0;
Exit;
end;
......@@ -205,23 +206,23 @@ begin
end;
Result.count := Result.items.Count;
Logger.Log(4, Format('ApiService.GetTaskItems - returned %d item(s)', [Result.count]));
Logger.Log(4, Format('TaskItemService.GetTaskItems - returned %d item(s)', [Result.count]));
except
on E: Exception do
begin
Logger.Log(2, 'ApiService.GetTaskItems - ERROR: ' + E.Message);
Logger.Log(2, 'TaskItemService.GetTaskItems - ERROR: ' + E.Message);
raise;
end;
end;
end;
function TApiService.AddTaskRow(taskId: string; insertAfterItemNum: Integer): Boolean;
function TTaskItemService.AddTaskRow(taskId: string; insertAfterItemNum: Integer): Boolean;
var
newItemNum: Integer;
maxItemNum: Integer;
begin
Logger.Log(4, Format('ApiService.AddTaskRow - TASK_ID="%s" INSERT_AFTER_ITEM_NUM="%d"', [taskId, insertAfterItemNum]));
Logger.Log(4, Format('TaskItemService.AddTaskRow - TASK_ID="%s" INSERT_AFTER_ITEM_NUM="%d"', [taskId, insertAfterItemNum]));
apiDB.uqGetTaskMaxItemNum.Close;
apiDB.uqGetTaskMaxItemNum.ParamByName('TASK_ID').AsString := taskId;
......@@ -257,21 +258,21 @@ begin
apiDB.uqAddTaskRow.Connection.Commit;
Result := True;
Logger.Log(4, Format('ApiService.AddTaskRow - OK TASK_ID="%s" ITEM_NUM="%d"', [taskId, newItemNum]));
Logger.Log(4, Format('TaskItemService.AddTaskRow - OK TASK_ID="%s" ITEM_NUM="%d"', [taskId, newItemNum]));
except
on E: Exception do
begin
if apiDB.uqAddTaskRow.Connection.InTransaction then
apiDB.uqAddTaskRow.Connection.Rollback;
Logger.Log(2, 'ApiService.AddTaskRow - ERROR: ' + E.Message);
Logger.Log(2, 'TaskItemService.AddTaskRow - ERROR: ' + E.Message);
raise;
end;
end;
end;
procedure TApiService.MoveTaskRow(const taskId: Integer; const taskItemId: Integer; const newItemNum: Integer);
procedure TTaskItemService.MoveTaskRow(const taskId: Integer; const taskItemId: Integer; const newItemNum: Integer);
var
oldItemNum: Integer;
maxItemNum: Integer;
......@@ -368,7 +369,7 @@ begin
end;
function TApiService.SaveTaskItemField(const Item: TTaskItemFieldSave): Boolean;
function TTaskItemService.SaveTaskItemField(const Item: TTaskItemFieldSave): Boolean;
var
uqSaveField: TUniQuery;
columnName: string;
......@@ -478,7 +479,7 @@ begin
end;
function TApiService.BuildTaskNumber: string;
function TTaskItemService.BuildTaskNumber: string;
procedure AddPart(const value: string);
var
......@@ -506,7 +507,7 @@ begin
end;
function TApiService.BuildTaskTitle(const taskNumber, projectName, subject: string): string;
function TTaskItemService.BuildTaskTitle(const taskNumber, projectName, subject: string): string;
begin
Result := 'Task';
......@@ -521,11 +522,11 @@ begin
end;
function TApiService.DeleteTaskRow(const taskId: Integer; const taskItemId: Integer): Boolean;
function TTaskItemService.DeleteTaskRow(const taskId: Integer; const taskItemId: Integer): Boolean;
var
oldItemNum: Integer;
begin
Logger.Log(4, Format('ApiService.DeleteTaskRow - TASK_ID="%d" TASK_ITEM_ID="%d"', [taskId, taskItemId]));
Logger.Log(4, Format('TaskItemService.DeleteTaskRow - TASK_ID="%d" TASK_ITEM_ID="%d"', [taskId, taskItemId]));
apiDB.uqGetTaskRowPosition.Close;
apiDB.uqGetTaskRowPosition.ParamByName('TASK_ID').AsInteger := taskId;
......@@ -534,7 +535,7 @@ begin
if apiDB.uqGetTaskRowPosition.IsEmpty then
begin
Logger.Log(2, Format('ApiService.DeleteTaskRow - row not found TASK_ID="%d" TASK_ITEM_ID="%d"', [taskId, taskItemId]));
Logger.Log(2, Format('TaskItemService.DeleteTaskRow - row not found TASK_ID="%d" TASK_ITEM_ID="%d"', [taskId, taskItemId]));
raise Exception.Create('Task row not found.');
end;
......@@ -553,21 +554,21 @@ begin
apiDB.uqGetTaskRowPosition.Connection.Commit;
Result := True;
Logger.Log(4, Format('ApiService.DeleteTaskRow - OK TASK_ID="%d" TASK_ITEM_ID="%d" OLD_ITEM_NUM="%d"', [taskId, taskItemId, oldItemNum]));
Logger.Log(4, Format('TaskItemService.DeleteTaskRow - OK TASK_ID="%d" TASK_ITEM_ID="%d" OLD_ITEM_NUM="%d"', [taskId, taskItemId, oldItemNum]));
except
on E: Exception do
begin
if apiDB.uqGetTaskRowPosition.Connection.InTransaction then
apiDB.uqGetTaskRowPosition.Connection.Rollback;
Logger.Log(2, Format('ApiService.DeleteTaskRow - ERROR TASK_ID="%d" TASK_ITEM_ID="%d" MSG="%s"', [taskId, taskItemId, E.Message]));
Logger.Log(2, Format('TaskItemService.DeleteTaskRow - ERROR TASK_ID="%d" TASK_ITEM_ID="%d" MSG="%s"', [taskId, taskItemId, E.Message]));
raise;
end;
end;
end;
function TApiService.FindAssignedOptionId(const taskId, name: string): string;
function TTaskItemService.FindAssignedOptionId(const taskId, name: string): string;
begin
Result := '';
......@@ -587,7 +588,8 @@ begin
end;
end;
function TApiService.FindAssignedOptionName(const taskId, name: string): string;
function TTaskItemService.FindAssignedOptionName(const taskId, name: string): string;
begin
Result := '';
......@@ -608,7 +610,7 @@ begin
end;
function TApiService.AddAssignedName(taskId: string; name: string): TTaskUserOptionsResponse;
function TTaskItemService.AddAssignedName(taskId: string; name: string): TTaskUserOptionsResponse;
var
newName: string;
existingName: string;
......@@ -646,7 +648,7 @@ begin
end;
function TApiService.RenameAssignedName(taskId: string; oldName: string; newName: string): TTaskUserOptionsResponse;
function TTaskItemService.RenameAssignedName(taskId: string; oldName: string; newName: string): TTaskUserOptionsResponse;
var
oldAssignedId: string;
existingAssignedId: string;
......@@ -706,7 +708,7 @@ begin
end;
function TApiService.DeleteAssignedName(taskId: string; name: string): TTaskUserOptionsResponse;
function TTaskItemService.DeleteAssignedName(taskId: string; name: string): TTaskUserOptionsResponse;
var
assignedId: string;
assignedName: string;
......@@ -743,7 +745,7 @@ begin
end;
function TApiService.BuildAssignedOptionsResponse(const taskId: string): TTaskUserOptionsResponse;
function TTaskItemService.BuildAssignedOptionsResponse(const taskId: string): TTaskUserOptionsResponse;
var
taskUserOption: TTaskUserOption;
begin
......@@ -767,7 +769,7 @@ begin
end;
function TApiService.FindProjectId(const taskId: string): string;
function TTaskItemService.FindProjectId(const taskId: string): string;
begin
Result := '';
......@@ -780,7 +782,7 @@ begin
end;
function TApiService.FindApplicationId(const taskId, name: string): Integer;
function TTaskItemService.FindApplicationId(const taskId, name: string): Integer;
begin
Result := 0;
......@@ -800,7 +802,8 @@ begin
end;
end;
function TApiService.FindApplicationName(const taskId, name: string): string;
function TTaskItemService.FindApplicationName(const taskId, name: string): string;
begin
Result := '';
......@@ -821,7 +824,7 @@ begin
end;
function TApiService.BuildApplicationOptionsResponse(const taskId: string): TTaskApplicationOptionsResponse;
function TTaskItemService.BuildApplicationOptionsResponse(const taskId: string): TTaskApplicationOptionsResponse;
var
taskApplicationOption: TTaskApplicationOption;
begin
......@@ -845,7 +848,7 @@ begin
end;
function TApiService.AddApplicationName(taskId: string; name: string): TTaskApplicationOptionsResponse;
function TTaskItemService.AddApplicationName(taskId: string; name: string): TTaskApplicationOptionsResponse;
var
projectId: string;
newName: string;
......@@ -884,7 +887,7 @@ begin
end;
function TApiService.RenameApplicationName(taskId: string; oldName: string; newName: string): TTaskApplicationOptionsResponse;
function TTaskItemService.RenameApplicationName(taskId: string; oldName: string; newName: string): TTaskApplicationOptionsResponse;
var
projectId: string;
oldApplicationId: Integer;
......@@ -949,7 +952,7 @@ begin
end;
function TApiService.DeleteApplicationName(taskId: string; name: string): TTaskApplicationOptionsResponse;
function TTaskItemService.DeleteApplicationName(taskId: string; name: string): TTaskApplicationOptionsResponse;
var
projectId: string;
applicationId: Integer;
......@@ -990,7 +993,8 @@ begin
Result := BuildApplicationOptionsResponse(taskId);
end;
function TApiService.FindReportedOptionId(const taskId, name: string): string;
function TTaskItemService.FindReportedOptionId(const taskId, name: string): string;
begin
Result := '';
......@@ -1010,7 +1014,8 @@ begin
end;
end;
function TApiService.FindReportedOptionName(const taskId, name: string): string;
function TTaskItemService.FindReportedOptionName(const taskId, name: string): string;
begin
Result := '';
......@@ -1030,7 +1035,8 @@ begin
end;
end;
function TApiService.BuildReportedOptionsResponse(const taskId: string): TTaskUserOptionsResponse;
function TTaskItemService.BuildReportedOptionsResponse(const taskId: string): TTaskUserOptionsResponse;
var
taskUserOption: TTaskUserOption;
begin
......@@ -1053,7 +1059,8 @@ begin
end;
end;
function TApiService.AddReportedName(taskId: string; name: string): TTaskUserOptionsResponse;
function TTaskItemService.AddReportedName(taskId: string; name: string): TTaskUserOptionsResponse;
var
newName: string;
existingName: string;
......@@ -1090,7 +1097,8 @@ begin
Result := BuildReportedOptionsResponse(taskId);
end;
function TApiService.RenameReportedName(taskId: string; oldName: string; newName: string): TTaskUserOptionsResponse;
function TTaskItemService.RenameReportedName(taskId: string; oldName: string; newName: string): TTaskUserOptionsResponse;
var
oldReportedId: string;
existingReportedId: string;
......@@ -1149,7 +1157,8 @@ begin
Result := BuildReportedOptionsResponse(taskId);
end;
function TApiService.DeleteReportedName(taskId: string; name: string): TTaskUserOptionsResponse;
function TTaskItemService.DeleteReportedName(taskId: string; name: string): TTaskUserOptionsResponse;
var
reportedId: string;
reportedName: string;
......@@ -1185,11 +1194,8 @@ begin
Result := BuildReportedOptionsResponse(taskId);
end;
initialization
RegisterServiceType(TypeInfo(IApiService));
RegisterServiceType(TApiService);
RegisterServiceType(TTaskItemService);
end.
unit TimeEntry.Service;
interface
uses
System.Generics.Collections,
XData.Service.Common,
Bcl.Types.Nullable,
Aurelius.Mapping.Attributes;
const
API_MODEL = 'Api';
type
TTimeEntry = class
public
entryId: Integer;
taskDate: string;
taskId: string;
taskDisplay: string;
hours: Nullable<Double>;
taskTime: string;
place: string;
placeDesc: string;
category: string;
categoryDesc: string;
summary: string;
end;
TTimeEntryTaskOption = class
public
taskId: string;
taskDisplay: string;
end;
TTimeEntryCategoryOption = class
public
code: string;
codeDesc: string;
end;
TTimeEntriesResponse = class
public
userName: string;
count: Integer;
items: TList<TTimeEntry>;
taskOptions: TList<TTimeEntryTaskOption>;
categoryOptions: TList<TTimeEntryCategoryOption>;
placeOptions: TList<TTimeEntryCategoryOption>;
constructor Create;
destructor Destroy; override;
end;
TTimeEntrySave = class
public
entryId: string;
userId: string;
taskDate: string;
taskId: string;
hours: Double;
taskTime: string;
place: string;
category: string;
summary: string;
end;
TTimeEntryFieldSave = class
public
entryId: Integer;
userId: string;
fieldName: string;
value: string;
end;
type
TTaskPickerOption = class
public
value: string;
display: string;
end;
TTaskPickerOptionsResponse = class
public
options: TList<TTaskPickerOption>;
constructor Create;
destructor Destroy; override;
end;
[ServiceContract, Model(API_MODEL)]
ITimeEntryService = interface(IInvokable)
['{B18BCD1E-B19A-4D25-BBA9-50A24FC4C690}']
[HttpGet] function GetTimeEntries(userId, startDate, endDate: string): TTimeEntriesResponse;
[HttpPost] function AddTimeEntry(userId, taskDate: string): string;
[HttpPost] function SaveTimeEntry(Item: TTimeEntrySave): string;
[HttpPost] function SaveTimeEntryField(Item: TTimeEntryFieldSave): Boolean;
[HttpPost] function DeleteTimeEntry(userId: string; entryId: Integer): Boolean;
function GetTaskPickerCustomers(userId: string): TTaskPickerOptionsResponse;
function GetTaskPickerProjects(userId, customerId: string): TTaskPickerOptionsResponse;
function GetTaskPickerTasks(userId, projectId: string): TTaskPickerOptionsResponse;
end;
implementation
constructor TTimeEntriesResponse.Create;
begin
inherited;
items := TList<TTimeEntry>.Create;
taskOptions := TList<TTimeEntryTaskOption>.Create;
categoryOptions := TList<TTimeEntryCategoryOption>.Create;
placeOptions := TList<TTimeEntryCategoryOption>.Create;
end;
destructor TTimeEntriesResponse.Destroy;
begin
items.Free;
taskOptions.Free;
categoryOptions.Free;
placeOptions.Free;
inherited;
end;
constructor TTaskPickerOptionsResponse.Create;
begin
inherited;
options := TList<TTaskPickerOption>.Create;
end;
destructor TTaskPickerOptionsResponse.Destroy;
begin
options.Free;
inherited;
end;
initialization
RegisterServiceType(TypeInfo(ITimeEntryService));
end.
unit TimeEntry.ServiceImpl;
interface
uses
XData.Service.Common,
XData.Server.Module,
TimeEntry.Service,
Api.Database,
Uni;
type
[ServiceImplementation]
TTimeEntryService = class(TInterfacedObject, ITimeEntryService)
strict private
apiDB: TApiDatabase;
procedure AfterConstruction; override;
procedure BeforeDestruction; override;
function ParseIsoDate(value: string): TDateTime;
function FieldText(AQuery: TUniQuery; AFieldName: string): string;
function BuildTaskNumber(AQuery: TUniQuery): string;
function BuildTaskDisplay(AQuery: TUniQuery): string;
procedure LoadUserName(AResponse: TTimeEntriesResponse; userId: string);
procedure LoadTimeEntryItems(AResponse: TTimeEntriesResponse; userId: string; startDateValue, exclusiveEndDateValue: TDateTime);
procedure LoadTaskOptions(AResponse: TTimeEntriesResponse; userId: string; startDateValue, exclusiveEndDateValue: TDateTime);
procedure LoadPlaceOptions(AResponse: TTimeEntriesResponse);
procedure LoadCategoryOptions(AResponse: TTimeEntriesResponse);
function GetNextIdValue(const AKeyName: string): string;
public
function GetTimeEntries(userId, startDate, endDate: string): TTimeEntriesResponse;
function AddTimeEntry(userId, taskDate: string): string;
function SaveTimeEntry(Item: TTimeEntrySave): string;
function SaveTimeEntryField(Item: TTimeEntryFieldSave): Boolean;
function GetTaskPickerCustomers(userId: string): TTaskPickerOptionsResponse;
function GetTaskPickerProjects(userId, customerId: string): TTaskPickerOptionsResponse;
function GetTaskPickerTasks(userId, projectId: string): TTaskPickerOptionsResponse;
function DeleteTimeEntry(userId: string; entryId: Integer): Boolean;
end;
implementation
uses
System.SysUtils,
System.DateUtils,
Common.Logging;
procedure TTimeEntryService.AfterConstruction;
begin
inherited;
apiDB := TApiDatabase.Create(nil);
end;
procedure TTimeEntryService.BeforeDestruction;
begin
apiDB.Free;
inherited;
end;
function TTimeEntryService.ParseIsoDate(value: string): TDateTime;
var
yearValue: Integer;
monthValue: Integer;
dayValue: Integer;
begin
yearValue := StrToInt(Copy(value, 1, 4));
monthValue := StrToInt(Copy(value, 6, 2));
dayValue := StrToInt(Copy(value, 9, 2));
Result := EncodeDate(yearValue, monthValue, dayValue);
end;
function TTimeEntryService.FieldText(AQuery: TUniQuery; AFieldName: string): string;
begin
if AQuery.FieldByName(AFieldName).IsNull then
Result := ''
else
Result := Trim(AQuery.FieldByName(AFieldName).AsString);
end;
function TTimeEntryService.BuildTaskNumber(AQuery: TUniQuery): string;
procedure AddPart(AValue: string);
begin
if AValue = '' then
Exit;
if Result <> '' then
Result := Result + '.';
Result := Result + AValue;
end;
begin
Result := '';
AddPart(FieldText(AQuery, 'TASK_NUM_1'));
AddPart(FieldText(AQuery, 'TASK_NUM_2'));
AddPart(FieldText(AQuery, 'TASK_NUM_3'));
AddPart(FieldText(AQuery, 'TASK_NUM_4'));
AddPart(FieldText(AQuery, 'TASK_NUM_5'));
AddPart(FieldText(AQuery, 'TASK_NUM_6'));
end;
procedure AddTaskPickerOption(AResponse: TTaskPickerOptionsResponse; const AValue, ADisplay: string);
var
option: TTaskPickerOption;
begin
option := TTaskPickerOption.Create;
TXDataOperationContext.Current.Handler.ManagedObjects.Add(option);
option.value := AValue;
option.display := ADisplay;
AResponse.options.Add(option);
end;
function TTimeEntryService.BuildTaskDisplay(AQuery: TUniQuery): string;
var
customerText: string;
projectText: string;
taskNumberText: string;
subjectText: string;
leftText: string;
taskText: string;
begin
customerText := FieldText(AQuery, 'CUSTOMER_SHORT_NAME');
projectText := FieldText(AQuery, 'PROJECT_NAME');
taskNumberText := BuildTaskNumber(AQuery);
subjectText := FieldText(AQuery, 'TASK_SUBJECT');
leftText := customerText;
if projectText <> '' then
begin
if leftText <> '' then
leftText := leftText + ' - ';
leftText := leftText + projectText;
end;
taskText := taskNumberText;
if subjectText <> '' then
begin
if taskText <> '' then
taskText := taskText + ' - ';
taskText := taskText + subjectText;
end;
Result := leftText;
if taskText <> '' then
begin
if Result <> '' then
Result := Result + ' | ';
Result := Result + taskText;
end;
end;
procedure TTimeEntryService.LoadUserName(AResponse: TTimeEntriesResponse; userId: string);
var
userQuery: TUniQuery;
begin
userQuery := TUniQuery.Create(nil);
try
userQuery.Connection := apiDB.ucETaskApi;
userQuery.SQL.Text :=
'select USER_ID, NAME, USER_NAME ' +
'from users ' +
'where USER_ID = :USER_ID';
userQuery.ParamByName('USER_ID').AsString := userId;
userQuery.Open;
AResponse.userName := FieldText(userQuery, 'NAME');
if AResponse.userName = '' then
AResponse.userName := FieldText(userQuery, 'USER_NAME');
finally
userQuery.Free;
end;
end;
procedure TTimeEntryService.LoadTimeEntryItems(AResponse: TTimeEntriesResponse; userId: string; startDateValue, exclusiveEndDateValue: TDateTime);
var
itemsQuery: TUniQuery;
item: TTimeEntry;
begin
itemsQuery := TUniQuery.Create(nil);
try
itemsQuery.Connection := apiDB.ucETaskApi;
itemsQuery.SQL.Text :=
'select ' +
' ti.ENTRY_ID, ' +
' ti.TASK_DATE, ' +
' ti.TASK_ID, ' +
' ti.HOURS, ' +
' ti.TASK_TIME, ' +
' ti.PLACE, ' +
' ti.CATEGORY, ' +
' cat.CODE_DESC as CATEGORY_DESC, ' +
' ti.SUMMARY, ' +
' c.SHORT_NAME as CUSTOMER_SHORT_NAME, ' +
' p.NAME as PROJECT_NAME, ' +
' t.TASK_NUM_1, ' +
' t.TASK_NUM_2, ' +
' t.TASK_NUM_3, ' +
' t.TASK_NUM_4, ' +
' t.TASK_NUM_5, ' +
' t.TASK_NUM_6, ' +
' t.SUBJECT as TASK_SUBJECT, ' +
' plc.CODE_DESC as PLACE_DESC ' +
'from time_items ti ' +
'left join tasks t on t.TASK_ID = ti.TASK_ID ' +
'left join project p on p.PROJECT_ID = t.PROJECT_ID ' +
'left join customers c on c.CUSTOMER_ID = p.CUSTOMER_ID ' +
'left join codes cat on cat.CATEGORY = ''TASK'' and cat.CODE_TYPE = ''CATGRY'' and cat.CODE = ti.CATEGORY ' +
'left join codes plc on plc.CATEGORY = ''GENERAL'' and plc.CODE_TYPE = ''PLACE'' and plc.CODE = ti.PLACE ' +
'where ti.USER_ID = :USER_ID ' +
' and ti.TASK_DATE >= :START_DATE ' +
' and ti.TASK_DATE < :END_DATE ' +
'order by ti.TASK_DATE, ti.ENTRY_ID';
itemsQuery.ParamByName('USER_ID').AsString := userId;
itemsQuery.ParamByName('START_DATE').AsDateTime := startDateValue;
itemsQuery.ParamByName('END_DATE').AsDateTime := exclusiveEndDateValue;
itemsQuery.Open;
while not itemsQuery.Eof do
begin
item := TTimeEntry.Create;
TXDataOperationContext.Current.Handler.ManagedObjects.Add(item);
item.entryId := itemsQuery.FieldByName('ENTRY_ID').AsInteger;
if itemsQuery.FieldByName('TASK_DATE').IsNull then
item.taskDate := ''
else
item.taskDate := FormatDateTime('yyyy-mm-dd', itemsQuery.FieldByName('TASK_DATE').AsDateTime);
item.taskId := FieldText(itemsQuery, 'TASK_ID');
item.taskDisplay := BuildTaskDisplay(itemsQuery);
if not itemsQuery.FieldByName('HOURS').IsNull then
item.hours := itemsQuery.FieldByName('HOURS').AsFloat;
item.taskTime := FieldText(itemsQuery, 'TASK_TIME');
item.place := FieldText(itemsQuery, 'PLACE');
item.placeDesc := FieldText(itemsQuery, 'PLACE_DESC');
if item.placeDesc = '' then
item.placeDesc := item.place;
item.category := FieldText(itemsQuery, 'CATEGORY');
item.categoryDesc := FieldText(itemsQuery, 'CATEGORY_DESC');
if item.categoryDesc = '' then
item.categoryDesc := item.category;
item.summary := FieldText(itemsQuery, 'SUMMARY');
AResponse.items.Add(item);
itemsQuery.Next;
end;
finally
itemsQuery.Free;
end;
end;
procedure TTimeEntryService.LoadTaskOptions(AResponse: TTimeEntriesResponse; userId: string; startDateValue, exclusiveEndDateValue: TDateTime);
var
tasksQuery: TUniQuery;
taskOption: TTimeEntryTaskOption;
begin
tasksQuery := TUniQuery.Create(nil);
try
tasksQuery.Connection := apiDB.ucETaskApi;
tasksQuery.SQL.Text :=
'select distinct ' +
' t.TASK_ID, ' +
' c.SHORT_NAME as CUSTOMER_SHORT_NAME, ' +
' p.NAME as PROJECT_NAME, ' +
' t.TASK_NUM_1, ' +
' t.TASK_NUM_2, ' +
' t.TASK_NUM_3, ' +
' t.TASK_NUM_4, ' +
' t.TASK_NUM_5, ' +
' t.TASK_NUM_6, ' +
' t.SUBJECT as TASK_SUBJECT ' +
'from task_assigned_user tau ' +
'join tasks t on t.TASK_ID = tau.TASK_ID ' +
'join project p on p.PROJECT_ID = t.PROJECT_ID ' +
'join customers c on c.CUSTOMER_ID = p.CUSTOMER_ID ' +
'where tau.USER_ID = :USER_ID ' +
' and upper(trim(coalesce(tau.FOCUSED_TASK, ''''))) = ''T'' ' +
'order by c.SHORT_NAME, p.NAME, t.TASK_NUM_1, t.TASK_NUM_2, t.TASK_NUM_3, t.TASK_NUM_4, t.TASK_NUM_5, t.TASK_NUM_6';
tasksQuery.ParamByName('USER_ID').AsString := userId;
tasksQuery.Open;
while not tasksQuery.Eof do
begin
taskOption := TTimeEntryTaskOption.Create;
TXDataOperationContext.Current.Handler.ManagedObjects.Add(taskOption);
taskOption.taskId := FieldText(tasksQuery, 'TASK_ID');
taskOption.taskDisplay := BuildTaskDisplay(tasksQuery);
AResponse.taskOptions.Add(taskOption);
tasksQuery.Next;
end;
finally
tasksQuery.Free;
end;
end;
procedure TTimeEntryService.LoadCategoryOptions(AResponse: TTimeEntriesResponse);
var
categoriesQuery: TUniQuery;
categoryOption: TTimeEntryCategoryOption;
begin
categoriesQuery := TUniQuery.Create(nil);
try
categoriesQuery.Connection := apiDB.ucETaskApi;
categoriesQuery.SQL.Text :=
'select CODE, CODE_DESC ' +
'from codes ' +
'where CATEGORY = ''TASK'' ' +
' and CODE_TYPE = ''CATGRY'' ' +
'order by CODE_DESC';
categoriesQuery.Open;
while not categoriesQuery.Eof do
begin
categoryOption := TTimeEntryCategoryOption.Create;
TXDataOperationContext.Current.Handler.ManagedObjects.Add(categoryOption);
categoryOption.code := FieldText(categoriesQuery, 'CODE');
categoryOption.codeDesc := FieldText(categoriesQuery, 'CODE_DESC');
AResponse.categoryOptions.Add(categoryOption);
categoriesQuery.Next;
end;
finally
categoriesQuery.Free;
end;
end;
procedure TTimeEntryService.LoadPlaceOptions(AResponse: TTimeEntriesResponse);
var
placeQuery: TUniQuery;
placeOption: TTimeEntryCategoryOption;
begin
placeQuery := TUniQuery.Create(nil);
try
placeQuery.Connection := apiDB.ucETaskApi;
placeQuery.SQL.Text :=
'select CODE, CODE_DESC ' +
'from codes ' +
'where CATEGORY = ''GENERAL'' ' +
' and CODE_TYPE = ''PLACE'' ' +
'order by CODE_DESC';
placeQuery.Open;
while not placeQuery.Eof do
begin
placeOption := TTimeEntryCategoryOption.Create;
TXDataOperationContext.Current.Handler.ManagedObjects.Add(placeOption);
placeOption.code := FieldText(placeQuery, 'CODE');
placeOption.codeDesc := FieldText(placeQuery, 'CODE_DESC');
AResponse.placeOptions.Add(placeOption);
placeQuery.Next;
end;
finally
placeQuery.Free;
end;
end;
function TTimeEntryService.GetTimeEntries(userId, startDate, endDate: string): TTimeEntriesResponse;
var
startDateValue: TDateTime;
endDateValue: TDateTime;
exclusiveEndDateValue: TDateTime;
begin
Logger.Log(4, Format('TimeEntryService.GetTimeEntries - USER_ID="%s" START="%s" END="%s"', [userId, startDate, endDate]));
Result := TTimeEntriesResponse.Create;
TXDataOperationContext.Current.Handler.ManagedObjects.Add(Result);
startDateValue := ParseIsoDate(startDate);
endDateValue := ParseIsoDate(endDate);
exclusiveEndDateValue := IncDay(endDateValue, 1);
LoadUserName(Result, userId);
LoadTimeEntryItems(Result, userId, startDateValue, exclusiveEndDateValue);
LoadTaskOptions(Result, userId, startDateValue, exclusiveEndDateValue);
LoadPlaceOptions(Result);
LoadCategoryOptions(Result);
Result.count := Result.items.Count;
Logger.Log(4, Format('TimeEntryService.GetTimeEntries - returned %d item(s)', [Result.count]));
end;
function TTimeEntryService.GetNextIdValue(const AKeyName: string): string;
var
q: TUniQuery;
nextId: Integer;
begin
q := TUniQuery.Create(nil);
try
q.Connection := apiDB.ucETaskApi;
q.SQL.Text :=
'select KeyValue from idfield where KeyName = :KEY_NAME';
q.ParamByName('KEY_NAME').AsString := AKeyName;
q.Open;
nextId := q.FieldByName('KeyValue').AsInteger + 1;
q.Close;
q.SQL.Text :=
'update idfield set KeyValue = :KEY_VALUE where KeyName = :KEY_NAME';
q.ParamByName('KEY_VALUE').AsInteger := nextId;
q.ParamByName('KEY_NAME').AsString := AKeyName;
q.ExecSQL;
Result := IntToStr(nextId);
finally
q.Free;
end;
end;
function TTimeEntryService.AddTimeEntry(userId, taskDate: string): string;
var
taskDateValue: TDateTime;
entryId: string;
begin
Logger.Log(4, Format('TimeEntryService.AddTimeEntry - USER_ID="%s" TASK_DATE="%s"', [userId, taskDate]));
taskDateValue := ParseIsoDate(taskDate);
entryId := GetNextIdValue('TimeEntryId');
apiDB.uqAddTimeEntry.Close;
apiDB.uqAddTimeEntry.ParamByName('ENTRY_ID').AsString := entryId;
apiDB.uqAddTimeEntry.ParamByName('USER_ID').AsString := userId;
apiDB.uqAddTimeEntry.ParamByName('TASK_DATE').AsDateTime := taskDateValue;
apiDB.uqAddTimeEntry.ParamByName('CREATED_BY').AsString := userId;
apiDB.uqAddTimeEntry.ParamByName('MODIFIED_BY').AsString := userId;
apiDB.uqAddTimeEntry.ExecSQL;
Result := entryId;
Logger.Log(4, 'TimeEntryService.AddTimeEntry - new ENTRY_ID=' + Result);
end;
function TTimeEntryService.SaveTimeEntry(Item: TTimeEntrySave): string;
var
taskDateValue: TDateTime;
entryId: string;
isNewEntry: Boolean;
q: TUniQuery;
begin
if not Assigned(Item) then
raise Exception.Create('SaveTimeEntry: Item is nil.');
if Trim(Item.userId) = '' then
raise Exception.Create('SaveTimeEntry: Invalid userId.');
if Trim(Item.taskDate) = '' then
raise Exception.Create('SaveTimeEntry: Task date is required.');
if Trim(Item.taskId) = '' then
raise Exception.Create('SaveTimeEntry: Task is required.');
if Item.hours <= 0 then
raise Exception.Create('SaveTimeEntry: Hours must be greater than zero.');
if Trim(Item.category) = '' then
raise Exception.Create('SaveTimeEntry: Category is required.');
if Trim(Item.summary) = '' then
raise Exception.Create('SaveTimeEntry: Summary is required.');
Logger.Log(4, Format(
'TimeEntryService.SaveTimeEntry - ENTRY_ID="%s" USER_ID="%s"',
[Item.entryId, Item.userId]
));
taskDateValue := ParseIsoDate(Item.taskDate);
isNewEntry := StrToIntDef(Item.entryId, 0) <= 0;
if isNewEntry then
begin
entryId := GetNextIdValue('TimeEntryId');
q := TUniQuery.Create(nil);
try
q.Connection := apiDB.ucETaskApi;
q.SQL.Text :=
'insert into time_items ( ' +
' ENTRY_ID, ' +
' USER_ID, ' +
' TASK_DATE, ' +
' TASK_ID, ' +
' PROJECT_ID, ' +
' HOURS, ' +
' TASK_TIME, ' +
' PLACE, ' +
' CATEGORY, ' +
' SUMMARY, ' +
' CREATE_DATE, ' +
' CREATED_BY, ' +
' MODIFY_DATE, ' +
' MODIFIED_BY ' +
') values ( ' +
' :ENTRY_ID, ' +
' :USER_ID, ' +
' :TASK_DATE, ' +
' :TASK_ID, ' +
' (select t.PROJECT_ID from tasks t where t.TASK_ID = :TASK_ID), ' +
' :HOURS, ' +
' :TASK_TIME, ' +
' :PLACE, ' +
' :CATEGORY, ' +
' :SUMMARY, ' +
' now(), ' +
' :CREATED_BY, ' +
' now(), ' +
' :MODIFIED_BY ' +
')';
q.ParamByName('ENTRY_ID').AsString := entryId;
q.ParamByName('USER_ID').AsString := Item.userId;
q.ParamByName('TASK_DATE').AsDateTime := taskDateValue;
q.ParamByName('TASK_ID').AsString := Item.taskId;
q.ParamByName('HOURS').AsFloat := Item.hours;
if Trim(Item.taskTime) = '' then
q.ParamByName('TASK_TIME').Clear
else
q.ParamByName('TASK_TIME').AsString := Item.taskTime;
if Trim(Item.place) = '' then
q.ParamByName('PLACE').Clear
else
q.ParamByName('PLACE').AsString := Item.place;
q.ParamByName('CATEGORY').AsString := Item.category;
q.ParamByName('SUMMARY').AsString := Item.summary;
q.ParamByName('CREATED_BY').AsString := Item.userId;
q.ParamByName('MODIFIED_BY').AsString := Item.userId;
q.ExecSQL;
finally
q.Free;
end;
end
else
begin
entryId := Item.entryId;
apiDB.uqSaveTimeEntry.Close;
apiDB.uqSaveTimeEntry.ParamByName('ENTRY_ID').AsString := entryId;
apiDB.uqSaveTimeEntry.ParamByName('USER_ID').AsString := Item.userId;
apiDB.uqSaveTimeEntry.ParamByName('TASK_DATE').AsDateTime := taskDateValue;
apiDB.uqSaveTimeEntry.ParamByName('TASK_ID').AsString := Item.taskId;
apiDB.uqSaveTimeEntry.ParamByName('HOURS').AsFloat := Item.hours;
if Trim(Item.taskTime) = '' then
apiDB.uqSaveTimeEntry.ParamByName('TASK_TIME').Clear
else
apiDB.uqSaveTimeEntry.ParamByName('TASK_TIME').AsString := Item.taskTime;
if Trim(Item.place) = '' then
apiDB.uqSaveTimeEntry.ParamByName('PLACE').Clear
else
apiDB.uqSaveTimeEntry.ParamByName('PLACE').AsString := Item.place;
apiDB.uqSaveTimeEntry.ParamByName('CATEGORY').AsString := Item.category;
apiDB.uqSaveTimeEntry.ParamByName('SUMMARY').AsString := Item.summary;
apiDB.uqSaveTimeEntry.ParamByName('MODIFIED_BY').AsString := Item.userId;
apiDB.uqSaveTimeEntry.ExecSQL;
end;
Result := entryId;
Logger.Log(4, 'TimeEntryService.SaveTimeEntry - saved ENTRY_ID=' + Result);
end;
function TTimeEntryService.SaveTimeEntryField(Item: TTimeEntryFieldSave): Boolean;
var
uqSaveField: TUniQuery;
columnName: string;
d: TDateTime;
function MapFieldNameToColumn(AFieldName: string): string;
begin
Result := '';
if SameText(AFieldName, 'taskDate') then
Result := 'TASK_DATE'
else if SameText(AFieldName, 'hours') then
Result := 'HOURS'
else if SameText(AFieldName, 'taskTime') then
Result := 'TASK_TIME'
else if SameText(AFieldName, 'place') then
Result := 'PLACE'
else if SameText(AFieldName, 'category') then
Result := 'CATEGORY'
else if SameText(AFieldName, 'summary') then
Result := 'SUMMARY';
end;
function ParseDateOrZero(const S: string; out ADate: TDateTime): Boolean;
var
y: Integer;
m: Integer;
dInt: Integer;
begin
Result := False;
ADate := 0;
if Length(Trim(S)) <> 10 then
Exit;
y := StrToIntDef(Copy(S, 1, 4), 0);
m := StrToIntDef(Copy(S, 6, 2), 0);
dInt := StrToIntDef(Copy(S, 9, 2), 0);
if (y > 0) and (m > 0) and (dInt > 0) then
begin
try
ADate := EncodeDate(y, m, dInt);
Result := True;
except
Result := False;
end;
end;
end;
begin
Result := False;
if not Assigned(Item) then
raise Exception.Create('SaveTimeEntryField: Item is nil.');
if Item.entryId <= 0 then
raise Exception.Create('SaveTimeEntryField: Invalid entryId.');
if Trim(Item.userId) = '' then
raise Exception.Create('SaveTimeEntryField: Invalid userId.');
uqSaveField := TUniQuery.Create(nil);
try
uqSaveField.Connection := apiDB.ucETaskApi;
if SameText(Item.fieldName, 'taskId') then
begin
if Trim(Item.value) = '' then
begin
uqSaveField.SQL.Text :=
'update time_items ' +
'set TASK_ID = null, ' +
' PROJECT_ID = null, ' +
' MODIFY_DATE = now(), ' +
' MODIFIED_BY = :MODIFIED_BY ' +
'where ENTRY_ID = :ENTRY_ID ' +
' and USER_ID = :USER_ID';
end
else
begin
uqSaveField.SQL.Text :=
'update time_items ' +
'set TASK_ID = :TASK_ID, ' +
' PROJECT_ID = ( ' +
' select t.PROJECT_ID ' +
' from tasks t ' +
' where t.TASK_ID = :TASK_ID ' +
' ), ' +
' MODIFY_DATE = now(), ' +
' MODIFIED_BY = :MODIFIED_BY ' +
'where ENTRY_ID = :ENTRY_ID ' +
' and USER_ID = :USER_ID';
uqSaveField.ParamByName('TASK_ID').AsString := Item.value;
end;
end
else
begin
columnName := MapFieldNameToColumn(Item.fieldName);
if columnName = '' then
raise Exception.Create('SaveTimeEntryField: Invalid field name: ' + Item.fieldName);
uqSaveField.SQL.Text :=
'update time_items ' +
'set ' + columnName + ' = :' + columnName + ', ' +
' MODIFY_DATE = now(), ' +
' MODIFIED_BY = :MODIFIED_BY ' +
'where ENTRY_ID = :ENTRY_ID ' +
' and USER_ID = :USER_ID';
if SameText(Item.fieldName, 'taskDate') then
begin
if ParseDateOrZero(Item.value, d) then
uqSaveField.ParamByName(columnName).AsDateTime := d
else
uqSaveField.ParamByName(columnName).Clear;
end
else if SameText(Item.fieldName, 'hours') then
begin
if Trim(Item.value) = '' then
uqSaveField.ParamByName(columnName).Clear
else
uqSaveField.ParamByName(columnName).AsFloat := StrToFloatDef(Item.value, 0);
end
else
begin
if Trim(Item.value) = '' then
uqSaveField.ParamByName(columnName).Clear
else
uqSaveField.ParamByName(columnName).AsString := Item.value;
end;
end;
uqSaveField.ParamByName('ENTRY_ID').AsInteger := Item.entryId;
uqSaveField.ParamByName('USER_ID').AsString := Item.userId;
uqSaveField.ParamByName('MODIFIED_BY').AsString := Item.userId;
uqSaveField.ExecSQL;
Result := True;
Logger.Log(4, Format(
'TimeEntryService.SaveTimeEntryField - ENTRY_ID="%d" FIELD="%s"',
[Item.entryId, Item.fieldName]
));
finally
uqSaveField.Free;
end;
end;
function TTimeEntryService.GetTaskPickerCustomers(userId: string): TTaskPickerOptionsResponse;
begin
Logger.Log(4, Format('TimeEntryService.GetTaskPickerCustomers - USER_ID="%s"', [userId]));
Result := TTaskPickerOptionsResponse.Create;
TXDataOperationContext.Current.Handler.ManagedObjects.Add(Result);
apiDB.uqTaskPickerCustomers.Close;
apiDB.uqTaskPickerCustomers.ParamByName('USER_ID').AsString := userId;
apiDB.uqTaskPickerCustomers.Open;
try
while not apiDB.uqTaskPickerCustomers.Eof do
begin
AddTaskPickerOption(
Result,
FieldText(apiDB.uqTaskPickerCustomers, 'CUSTOMER_ID'),
FieldText(apiDB.uqTaskPickerCustomers, 'CUSTOMER_SHORT_NAME')
);
apiDB.uqTaskPickerCustomers.Next;
end;
finally
apiDB.uqTaskPickerCustomers.Close;
end;
end;
function TTimeEntryService.GetTaskPickerProjects(userId, customerId: string): TTaskPickerOptionsResponse;
begin
Logger.Log(4, Format('TimeEntryService.GetTaskPickerProjects - USER_ID="%s" CUSTOMER_ID="%s"', [userId, customerId]));
Result := TTaskPickerOptionsResponse.Create;
TXDataOperationContext.Current.Handler.ManagedObjects.Add(Result);
apiDB.uqTaskPickerProjects.Close;
apiDB.uqTaskPickerProjects.ParamByName('USER_ID').AsString := userId;
apiDB.uqTaskPickerProjects.ParamByName('CUSTOMER_ID').AsString := customerId;
apiDB.uqTaskPickerProjects.Open;
try
while not apiDB.uqTaskPickerProjects.Eof do
begin
AddTaskPickerOption(
Result,
FieldText(apiDB.uqTaskPickerProjects, 'PROJECT_ID'),
FieldText(apiDB.uqTaskPickerProjects, 'PROJECT_NAME')
);
apiDB.uqTaskPickerProjects.Next;
end;
finally
apiDB.uqTaskPickerProjects.Close;
end;
end;
function TTimeEntryService.GetTaskPickerTasks(userId, projectId: string): TTaskPickerOptionsResponse;
begin
Logger.Log(4, Format('TimeEntryService.GetTaskPickerTasks - USER_ID="%s" PROJECT_ID="%s"', [userId, projectId]));
Result := TTaskPickerOptionsResponse.Create;
TXDataOperationContext.Current.Handler.ManagedObjects.Add(Result);
apiDB.uqTaskPickerTasks.Close;
apiDB.uqTaskPickerTasks.ParamByName('USER_ID').AsString := userId;
apiDB.uqTaskPickerTasks.ParamByName('PROJECT_ID').AsString := projectId;
apiDB.uqTaskPickerTasks.Open;
try
while not apiDB.uqTaskPickerTasks.Eof do
begin
AddTaskPickerOption(
Result,
FieldText(apiDB.uqTaskPickerTasks, 'TASK_ID'),
BuildTaskDisplay(apiDB.uqTaskPickerTasks)
);
apiDB.uqTaskPickerTasks.Next;
end;
finally
apiDB.uqTaskPickerTasks.Close;
end;
end;
function TTimeEntryService.DeleteTimeEntry(userId: string; entryId: Integer): Boolean;
var
q: TUniQuery;
begin
Result := False;
if Trim(userId) = '' then
raise Exception.Create('DeleteTimeEntry: Invalid userId.');
if entryId <= 0 then
raise Exception.Create('DeleteTimeEntry: Invalid entryId.');
Logger.Log(4, Format(
'TimeEntryService.DeleteTimeEntry - USER_ID="%s" ENTRY_ID="%d"',
[userId, entryId]
));
q := TUniQuery.Create(nil);
try
q.Connection := apiDB.ucETaskApi;
q.SQL.Text :=
'delete from time_items ' +
'where ENTRY_ID = :ENTRY_ID ' +
' and USER_ID = :USER_ID';
q.ParamByName('ENTRY_ID').AsInteger := entryId;
q.ParamByName('USER_ID').AsString := userId;
q.ExecSQL;
if q.RowsAffected <= 0 then
raise Exception.Create('Time entry was not found or does not belong to this user.');
Result := True;
Logger.Log(4, Format(
'TimeEntryService.DeleteTimeEntry - deleted ENTRY_ID="%d"',
[entryId]
));
finally
q.Free;
end;
end;
initialization
RegisterServiceType(TTimeEntryService);
end.
object AuthDatabase: TAuthDatabase
OnCreate = DataModuleCreate
OnDestroy = DataModuleDestroy
Height = 207
Width = 303
object uqWebTasksUrl: TUniQuery
Connection = ucETaskAuth
SQL.Strings = (
'select'
' u.USER_ID,'
' u.USER_NAME,'
' u.NAME,'
' u.STATUS,'
' u.EMAIL,'
' u.ACCESS_LEVEL,'
' u.TASK_RIGHTS,'
' u.PERSPECTIVE_ID,'
' u.LAST_NAME,'
' u.FIRST_NAME,'
' w.URL_TIME,'
' w.URL_TIME_EXP'
'from web_tasks_url w'
'join users u on u.USER_ID = w.USER_ID'
'where w.USER_ID = :USER_ID'
' and w.TASK_ID = :TASK_ID'
' and w.URL_CODE = :URL_CODE'
' and TIMESTAMPDIFF(SECOND, w.URL_TIME, NOW()) between 0 and w.U' +
'RL_TIME_EXP'
'order by w.URL_TIME desc'
'limit 1')
FetchRows = 100
Left = 78
Top = 43
ParamData = <
item
DataType = ftUnknown
Name = 'USER_ID'
Value = nil
end
item
DataType = ftUnknown
Name = 'TASK_ID'
Value = nil
end
item
DataType = ftUnknown
Name = 'URL_CODE'
Value = nil
end>
object uqWebTasksUrlUSER_ID: TStringField
FieldName = 'USER_ID'
Required = True
Size = 7
end
object uqWebTasksUrlUSER_NAME: TStringField
FieldName = 'USER_NAME'
Required = True
Size = 12
end
object uqWebTasksUrlNAME: TStringField
FieldName = 'NAME'
Size = 40
end
object uqWebTasksUrlSTATUS: TStringField
FieldName = 'STATUS'
Size = 7
end
object uqWebTasksUrlEMAIL: TStringField
FieldName = 'EMAIL'
Size = 50
end
object uqWebTasksUrlACCESS_LEVEL: TIntegerField
FieldName = 'ACCESS_LEVEL'
end
object uqWebTasksUrlTASK_RIGHTS: TIntegerField
FieldName = 'TASK_RIGHTS'
end
object uqWebTasksUrlPERSPECTIVE_ID: TStringField
FieldName = 'PERSPECTIVE_ID'
Size = 45
end
object uqWebTasksUrlLAST_NAME: TStringField
FieldName = 'LAST_NAME'
Size = 35
end
object uqWebTasksUrlFIRST_NAME: TStringField
FieldName = 'FIRST_NAME'
Size = 25
end
object uqWebTasksUrlURL_TIME: TDateTimeField
FieldName = 'URL_TIME'
ReadOnly = True
Required = True
end
object uqWebTasksUrlURL_TIME_EXP: TIntegerField
FieldName = 'URL_TIME_EXP'
ReadOnly = True
Required = True
end
end
object ucETaskAuth: TUniConnection
ProviderName = 'MySQL'
Database = 'eTask'
Username = 'root'
Server = '192.168.102.131'
Connected = True
LoginPrompt = False
Left = 69
Top = 133
EncryptedPassword = '9AFF92FF8CFF86FF8CFFCFFFCEFF'
end
object MySQLUniProvider1: TMySQLUniProvider
Left = 194
Top = 132
end
object uqWebLogin: TUniQuery
Connection = ucETaskAuth
SQL.Strings = (
'select'
' u.USER_ID,'
' u.USER_NAME,'
' u.NAME,'
' u.STATUS,'
' u.EMAIL,'
' u.ACCESS_LEVEL,'
' u.TASK_RIGHTS,'
' u.PERSPECTIVE_ID,'
' u.LAST_NAME,'
' u.FIRST_NAME,'
' w.WEB_LOGIN'
'from web_tasks_url w'
'join users u on u.USER_ID = w.USER_ID'
'where w.USER_ID = :USER_ID'
' and w.TASK_ID = :TASK_ID'
' and u.PASSWORD = :PASSWORD')
Left = 192
Top = 44
ParamData = <
item
DataType = ftUnknown
Name = 'USER_ID'
Value = nil
end
item
DataType = ftUnknown
Name = 'TASK_ID'
Value = nil
end
item
DataType = ftUnknown
Name = 'PASSWORD'
Value = nil
end>
object uqWebLoginUSER_ID: TStringField
FieldName = 'USER_ID'
Required = True
Size = 7
end
object uqWebLoginUSER_NAME: TStringField
FieldName = 'USER_NAME'
Required = True
Size = 12
end
object uqWebLoginNAME: TStringField
FieldName = 'NAME'
Size = 40
end
object uqWebLoginSTATUS: TStringField
FieldName = 'STATUS'
Size = 7
end
object uqWebLoginEMAIL: TStringField
FieldName = 'EMAIL'
Size = 50
end
object uqWebLoginACCESS_LEVEL: TIntegerField
FieldName = 'ACCESS_LEVEL'
end
object uqWebLoginTASK_RIGHTS: TIntegerField
FieldName = 'TASK_RIGHTS'
end
object uqWebLoginPERSPECTIVE_ID: TStringField
FieldName = 'PERSPECTIVE_ID'
Size = 45
end
object uqWebLoginLAST_NAME: TStringField
FieldName = 'LAST_NAME'
Size = 35
end
object uqWebLoginFIRST_NAME: TStringField
FieldName = 'FIRST_NAME'
Size = 25
end
object uqWebLoginWEB_LOGIN: TStringField
FieldName = 'WEB_LOGIN'
ReadOnly = True
Required = True
FixedChar = True
Size = 1
end
end
end
// Auth Database to verify logins
unit Auth.Database;
interface
uses
System.SysUtils, System.Classes, IniFiles, Vcl.Forms, MemDS,
Data.DB, DBAccess, Uni, UniProvider, PostgreSQLUniProvider, MySQLUniProvider;
type
TAuthDatabase = class(TDataModule)
uqWebTasksUrl: TUniQuery;
ucETaskAuth: TUniConnection;
MySQLUniProvider1: TMySQLUniProvider;
uqWebTasksUrlUSER_ID: TStringField;
uqWebTasksUrlUSER_NAME: TStringField;
uqWebTasksUrlNAME: TStringField;
uqWebTasksUrlSTATUS: TStringField;
uqWebTasksUrlEMAIL: TStringField;
uqWebTasksUrlACCESS_LEVEL: TIntegerField;
uqWebTasksUrlTASK_RIGHTS: TIntegerField;
uqWebTasksUrlPERSPECTIVE_ID: TStringField;
uqWebTasksUrlLAST_NAME: TStringField;
uqWebTasksUrlFIRST_NAME: TStringField;
uqWebTasksUrlURL_TIME: TDateTimeField;
uqWebTasksUrlURL_TIME_EXP: TIntegerField;
uqWebLogin: TUniQuery;
uqWebLoginUSER_ID: TStringField;
uqWebLoginUSER_NAME: TStringField;
uqWebLoginNAME: TStringField;
uqWebLoginSTATUS: TStringField;
uqWebLoginEMAIL: TStringField;
uqWebLoginACCESS_LEVEL: TIntegerField;
uqWebLoginTASK_RIGHTS: TIntegerField;
uqWebLoginPERSPECTIVE_ID: TStringField;
uqWebLoginLAST_NAME: TStringField;
uqWebLoginFIRST_NAME: TStringField;
uqWebLoginWEB_LOGIN: TStringField;
procedure DataModuleCreate(Sender: TObject);
procedure DataModuleDestroy(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
AuthDatabase: TAuthDatabase;
implementation
uses
System.JSON,
Common.Config,
Common.Logging,
uLibrary;
{%CLASSGROUP 'Vcl.Controls.TControl'}
{$R *.dfm}
procedure TAuthDatabase.DataModuleCreate(Sender: TObject);
begin
Logger.Log( 5, 'TAuthDatabase.DataModuleCreate' );
LoadDatabaseSettings( ucETaskAuth, 'emT3XDataServer.ini' );
try
ucETaskAuth.Connect;
except
on E: Exception do
begin
Logger.Log(2, '--TAuthDatabase.DataModuleCreate -Error connecting to database: ' + E.Message);
end;
end;
end;
procedure TAuthDatabase.DataModuleDestroy(Sender: TObject);
begin
ucETaskAuth.Connected := false;
end;
end.
unit Auth.ServiceImpl;
interface
uses
XData.Service.Common,
XData.Server.Module,
Auth.Service,
Auth.Database,
Uni, Data.DB, System.Hash, System.IniFiles, System.JSON;
type
[ServiceImplementation]
TAuthService = class(TInterfacedObject, IAuthService)
strict private
authDB: TAuthDatabase;
userId: string;
userName: string;
userFullName: string;
userStatus: string;
userEmail: string;
userAccessLevel: string;
userTaskRights: string;
userPerspectiveId: string;
userFirstName: string;
userLastName: string;
procedure AfterConstruction; override;
procedure BeforeDestruction; override;
function CheckUrlLogin(const userId, taskId, urlCode: string): Integer;
procedure LoadUserFromUrlLoginQuery;
public
function Login(const userId, taskId, urlCode: string): string;
function VerifyVersion(ClientVersion: string): TJSONObject;
function WebLogin(const userId, taskId, password: string): string;
function CheckWebLogin(const userId, taskId, password: string): Integer;
procedure LoadUserFromWebLoginQuery;
end;
implementation
uses
System.SysUtils,
System.DateUtils,
Bcl.JOSE.Core.Builder,
Bcl.JOSE.Core.JWT,
Aurelius.Global.Utils,
XData.Sys.Exceptions,
Common.Logging,
Common.Config;
procedure TAuthService.AfterConstruction;
begin
inherited;
try
authDB := TAuthDatabase.Create(nil);
except
on E: Exception do
begin
Logger.Log(1, 'Error when creating the Auth database: ' + E.Message);
raise EXDataHttpException.Create(500, 'Unable to create Auth database: A Server Error has occured!');
end;
end;
end;
procedure TAuthService.BeforeDestruction;
begin
authDB.Free;
inherited;
end;
function TAuthService.VerifyVersion(ClientVersion: string): TJSONObject;
var
iniFile: TIniFile;
webClientVersion: string;
begin
Result := TJSONObject.Create;
TXDataOperationContext.Current.Handler.ManagedObjects.Add(Result);
iniFile := TIniFile.Create(ChangeFileExt(ParamStr(0), '.ini'));
try
webClientVersion := iniFile.ReadString('Settings', 'webClientVersion', '');
Result.AddPair('webClientVersion', webClientVersion);
if webClientVersion = '' then
begin
Result.AddPair('error', 'webClientVersion is not configured.');
Exit;
end;
if ClientVersion <> webClientVersion then
begin
Result.AddPair('error',
'Your browser is running an old version of the app.' + sLineBreak +
'Please click button to reload.' + sLineBreak + sLineBreak +
'If error continues, empty cache and hard reload.');
end;
finally
iniFile.Free;
end;
end;
function TAuthService.CheckUrlLogin(const userId, taskId, urlCode: string): Integer;
var
sql: string;
timeNow: TDateTime;
timeDiff: integer;
begin
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.SQL.Text := sql;
authDB.uqWebTasksUrl.ParamByName('USER_ID').AsString := userId;
authDB.uqWebTasksUrl.ParamByName('TASK_ID').AsString := taskId;
authDB.uqWebTasksUrl.ParamByName('URL_CODE').AsString := urlCode;
authDB.uqWebTasksUrl.Open;
if authDB.uqWebTasksUrl.IsEmpty then
begin
Logger.Log(3, '--URL Login failed 0: authDB.uqWebTasksUrl.IsEmpty');
Result := 0;
Exit;
end;
if authDB.uqWebTasksUrlSTATUS.AsString <> 'ACTIVE' then
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;
Exit;
end;
LoadUserFromUrlLoginQuery;
Result := 3;
end;
procedure TAuthService.LoadUserFromUrlLoginQuery;
var
nameValue: string;
begin
Self.userId := authDB.uqWebTasksUrl.FieldByName('USER_ID').AsString;
userName := authDB.uqWebTasksUrl.FieldByName('USER_NAME').AsString;
userStatus := authDB.uqWebTasksUrl.FieldByName('STATUS').AsString;
userEmail := authDB.uqWebTasksUrl.FieldByName('EMAIL').AsString;
userAccessLevel := authDB.uqWebTasksUrl.FieldByName('ACCESS_LEVEL').AsString;
userTaskRights := authDB.uqWebTasksUrl.FieldByName('TASK_RIGHTS').AsString;
userPerspectiveId := authDB.uqWebTasksUrl.FieldByName('PERSPECTIVE_ID').AsString;
userLastName := authDB.uqWebTasksUrl.FieldByName('LAST_NAME').AsString;
userFirstName := authDB.uqWebTasksUrl.FieldByName('FIRST_NAME').AsString;
nameValue := Trim(authDB.uqWebTasksUrl.FieldByName('NAME').AsString);
if nameValue <> '' then
userFullName := nameValue
else
userFullName := Trim(userFirstName + ' ' + userLastName);
end;
function TAuthService.Login(const userId, taskId, urlCode: string): string;
var
userState: Integer;
jwt: TJWT;
begin
Logger.Log(3, Format('AuthService.Login - UserID: "%s", TaskID: "%s", Code: "%s"', [userId, taskId, urlCode]));
try
userState := CheckUrlLogin(userId, taskId, urlCode);
except
on E: Exception do
begin
Logger.Log(1, 'URL Login failed due to database error: ' + E.Message);
raise EXDataHttpException.Create(500, 'Login failed: Unable to connect to the database.');
end;
end;
if userState = 0 then
begin
Logger.Log(2, 'Login Error: Invalid url parameters');
raise EXDataHttpUnauthorized.Create('Invalid url parameters');
end;
if userState = 1 then
begin
Logger.Log(2, 'Login Error: User not active!');
raise EXDataHttpUnauthorized.Create('User not active!');
end;
if userState = 2 then
begin
Logger.Log(2, 'Login Error: Expired link');
raise EXDataHttpUnauthorized.Create('Expired link');
end;
jwt := TJWT.Create;
try
jwt.Claims.JWTId := LowerCase(Copy(TUtils.GuidToVariant(TUtils.NewGuid), 2, 36));
jwt.Claims.IssuedAt := Now;
jwt.Claims.Expiration := IncHour(Now, 12);
jwt.Claims.SetClaimOfType<string>('user_id', Self.userId);
jwt.Claims.SetClaimOfType<string>('user_name', userName);
jwt.Claims.SetClaimOfType<string>('user_fullname', userFullName);
jwt.Claims.SetClaimOfType<string>('user_status', userStatus);
jwt.Claims.SetClaimOfType<string>('user_email', userEmail);
jwt.Claims.SetClaimOfType<string>('user_access_level', userAccessLevel);
jwt.Claims.SetClaimOfType<string>('task_rights', userTaskRights);
jwt.Claims.SetClaimOfType<string>('user_perspective_id', userPerspectiveId);
jwt.Claims.SetClaimOfType<string>('first_name', userFirstName);
jwt.Claims.SetClaimOfType<string>('last_name', userLastName);
Result := TJOSE.SHA256CompactToken(serverConfig.jwtTokenSecret, jwt);
finally
jwt.Free;
end;
end;
function TAuthService.CheckWebLogin(const userId, taskId, password: string): Integer;
var
sql: string;
begin
Logger.Log(3, 'TAuthService.CheckWebLogin(const userId, taskId, password: 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.WEB_LOGIN ';
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 u.PASSWORD = :PASSWORD ';
authDB.uqWebLogin.Close;
authDB.uqWebLogin.SQL.Text := sql;
authDB.uqWebLogin.ParamByName('USER_ID').AsString := userId;
authDB.uqWebLogin.ParamByName('TASK_ID').AsString := taskId;
authDB.uqWebLogin.ParamByName('PASSWORD').AsString := password;
authDB.uqWebLogin.Open;
if authDB.uqWebLogin.IsEmpty then
begin
Logger.Log(3, '--Web Login failed 0: authDB.uqWebLogin.IsEmpty');
Result := 0;
Exit;
end;
if authDB.uqWebLoginSTATUS.AsString <> 'ACTIVE' then
begin
Logger.Log(3, '--Web Login failed 1: authDB.uqWebLoginSTATUS.AsString <> ACTIVE');
Result := 1;
Exit;
end;
if authDB.uqWebLoginWEB_LOGIN.AsString <> 'T' then
begin
Logger.Log(3, '--Web Login failed 2: WEB_LOGIN <> T');
Result := 2;
Exit;
end;
LoadUserFromWebLoginQuery;
Result := 3;
end;
procedure TAuthService.LoadUserFromWebLoginQuery;
var
nameValue: string;
begin
Self.userId := authDB.uqWebLoginUSER_ID.AsString;
userName := authDB.uqWebLoginUSER_NAME.AsString;
userStatus := authDB.uqWebLoginSTATUS.AsString;
userEmail := authDB.uqWebLoginEMAIL.AsString;
userAccessLevel := authDB.uqWebLoginACCESS_LEVEL.AsString;
userTaskRights := authDB.uqWebLoginTASK_RIGHTS.AsString;
userPerspectiveId := authDB.uqWebLoginPERSPECTIVE_ID.AsString;
userLastName := authDB.uqWebLoginLAST_NAME.AsString;
userFirstName := authDB.uqWebLoginFIRST_NAME.AsString;
nameValue := Trim(authDB.uqWebLoginNAME.AsString);
if nameValue <> '' then
userFullName := nameValue
else
userFullName := Trim(userFirstName + ' ' + userLastName);
end;
function TAuthService.WebLogin(const userId, taskId, password: string): string;
var
userState: Integer;
jwt: TJWT;
begin
Logger.Log(3, Format('AuthService.WebLogin - UserID: "%s", TaskID: "%s"', [userId, taskId]));
try
userState := CheckWebLogin(userId, taskId, password);
except
on E: Exception do
begin
Logger.Log(1, 'Web Login failed due to database error: ' + E.Message);
raise EXDataHttpException.Create(500, 'Login failed: Unable to connect to the database.');
end;
end;
if userState = 0 then
begin
Logger.Log(2, 'Web Login Error: Invalid user id or password');
raise EXDataHttpUnauthorized.Create('Invalid user id or password');
end;
if userState = 1 then
begin
Logger.Log(2, 'Web Login Error: User not active!');
raise EXDataHttpUnauthorized.Create('User not active!');
end;
if userState = 2 then
begin
Logger.Log(2, 'Web Login Error: Web login is not enabled for this task');
raise EXDataHttpUnauthorized.Create('Web login is not enabled for this task');
end;
jwt := TJWT.Create;
try
jwt.Claims.JWTId := LowerCase(Copy(TUtils.GuidToVariant(TUtils.NewGuid), 2, 36));
jwt.Claims.IssuedAt := Now;
jwt.Claims.Expiration := IncHour(Now, 12);
jwt.Claims.SetClaimOfType<string>('user_id', Self.userId);
jwt.Claims.SetClaimOfType<string>('user_name', userName);
jwt.Claims.SetClaimOfType<string>('user_fullname', userFullName);
jwt.Claims.SetClaimOfType<string>('user_status', userStatus);
jwt.Claims.SetClaimOfType<string>('user_email', userEmail);
jwt.Claims.SetClaimOfType<string>('user_access_level', userAccessLevel);
jwt.Claims.SetClaimOfType<string>('task_rights', userTaskRights);
jwt.Claims.SetClaimOfType<string>('user_perspective_id', userPerspectiveId);
jwt.Claims.SetClaimOfType<string>('first_name', userFirstName);
jwt.Claims.SetClaimOfType<string>('last_name', userLastName);
Result := TJOSE.SHA256CompactToken(serverConfig.jwtTokenSecret, jwt);
finally
jwt.Free;
end;
end;
initialization
RegisterServiceType(TAuthService);
end.
[Auth.ServiceImpl.pas]
SaveTime=4/15/2026 6:21:59 PM
FileCount=1
File0=C:\Projects\emT3web\emT3XDataServer\Source\Auth.ServiceImpl.pas
[Auth.Database.pas]
SaveTime=4/15/2026 6:21:59 PM
FileCount=2
File0=C:\Projects\emT3web\emT3XDataServer\Source\Auth.Database.pas
File1=C:\Projects\emT3web\emT3XDataServer\Source\Auth.Database.dfm
[Settings]
MemoLogLevel=4
FileLogLevel=4
webClientVersion=0.8.8
LogFileNum=161
webClientVersion=0.9.3
LogFileNum=245
[Database]
Server=192.168.102.131
--Server=192.168.116.128
--Server=192.168.102.131
Server=192.168.102.133
--Server=192.168.116.131
--Server=192.168.159.10
Database=eTask
Username=root
......
......@@ -20,9 +20,11 @@ uses
Auth.Service in 'Source\Auth.Service.pas',
Auth.ServiceImpl in 'Source\Auth.ServiceImpl.pas',
App.Server.Module in 'Source\App.Server.Module.pas' {AppServerModule: TDataModule},
Api.Service in 'Source\Api.Service.pas',
Api.ServiceImpl in 'Source\Api.ServiceImpl.pas',
Common.Ini in 'Source\Common.Ini.pas';
TaskItem.Service in 'Source\TaskItem.Service.pas',
TaskItem.ServiceImpl in 'Source\TaskItem.ServiceImpl.pas',
Common.Ini in 'Source\Common.Ini.pas',
TimeEntry.Service in 'Source\TimeEntry.Service.pas',
TimeEntry.ServiceImpl in 'Source\TimeEntry.ServiceImpl.pas';
type
TMemoLogAppender = class( TInterfacedObject, ILogAppender )
......
......@@ -114,10 +114,12 @@
<VerInfo_Locale>1033</VerInfo_Locale>
<DCC_ExeOutput>.\bin</DCC_ExeOutput>
<DCC_UnitSearchPath>C:\RADTOOLS\FastMM4;$(DCC_UnitSearchPath)</DCC_UnitSearchPath>
<VerInfo_Keys>CompanyName=EM Systems;FileDescription=$(MSBuildProjectName);FileVersion=0.8.8.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.9.3.1;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=0.9.11;Comments=</VerInfo_Keys>
<VerInfo_MajorVer>0</VerInfo_MajorVer>
<VerInfo_MinorVer>8</VerInfo_MinorVer>
<VerInfo_Release>8</VerInfo_Release>
<VerInfo_MinorVer>9</VerInfo_MinorVer>
<VerInfo_AutoIncVersion>true</VerInfo_AutoIncVersion>
<VerInfo_Build>1</VerInfo_Build>
<VerInfo_Release>3</VerInfo_Release>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_1_Win64)'!=''">
<AppDPIAwarenessMode>PerMonitorV2</AppDPIAwarenessMode>
......@@ -175,9 +177,11 @@
<Form>AppServerModule</Form>
<DesignClass>TDataModule</DesignClass>
</DCCReference>
<DCCReference Include="Source\Api.Service.pas"/>
<DCCReference Include="Source\Api.ServiceImpl.pas"/>
<DCCReference Include="Source\TaskItem.Service.pas"/>
<DCCReference Include="Source\TaskItem.ServiceImpl.pas"/>
<DCCReference Include="Source\Common.Ini.pas"/>
<DCCReference Include="Source\TimeEntry.Service.pas"/>
<DCCReference Include="Source\TimeEntry.ServiceImpl.pas"/>
<BuildConfiguration Include="Base">
<Key>Base</Key>
</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