Commit 21727feb by Mac Stephens

Merge branch 'dev'

parents cdb35e6e 68ac3ea9
...@@ -4,11 +4,14 @@ emT3VCLDemo/Win64x/ ...@@ -4,11 +4,14 @@ emT3VCLDemo/Win64x/
emT3Web/__history/ emT3Web/__history/
emT3Web/__recovery/ emT3Web/__recovery/
emT3Web/config/ emT3Web/config/
emT3Web/css/__history/
emT3Web/Win32/ emT3Web/Win32/
emT3XDataServer/__history/ emT3XDataServer/__history/
emT3XDataServer/__recovery/
emT3XDataServer/bin/logs/ emT3XDataServer/bin/logs/
emT3XDataServer/bin/static/ emT3XDataServer/bin/static/
emT3XDataServer/Source/__history/ emT3XDataServer/Source/__history/
emT3XDataServer/Source/__recovery/
emT3XDataServer/Win32/ emT3XDataServer/Win32/
*.exe *.exe
...@@ -19,6 +22,3 @@ emT3XDataServer/Win32/ ...@@ -19,6 +22,3 @@ emT3XDataServer/Win32/
*.tvsconfig *.tvsconfig
*.txt *.txt
*.zip *.zip
emT3Web/css/__history/
...@@ -184,13 +184,13 @@ ...@@ -184,13 +184,13 @@
<BuildOrder>1</BuildOrder> <BuildOrder>1</BuildOrder>
<PCH>true</PCH> <PCH>true</PCH>
</PCHCompile> </PCHCompile>
<CppCompile Include="uMain.cpp"> <CppCompile Include="fMain.cpp">
<Form>fMain</Form> <Form>frmMain</Form>
<FormType>dfm</FormType> <FormType>dfm</FormType>
<DependentOn>uMain.h</DependentOn> <DependentOn>fMain.h</DependentOn>
<BuildOrder>2</BuildOrder> <BuildOrder>2</BuildOrder>
</CppCompile> </CppCompile>
<FormResources Include="uMain.dfm"/> <FormResources Include="fMain.dfm"/>
<BuildConfiguration Include="Base"> <BuildConfiguration Include="Base">
<Key>Base</Key> <Key>Base</Key>
</BuildConfiguration> </BuildConfiguration>
......
...@@ -4,7 +4,7 @@ ...@@ -4,7 +4,7 @@
#pragma hdrstop #pragma hdrstop
#include <tchar.h> #include <tchar.h>
//--------------------------------------------------------------------------- //---------------------------------------------------------------------------
USEFORM("uMain.cpp", fMain); USEFORM("fMain.cpp", frmMain);
//--------------------------------------------------------------------------- //---------------------------------------------------------------------------
int WINAPI _tWinMain(HINSTANCE, HINSTANCE, LPTSTR, int) int WINAPI _tWinMain(HINSTANCE, HINSTANCE, LPTSTR, int)
{ {
...@@ -12,7 +12,7 @@ int WINAPI _tWinMain(HINSTANCE, HINSTANCE, LPTSTR, int) ...@@ -12,7 +12,7 @@ int WINAPI _tWinMain(HINSTANCE, HINSTANCE, LPTSTR, int)
{ {
Application->Initialize(); Application->Initialize();
Application->MainFormOnTaskBar = true; Application->MainFormOnTaskBar = true;
Application->CreateForm(__classid(TfMain), &fMain); Application->CreateForm(__classid(TfrmMain), &frmMain);
Application->Run(); Application->Run();
} }
catch (Exception &exception) catch (Exception &exception)
......
...@@ -5,33 +5,35 @@ ...@@ -5,33 +5,35 @@
#include <System.NetEncoding.hpp> #include <System.NetEncoding.hpp>
#pragma hdrstop #pragma hdrstop
#include "uMain.h" #include "fMain.h"
//--------------------------------------------------------------------------- //---------------------------------------------------------------------------
#pragma package(smart_init) #pragma package(smart_init)
#pragma link "MySQLUniProvider" #pragma link "MySQLUniProvider"
#pragma link "UniProvider" #pragma link "UniProvider"
#pragma resource "*.dfm" #pragma resource "*.dfm"
TfMain *fMain; TfrmMain *frmMain;
//--------------------------------------------------------------------------- //---------------------------------------------------------------------------
__fastcall TfMain::TfMain(TComponent* Owner) __fastcall TfrmMain::TfrmMain(TComponent* Owner)
: TForm(Owner) : TForm(Owner)
{ {
} }
//--------------------------------------------------------------------------- //---------------------------------------------------------------------------
void __fastcall TfrmMain::FormCreate(TObject *Sender)
void __fastcall TfMain::FormCreate(TObject *Sender)
{ {
Randomize(); 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 TfrmMain::btnOpenTaskItemsClick(TObject *Sender)
void __fastcall TfMain::btnOpenTaskItemsClick(TObject *Sender)
{ {
const UnicodeString userId = edtUserId->Text.Trim(); String userId = edtUserId->Text.Trim();
const UnicodeString taskId = edtTaskId->Text.Trim(); String taskId = edtTaskId->Text.Trim();
const UnicodeString baseUrl = edtWebUrl->Text.Trim(); String baseUrl = edtWebUrl->Text.Trim();
const int expSeconds = StrToIntDef(edtExpSeconds->Text.Trim(), 60); int expSeconds = StrToIntDef(edtExpSeconds->Text.Trim(), 5);
if (userId.IsEmpty() || taskId.IsEmpty() || baseUrl.IsEmpty()) if (userId.IsEmpty() || taskId.IsEmpty() || baseUrl.IsEmpty())
{ {
...@@ -39,14 +41,14 @@ void __fastcall TfMain::btnOpenTaskItemsClick(TObject *Sender) ...@@ -39,14 +41,14 @@ void __fastcall TfMain::btnOpenTaskItemsClick(TObject *Sender)
return; return;
} }
const int codeInt = 100000 + Random(900000); int codeInt = 100000 + Random(900000);
const UnicodeString urlCode = IntToStr(codeInt); String urlCode = IntToStr(codeInt);
LogLine("Generated URL_CODE=" + urlCode); LogLine("Generated URL_CODE=" + urlCode);
try try
{ {
if (!ucETask->Connected) if( !ucETask->Connected )
{ {
LogLine("Connecting to MariaDB..."); LogLine("Connecting to MariaDB...");
ucETask->Connect(); ucETask->Connect();
...@@ -75,42 +77,97 @@ void __fastcall TfMain::btnOpenTaskItemsClick(TObject *Sender) ...@@ -75,42 +77,97 @@ void __fastcall TfMain::btnOpenTaskItemsClick(TObject *Sender)
return; return;
} }
const UnicodeString launchUrl = BuildLaunchUrl(baseUrl, userId, taskId, urlCode); String launchUrl = BuildLaunchUrl(baseUrl, userId, taskId, urlCode);
if (launchUrl.IsEmpty()) if( launchUrl.IsEmpty() ){
{
LogLine("Launch URL build failed"); LogLine("Launch URL build failed");
return; return;
} }
LogLine("Launching browser:"); LogLine( "Launching browser:" );
LogLine(launchUrl); 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 TfrmMain::LogLine(String message)
void TfMain::LogLine(const 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->Lines->Add(stamp + " " + message);
memoLog->SelStart = memoLog->Text.Length(); memoLog->SelStart = memoLog->Text.Length();
} }
//--------------------------------------------------------------------------- //---------------------------------------------------------------------------
String TfrmMain::BuildLaunchUrl(String baseUrl, String userId, String taskId, String code)
String TfMain::BuildLaunchUrl(const String &baseUrl, const String &userId, const String &taskId, const String &code)
{ {
String cleanBaseUrl = baseUrl.Trim(); String cleanBaseUrl = baseUrl.Trim();
if (cleanBaseUrl.IsEmpty()) if( cleanBaseUrl.IsEmpty() )
return ""; 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 urlCode = 'WebLogin';
String qTaskId = TNetEncoding::URL->Encode(taskId);
String qCode = TNetEncoding::URL->Encode(code);
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 Left = 0
Top = 0 Top = 0
Caption = 'fMain' Caption = 'frmMain'
ClientHeight = 441 ClientHeight = 524
ClientWidth = 624 ClientWidth = 810
Color = clBtnFace Color = clBtnFace
Font.Charset = DEFAULT_CHARSET Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText Font.Color = clWindowText
...@@ -52,12 +52,15 @@ object fMain: TfMain ...@@ -52,12 +52,15 @@ object fMain: TfMain
OnClick = btnOpenTaskItemsClick OnClick = btnOpenTaskItemsClick
end end
object memoLog: TMemo object memoLog: TMemo
Left = 20 Left = 0
Top = 102 Top = 108
Width = 581 Width = 810
Height = 311 Height = 416
Align = alBottom
Anchors = [akLeft, akTop, akRight, akBottom]
Lines.Strings = ( Lines.Strings = (
'') '')
ScrollBars = ssVertical
TabOrder = 1 TabOrder = 1
end end
object edtUserId: TEdit object edtUserId: TEdit
...@@ -89,6 +92,24 @@ object fMain: TfMain ...@@ -89,6 +92,24 @@ object fMain: TfMain
NumbersOnly = True NumbersOnly = True
TabOrder = 5 TabOrder = 5
end 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 object ucETask: TUniConnection
ProviderName = 'MySQL' ProviderName = 'MySQL'
Database = 'etask' Database = 'etask'
...@@ -105,7 +126,7 @@ object fMain: TfMain ...@@ -105,7 +126,7 @@ object fMain: TfMain
'MySQL.HttpTrustServerCertificate=False' 'MySQL.HttpTrustServerCertificate=False'
'MySQL.ProxyPort=0') 'MySQL.ProxyPort=0')
Username = 'root' Username = 'root'
Server = '192.168.102.131' Server = '192.168.116.131'
LoginPrompt = False LoginPrompt = False
Left = 390 Left = 390
Top = 342 Top = 342
......
//--------------------------------------------------------------------------- //---------------------------------------------------------------------------
#ifndef uMainH #ifndef fMainH
#define uMainH #define fMainH
//--------------------------------------------------------------------------- //---------------------------------------------------------------------------
#include <System.Classes.hpp> #include <System.Classes.hpp>
#include <Vcl.Controls.hpp> #include <Vcl.Controls.hpp>
...@@ -14,7 +14,7 @@ ...@@ -14,7 +14,7 @@
#include "MySQLUniProvider.hpp" #include "MySQLUniProvider.hpp"
#include "UniProvider.hpp" #include "UniProvider.hpp"
//--------------------------------------------------------------------------- //---------------------------------------------------------------------------
class TfMain : public TForm class TfrmMain : public TForm
{ {
__published: // IDE-managed Components __published: // IDE-managed Components
TButton *btnOpenTaskItems; TButton *btnOpenTaskItems;
...@@ -30,16 +30,20 @@ __published: // IDE-managed Components ...@@ -30,16 +30,20 @@ __published: // IDE-managed Components
TUniConnection *ucETask; TUniConnection *ucETask;
TUniQuery *uqWebTasksUrl; TUniQuery *uqWebTasksUrl;
TMySQLUniProvider *MySQLUniProvider1; TMySQLUniProvider *MySQLUniProvider1;
TButton *btnTaskItemsLogin;
TButton *btnConnect;
void __fastcall FormCreate(TObject *Sender); void __fastcall FormCreate(TObject *Sender);
void __fastcall btnOpenTaskItemsClick(TObject *Sender); void __fastcall btnOpenTaskItemsClick(TObject *Sender);
void __fastcall btnTaskItemsLoginClick(TObject *Sender);
void __fastcall btnConnectClick(TObject *Sender);
private: private:
void LogLine(const String &message); void LogLine(String message);
String BuildLaunchUrl(const String &baseUrl, const String &userId, const String &taskId, const String &code); String BuildLaunchUrl(String baseUrl, String userId, String taskId, String code);
public: // User declarations public: // User declarations
__fastcall TfMain(TComponent* Owner); __fastcall TfrmMain(TComponent* Owner);
}; };
//--------------------------------------------------------------------------- //---------------------------------------------------------------------------
extern PACKAGE TfMain *fMain; extern PACKAGE TfrmMain *frmMain;
//--------------------------------------------------------------------------- //---------------------------------------------------------------------------
#endif #endif
...@@ -4,7 +4,7 @@ interface ...@@ -4,7 +4,7 @@ interface
uses uses
SysUtils, Web, JS, SysUtils, Web, JS,
XData.Web.Client; XData.Web.Client, WEBLib.Crypto;
const const
TOKEN_NAME = 'EMT3_WEB_TOKEN'; TOKEN_NAME = 'EMT3_WEB_TOKEN';
...@@ -23,8 +23,8 @@ type ...@@ -23,8 +23,8 @@ type
public public
constructor Create; reintroduce; constructor Create; reintroduce;
destructor Destroy; override; destructor Destroy; override;
procedure Login(AUser, APassword, AClientVersion: string; ASuccess: TOnLoginSuccess; procedure Login(AUserId, ATaskId, AUrlCode: string; ASuccess: TOnLoginSuccess; AError: TOnLoginError);
AError: TOnLoginError); [async] procedure WebLogin(AUserName, ALoginType, ALoginValue, APassword: string; ASuccess: TOnLoginSuccess; AError: TOnLoginError);
procedure Logout; procedure Logout;
function GetToken: string; function GetToken: string;
function Authenticated: Boolean; function Authenticated: Boolean;
...@@ -91,7 +91,7 @@ begin ...@@ -91,7 +91,7 @@ begin
Result := window.localStorage.getItem(TOKEN_NAME); Result := window.localStorage.getItem(TOKEN_NAME);
end; end;
procedure TAuthService.Login(AUser, APassword, AClientVersion: string; ASuccess: TOnLoginSuccess; procedure TAuthService.Login(AUserId, ATaskId, AUrlCode: string; ASuccess: TOnLoginSuccess;
AError: TOnLoginError); AError: TOnLoginError);
procedure OnLoad(Response: TXDataClientResponse); procedure OnLoad(Response: TXDataClientResponse);
...@@ -109,21 +109,70 @@ procedure TAuthService.Login(AUser, APassword, AClientVersion: string; ASuccess: ...@@ -109,21 +109,70 @@ procedure TAuthService.Login(AUser, APassword, AClientVersion: string; ASuccess:
end; end;
begin begin
if (AUser = '') or (APassword = '') then if (AUserId = '') or (ATaskId = '') or (AUrlCode = '') then
begin begin
AError('Invalid or expired code, please try again.'); AError('Invalid or expired code, please try again.');
Exit; Exit;
end; end;
FClient.RawInvoke( FClient.RawInvoke(
'IAuthService.Login', [AUser, APassword, AClientVersion], 'IAuthService.Login', [AUserId, ATaskId, AUrlCode],
@OnLoad, @OnError @OnLoad, @OnError
); );
end; 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; procedure TAuthService.Logout;
begin begin
DeleteToken; DeleteToken;
DMConnection.currentTaskId := '';
DMConnection.currentTimeEntryDate := '';
end; end;
procedure TAuthService.SetToken(AToken: string); procedure TAuthService.SetToken(AToken: string);
......
...@@ -20,7 +20,9 @@ type ...@@ -20,7 +20,9 @@ type
FUnauthorizedAccessProc: TUnauthorizedAccessProc; FUnauthorizedAccessProc: TUnauthorizedAccessProc;
public public
const clientVersion = '0.8.8'; currentTaskId: string;
currentTimeEntryDate: string;
const clientVersion = '0.9.3';
procedure InitApp(SuccessProc: TSuccessProc; procedure InitApp(SuccessProc: TSuccessProc;
UnauthorizedAccessProc: TUnauthorizedAccessProc); UnauthorizedAccessProc: TUnauthorizedAccessProc);
procedure SetClientConfig(Callback: TVersionCheckCallback); procedure SetClientConfig(Callback: TVersionCheckCallback);
......
...@@ -160,6 +160,12 @@ begin ...@@ -160,6 +160,12 @@ begin
var btnRight = document.getElementById('btn_confirm_right'); var btnRight = document.getElementById('btn_confirm_right');
var bsModal; 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 (body) body.innerText = msg;
if (btnLeft) btnLeft.innerText = leftLabel; if (btnLeft) btnLeft.innerText = leftLabel;
if (btnRight) btnRight.innerText = rightLabel; 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 @@ ...@@ -17,18 +17,18 @@
<ul class="dropdown-menu dropdown-menu-end shadow-sm" aria-labelledby="lnk_navbar_dropdown_menu_link"> <ul class="dropdown-menu dropdown-menu-end shadow-sm" aria-labelledby="lnk_navbar_dropdown_menu_link">
<li> <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> <i class="fa fa-home fa-fw"></i><span>Home</span>
</a> </a>
</li> </li>
<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> <i class="fa fa-user fa-fw"></i><span>User Profile</span>
</a> </a>
</li> </li>
<li><hr class="dropdown-divider"></li> <li><hr class="dropdown-divider"></li>
<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> <i class="fa fa-sign-out fa-fw"></i><span>Logout</span>
</a> </a>
</li> </li>
...@@ -87,19 +87,23 @@ ...@@ -87,19 +87,23 @@
</div> </div>
<!-- Confirmation Modal --> <!-- 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-dialog">
<div class="modal-content shadow-lg"> <div class="modal-content shadow-lg">
<div class="modal-header"> <div class="modal-header">
<h5 class="modal-title">Confirm</h5> <h5 class="modal-title">Confirm</h5>
<button type="button" class="btn-close" data-bs-dismiss="modal" aria-label="Close"></button> <button type="button" class="btn-close" data-bs-dismiss="modal" aria-label="Close"></button>
</div> </div>
<div class="modal-body fw-bold" id="lbl_confirmation_body"> <div class="modal-body fw-bold" id="main_modal_body">
Placeholder text Placeholder text
</div> </div>
<div class="modal-footer justify-content-center"> <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-danger me-3" id="btn_confirm_left">
<button type="button" class="btn btn-secondary" id="btn_confirm_right">Confirm</button> Delete
</button>
<button type="button" class="btn btn-secondary" id="btn_confirm_right">
Cancel
</button>
</div> </div>
</div> </div>
</div> </div>
......
...@@ -35,19 +35,34 @@ implementation ...@@ -35,19 +35,34 @@ implementation
uses uses
Auth.Service, Auth.Service,
View.TaskItems; View.TaskItems,
View.TimeEntries;
{$R *.dfm} {$R *.dfm}
procedure TFViewMain.WebFormCreate(Sender: TObject); procedure TFViewMain.WebFormCreate(Sender: TObject);
var var
userName: string; userName: string;
isTimeEntriesMode: Boolean;
begin begin
userName := JS.toString(AuthService.TokenPayload.Properties['user_name']); userName := JS.toString(AuthService.TokenPayload.Properties['user_name']);
lblUsername.Caption := userName; lblUsername.Caption := userName;
lblVersion.Caption := 'v' + DMConnection.clientVersion; 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); ShowForm(TFTaskItems);
end;
end; end;
procedure TFViewMain.lblLogoutClick(Sender: TObject); procedure TFViewMain.lblLogoutClick(Sender: TObject);
......
...@@ -58,6 +58,62 @@ object FTaskItems: TFTaskItems ...@@ -58,6 +58,62 @@ object FTaskItems: TFTaskItems
WidthPercent = 100.000000000000000000 WidthPercent = 100.000000000000000000
OnClick = btnInsertRowClick OnClick = btnInsertRowClick
end 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 object xdwcTasks: TXDataWebClient
Connection = DMConnection.ApiConnection Connection = DMConnection.ApiConnection
Left = 506 Left = 506
......
<div class="container-fluid p-2 d-flex flex-column h-100 overflow-hidden"> <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> <h5 class="mb-0" id="lbl_project_name"></h5>
<div class="d-flex align-items-center gap-3"> <div class="d-flex align-items-center gap-2 ms-auto flex-nowrap">
<div id="lbl_total_rows"></div> <div id="lbl_total_rows" class="me-2 text-nowrap"></div>
<div class="d-flex gap-2"> <div class="task-toolbar d-flex align-items-center gap-1 px-2 py-1">
<button id="btn_add_row" class="btn btn-sm btn-success">Add Row</button> <button id="btn_fmt_bold" type="button" class="btn btn-sm btn-light task-toolbar-btn" title="Bold">
<button id="btn_delete_row" class="btn btn-sm btn-danger">Delete Row</button> <i class="fas fa-bold"></i>
<button id="btn_insert_row" class="btn btn-sm btn-success">Insert Row</button> </button>
<button id="btn_reload" class="btn btn-sm btn-primary">Reload</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> </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>
</div> </div>
......
...@@ -31,11 +31,19 @@ type ...@@ -31,11 +31,19 @@ type
xdwdsTaskstaskItemId: TIntegerField; xdwdsTaskstaskItemId: TIntegerField;
btnDeleteRow: TWebButton; btnDeleteRow: TWebButton;
btnInsertRow: TWebButton; btnInsertRow: TWebButton;
btnTextColor: TWebButton;
btnFmtBold: TWebButton;
btnFmtItalic: TWebButton;
btnFmtUnderline: TWebButton;
[async] procedure btnAddRowClick(Sender: TObject); [async] procedure btnAddRowClick(Sender: TObject);
procedure btnReloadClick(Sender: TObject); procedure btnReloadClick(Sender: TObject);
procedure WebFormCreate(Sender: TObject); procedure WebFormCreate(Sender: TObject);
[async] procedure btnDeleteRowClick(Sender: TObject); [async] procedure btnDeleteRowClick(Sender: TObject);
[async] procedure btnInsertRowClick(Sender: TObject); [async] procedure btnInsertRowClick(Sender: TObject);
procedure btnTextColorClick(Sender: TObject);
procedure btnFmtBoldClick(Sender: TObject);
procedure btnFmtItalicClick(Sender: TObject);
procedure btnFmtUnderlineClick(Sender: TObject);
private private
FTaskId: string; FTaskId: string;
FApplicationOptions: TJSArray; FApplicationOptions: TJSArray;
...@@ -50,6 +58,8 @@ type ...@@ -50,6 +58,8 @@ type
FPendingScrollLeft: Integer; FPendingScrollLeft: Integer;
FPendingFocusItemNum: Integer; FPendingFocusItemNum: Integer;
FPendingFocusTaskField: string; FPendingFocusTaskField: string;
FActiveRichEditorId: string;
FLastSelectionRange: JSValue;
FNameManager: TNameManager; FNameManager: TNameManager;
[async] procedure LoadTasks(const ATaskId: string); [async] procedure LoadTasks(const ATaskId: string);
procedure RenderTable; procedure RenderTable;
...@@ -90,6 +100,12 @@ type ...@@ -90,6 +100,12 @@ type
[async] procedure HandleAddManagedName(const AFieldName: string; const ARowIndex: Integer; const ANewName: string); [async] procedure HandleAddManagedName(const AFieldName: string; const ARowIndex: Integer; const ANewName: string);
[async] procedure HandleRenameManagedName(const AFieldName, AOldName, ANewName: string); [async] procedure HandleRenameManagedName(const AFieldName, AOldName, ANewName: string);
[async] procedure HandleDeleteManagedName(const AFieldName, AName: 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 public
end; end;
...@@ -107,7 +123,11 @@ uses ...@@ -107,7 +123,11 @@ uses
procedure TFTaskItems.WebFormCreate(Sender: TObject); procedure TFTaskItems.WebFormCreate(Sender: TObject);
begin begin
console.log('TFTaskItems.WebFormCreate fired'); console.log('TFTaskItems.WebFormCreate fired');
FTaskId := Application.Parameters.Values['task_id']; FTaskId := Application.Parameters.Values['task_id'];
if FTaskId = '' then
FTaskId := DMConnection.currentTaskId;
FApplicationOptions := TJSArray.new; FApplicationOptions := TJSArray.new;
FReportedByOptions := TJSArray.new; FReportedByOptions := TJSArray.new;
FAssignedToOptions := TJSArray.new; FAssignedToOptions := TJSArray.new;
...@@ -214,6 +234,9 @@ begin ...@@ -214,6 +234,9 @@ begin
if xdwdsTasks.Eof then if xdwdsTasks.Eof then
Exit; Exit;
if SameText(fieldName, 'issue') or SameText(fieldName, 'notes') then
newVal := string(el.innerHTML)
else
newVal := string(TJSObject(el)['value']); newVal := string(TJSObject(el)['value']);
console.log('EditorInput: idx=' + IntToStr(idx) + ' field=' + fieldName + ' val=' + newVal); console.log('EditorInput: idx=' + IntToStr(idx) + ' field=' + fieldName + ' val=' + newVal);
...@@ -280,6 +303,13 @@ begin ...@@ -280,6 +303,13 @@ begin
el.addEventListener('input', TJSEventHandler(@EditorInput)); el.addEventListener('input', TJSEventHandler(@EditorInput));
el.addEventListener('blur', TJSEventHandler(@EditorBlur)); el.addEventListener('blur', TJSEventHandler(@EditorBlur));
el.addEventListener('keydown', TJSEventHandler(@EditorKeyDown)); 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; end;
nodes := document.querySelectorAll('.task-select'); nodes := document.querySelectorAll('.task-select');
...@@ -311,6 +341,10 @@ begin ...@@ -311,6 +341,10 @@ begin
el.addEventListener('click', TJSEventHandler(@RowClick)); el.addEventListener('click', TJSEventHandler(@RowClick));
end; end;
el := TJSHTMLElement(document.getElementById('issue_notes_text_color'));
if Assigned(el) then
el.addEventListener('input', TJSEventHandler(@ColorPickerInput));
ApplySelectedRowState; ApplySelectedRowState;
end; end;
...@@ -402,6 +436,21 @@ begin ...@@ -402,6 +436,21 @@ begin
end; end;
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); [async] procedure TFTaskItems.btnInsertRowClick(Sender: TObject);
begin begin
Utils.ShowSpinner('spinner'); Utils.ShowSpinner('spinner');
...@@ -525,7 +574,7 @@ begin ...@@ -525,7 +574,7 @@ begin
try try
response := await(xdwcTasks.RawInvokeAsync( response := await(xdwcTasks.RawInvokeAsync(
'IApiService.AddTaskRow', [FTaskId, insertAfterItemNum] 'ITaskItemService.AddTaskRow', [FTaskId, insertAfterItemNum]
)); ));
console.log('AddTaskRow response=' + string(TJSJSON.stringify(response.Result))); console.log('AddTaskRow response=' + string(TJSJSON.stringify(response.Result)));
...@@ -555,16 +604,29 @@ begin ...@@ -555,16 +604,29 @@ begin
end; end;
procedure TFTaskItems.btnTextColorClick(Sender: TObject);
var
colorEl: TJSHTMLElement;
begin
colorEl := TJSHTMLElement(document.getElementById('issue_notes_text_color'));
colorEl.click;
end;
procedure TFTaskItems.EnableAutoGrowTextAreas; procedure TFTaskItems.EnableAutoGrowTextAreas;
begin begin
asm asm
(function(){ (function(){
const host = document.getElementById('tasks_table_host'); const host = document.getElementById('tasks_table_host');
if(!host) return; 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(); fit();
ta.addEventListener('input', fit); editor.addEventListener('input', fit);
}); });
})(); })();
end; end;
...@@ -599,13 +661,13 @@ var ...@@ -599,13 +661,13 @@ var
titleText: string; titleText: string;
rowCount: Integer; rowCount: Integer;
begin begin
console.log('IApiService.GetTaskItems called with task_id: ' + ATaskId); console.log('ITaskItemService.GetTaskItems called with task_id: ' + ATaskId);
console.log('Load Tasks Fired'); console.log('Load Tasks Fired');
Utils.ShowSpinner('spinner'); Utils.ShowSpinner('spinner');
try try
try try
response := await(xdwcTasks.RawInvokeAsync( response := await(xdwcTasks.RawInvokeAsync(
'IApiService.GetTaskItems', [ATaskId] 'ITaskItemService.GetTaskItems', [ATaskId]
)); ));
except except
on E: EXDataClientRequestException do on E: EXDataClientRequestException do
...@@ -693,15 +755,6 @@ var ...@@ -693,15 +755,6 @@ var
'value="' + HtmlEncode(Value) + '"' + w + '>'; 'value="' + HtmlEncode(Value) + '"' + w + '>';
end; 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; function ItemNumInput(const Value: Integer; const AIdx: Integer): string;
begin begin
Result := Result :=
...@@ -786,6 +839,21 @@ var ...@@ -786,6 +839,21 @@ var
'</div>'; '</div>';
end; 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 begin
host := TJSHTMLElement(document.getElementById('tasks_table_host')); host := TJSHTMLElement(document.getElementById('tasks_table_host'));
if not Assigned(host) then if not Assigned(host) then
...@@ -837,8 +905,8 @@ begin ...@@ -837,8 +905,8 @@ begin
TdNowrap(SelectList('status', xdwdsTasksstatus.AsString, rowIdx, FStatusOptions, False)) + TdNowrap(SelectList('status', xdwdsTasksstatus.AsString, rowIdx, FStatusOptions, False)) +
TdNowrap(DateInput('statusDate', xdwdsTasksstatusDate.AsString, rowIdx)) + TdNowrap(DateInput('statusDate', xdwdsTasksstatusDate.AsString, rowIdx)) +
TdNowrap(TextInput('formSection', xdwdsTasksformSection.AsString, rowIdx)) + TdNowrap(TextInput('formSection', xdwdsTasksformSection.AsString, rowIdx)) +
TdWrap(TextArea('issue', xdwdsTasksissue.AsString, rowIdx)) + TdWrap(RichTextEditor('issue', xdwdsTasksissue.AsString, rowIdx)) +
TdWrap(TextArea('notes', xdwdsTasksnotes.AsString, rowIdx)) + TdWrap(RichTextEditor('notes', xdwdsTasksnotes.AsString, rowIdx)) +
'</tr>'; '</tr>';
xdwdsTasks.Next; xdwdsTasks.Next;
...@@ -963,7 +1031,7 @@ begin ...@@ -963,7 +1031,7 @@ begin
try try
response := await(xdwcTasks.RawInvokeAsync( response := await(xdwcTasks.RawInvokeAsync(
'IApiService.MoveTaskRow', 'ITaskItemService.MoveTaskRow',
[ [
StrToIntDef(xdwdsTaskstaskId.AsString, 0), StrToIntDef(xdwdsTaskstaskId.AsString, 0),
movedTaskItemId, movedTaskItemId,
...@@ -1038,7 +1106,7 @@ begin ...@@ -1038,7 +1106,7 @@ begin
Exit; Exit;
try try
response := await(xdwcTasks.RawInvokeAsync('IApiService.SaveTaskItemField', [payload])); response := await(xdwcTasks.RawInvokeAsync('ITaskItemService.SaveTaskItemField', [payload]));
console.log('SaveField: response=' + string(TJSJSON.stringify(response.Result))); console.log('SaveField: response=' + string(TJSJSON.stringify(response.Result)));
except except
on E: EXDataClientRequestException do on E: EXDataClientRequestException do
...@@ -1061,7 +1129,7 @@ begin ...@@ -1061,7 +1129,7 @@ begin
try try
response := await(xdwcTasks.RawInvokeAsync( response := await(xdwcTasks.RawInvokeAsync(
'IApiService.DeleteTaskRow', 'ITaskItemService.DeleteTaskRow',
[FSelectedTaskId, FSelectedTaskItemId] [FSelectedTaskId, FSelectedTaskItemId]
)); ));
console.log('DeleteTaskRow response=' + string(TJSJSON.stringify(response.Result))); console.log('DeleteTaskRow response=' + string(TJSJSON.stringify(response.Result)));
...@@ -1255,7 +1323,7 @@ begin ...@@ -1255,7 +1323,7 @@ begin
try try
response := await(xdwcTasks.RawInvokeAsync( response := await(xdwcTasks.RawInvokeAsync(
'IApiService.AddAssignedName', 'ITaskItemService.AddAssignedName',
[FTaskId, Trim(AName)] [FTaskId, Trim(AName)]
)); ));
...@@ -1281,7 +1349,7 @@ begin ...@@ -1281,7 +1349,7 @@ begin
try try
response := await(xdwcTasks.RawInvokeAsync( response := await(xdwcTasks.RawInvokeAsync(
'IApiService.RenameAssignedName', 'ITaskItemService.RenameAssignedName',
[FTaskId, Trim(AOldName), Trim(ANewName)] [FTaskId, Trim(AOldName), Trim(ANewName)]
)); ));
...@@ -1307,7 +1375,7 @@ begin ...@@ -1307,7 +1375,7 @@ begin
try try
response := await(xdwcTasks.RawInvokeAsync( response := await(xdwcTasks.RawInvokeAsync(
'IApiService.DeleteAssignedName', 'ITaskItemService.DeleteAssignedName',
[FTaskId, Trim(AName)] [FTaskId, Trim(AName)]
)); ));
...@@ -1368,6 +1436,7 @@ begin ...@@ -1368,6 +1436,7 @@ begin
await(SaveField(ARowIndex, AFieldName)); await(SaveField(ARowIndex, AFieldName));
end; end;
[async] procedure TFTaskItems.HandleRenameManagedName(const AFieldName, AOldName, ANewName: string); [async] procedure TFTaskItems.HandleRenameManagedName(const AFieldName, AOldName, ANewName: string);
var var
newOptions: TJSArray; newOptions: TJSArray;
...@@ -1431,7 +1500,7 @@ begin ...@@ -1431,7 +1500,7 @@ begin
try try
response := await(xdwcTasks.RawInvokeAsync( response := await(xdwcTasks.RawInvokeAsync(
'IApiService.AddApplicationName', 'ITaskItemService.AddApplicationName',
[FTaskId, Trim(AName)] [FTaskId, Trim(AName)]
)); ));
...@@ -1457,7 +1526,7 @@ begin ...@@ -1457,7 +1526,7 @@ begin
try try
response := await(xdwcTasks.RawInvokeAsync( response := await(xdwcTasks.RawInvokeAsync(
'IApiService.RenameApplicationName', 'ITaskItemService.RenameApplicationName',
[FTaskId, Trim(AOldName), Trim(ANewName)] [FTaskId, Trim(AOldName), Trim(ANewName)]
)); ));
...@@ -1483,7 +1552,7 @@ begin ...@@ -1483,7 +1552,7 @@ begin
try try
response := await(xdwcTasks.RawInvokeAsync( response := await(xdwcTasks.RawInvokeAsync(
'IApiService.DeleteApplicationName', 'ITaskItemService.DeleteApplicationName',
[FTaskId, Trim(AName)] [FTaskId, Trim(AName)]
)); ));
...@@ -1510,7 +1579,7 @@ begin ...@@ -1510,7 +1579,7 @@ begin
try try
response := await(xdwcTasks.RawInvokeAsync( response := await(xdwcTasks.RawInvokeAsync(
'IApiService.AddReportedName', 'ITaskItemService.AddReportedName',
[FTaskId, Trim(AName)] [FTaskId, Trim(AName)]
)); ));
...@@ -1536,7 +1605,7 @@ begin ...@@ -1536,7 +1605,7 @@ begin
try try
response := await(xdwcTasks.RawInvokeAsync( response := await(xdwcTasks.RawInvokeAsync(
'IApiService.RenameReportedName', 'ITaskItemService.RenameReportedName',
[FTaskId, Trim(AOldName), Trim(ANewName)] [FTaskId, Trim(AOldName), Trim(ANewName)]
)); ));
...@@ -1562,7 +1631,7 @@ begin ...@@ -1562,7 +1631,7 @@ begin
try try
response := await(xdwcTasks.RawInvokeAsync( response := await(xdwcTasks.RawInvokeAsync(
'IApiService.DeleteReportedName', 'ITaskItemService.DeleteReportedName',
[FTaskId, Trim(AName)] [FTaskId, Trim(AName)]
)); ));
...@@ -1580,6 +1649,118 @@ begin ...@@ -1580,6 +1649,118 @@ begin
end; 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. 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; border: 1px solid #dc3545 !important;
} }
...@@ -22,6 +22,7 @@ is-invalid .form-check-input { ...@@ -22,6 +22,7 @@ is-invalid .form-check-input {
transform: translateX(-120%); transform: translateX(-120%);
opacity: 0; opacity: 0;
} }
to { to {
transform: translateX(0); transform: translateX(0);
opacity: 1; opacity: 1;
...@@ -39,37 +40,6 @@ is-invalid .form-check-input { ...@@ -39,37 +40,6 @@ is-invalid .form-check-input {
left: 50%; left: 50%;
transform: translate(-50%, -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 { span.card {
border: none; border: none;
...@@ -89,155 +59,6 @@ span.card { ...@@ -89,155 +59,6 @@ span.card {
user-select: none; 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 { .dropdown-menu {
z-index: 1055; 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; ...@@ -2,6 +2,7 @@ program emT3Web;
uses uses
System.Classes, System.Classes,
System.SysUtils,
Vcl.Forms, Vcl.Forms,
XData.Web.Connection, XData.Web.Connection,
WEBLib.Dialogs, WEBLib.Dialogs,
...@@ -13,10 +14,15 @@ uses ...@@ -13,10 +14,15 @@ uses
Utils in 'Utils.pas', Utils in 'Utils.pas',
View.TaskItems in 'View.TaskItems.pas' {FTaskItems: TWebForm} {*.html}, View.TaskItems in 'View.TaskItems.pas' {FTaskItems: TWebForm} {*.html},
uNameOffCanvas in 'uNameOffCanvas.pas', 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} {$R *.res}
procedure DisplayLoginView(AUserId: string = ''; ATaskId: string = ''; AMessage: string = ''); forward;
procedure DoLogout(AMsg: string = ''); forward; procedure DoLogout(AMsg: string = ''); forward;
procedure DisplayMainView; procedure DisplayMainView;
...@@ -42,48 +48,108 @@ procedure Login(userId: string; taskId: string; urlCode: string); ...@@ -42,48 +48,108 @@ procedure Login(userId: string; taskId: string; urlCode: string);
procedure LoginError(AMsg: string); procedure LoginError(AMsg: string);
begin 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); ShowAppDialog('' + AMsg);
end; end;
begin begin
AuthService.Login( userId, taskId, urlCode, AuthService.Login(userId, taskId, urlCode,
@LoginSuccess, @LoginSuccess,
@LoginError @LoginError
); );
end; 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(); procedure DoLogin();
var var
userIdParam: string; userIdParam: string;
taskIdParam: string; taskIdParam: string;
codeParam: string; codeParam: string;
timeEntriesParam: string;
isTimeEntriesMode: Boolean;
begin 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']; userIdParam := Application.Parameters.Values['user_id'];
taskIdParam := Application.Parameters.Values['task_id']; taskIdParam := Application.Parameters.Values['task_id'];
codeParam := Application.Parameters.Values['url_code']; codeParam := Application.Parameters.Values['url_code'];
if (userIdParam = '') or (taskIdParam = '') or (codeParam = '') then
begin
DisplayLoginView(userIdParam, taskIdParam);
end
else
begin
AuthService.Logout; AuthService.Logout;
DMConnection.ApiConnection.Connected := False; DMConnection.ApiConnection.Connected := False;
if Assigned(FViewMain) then if Assigned(FViewMain) then
FViewMain.Free; FViewMain.Free;
Login( userIdParam, taskIdParam, codeParam ); DMConnection.currentTaskId := taskIdParam;
Login(userIdParam, taskIdParam, codeParam);
end;
end; end;
procedure DoLogout(AMsg: string); procedure DoLogout(AMsg: string);
var
userIdParam: string;
taskIdParam: string;
timeEntriesParam: string;
isTimeEntriesMode: Boolean;
begin begin
AuthService.Logout; 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); procedure UnauthorizedAccessProc(AMessage: string);
begin begin
ShowAppDialog('UnauthorizedAccessProc: ' + AMessage); ShowAppDialog('UnauthorizedAccessProc: ' + AMessage);
end; end;
procedure StartApplication; procedure StartApplication;
var var
ClientVer: string; ClientVer: string;
......
...@@ -94,15 +94,15 @@ ...@@ -94,15 +94,15 @@
<DCC_RemoteDebug>false</DCC_RemoteDebug> <DCC_RemoteDebug>false</DCC_RemoteDebug>
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo> <VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
<VerInfo_Locale>1033</VerInfo_Locale> <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> <AppDPIAwarenessMode>PerMonitor</AppDPIAwarenessMode>
<VerInfo_MajorVer>0</VerInfo_MajorVer> <VerInfo_MajorVer>0</VerInfo_MajorVer>
<VerInfo_MinorVer>8</VerInfo_MinorVer> <VerInfo_MinorVer>9</VerInfo_MinorVer>
<VerInfo_Release>8</VerInfo_Release> <TMSWebBrowser>1</TMSWebBrowser>
<TMSWebBrowser>5</TMSWebBrowser>
<TMSUseJSDebugger>2</TMSUseJSDebugger> <TMSUseJSDebugger>2</TMSUseJSDebugger>
<TMSWebSingleInstance>1</TMSWebSingleInstance> <VerInfo_Release>3</VerInfo_Release>
<TMSWebOutputPath>..\emT3XDataServer\bin\static</TMSWebOutputPath> <TMSWebOutputPath>..\emT3XDataServer\bin\static</TMSWebOutputPath>
<TMSWebSingleInstance>1</TMSWebSingleInstance>
</PropertyGroup> </PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2)'!=''"> <PropertyGroup Condition="'$(Cfg_2)'!=''">
<DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols> <DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols>
...@@ -139,15 +139,29 @@ ...@@ -139,15 +139,29 @@
<DCCReference Include="Utils.pas"/> <DCCReference Include="Utils.pas"/>
<DCCReference Include="View.TaskItems.pas"> <DCCReference Include="View.TaskItems.pas">
<Form>FTaskItems</Form> <Form>FTaskItems</Form>
<FormType>dfm</FormType>
<DesignClass>TWebForm</DesignClass> <DesignClass>TWebForm</DesignClass>
</DCCReference> </DCCReference>
<DCCReference Include="uNameOffCanvas.pas"/> <DCCReference Include="uNameOffCanvas.pas"/>
<DCCReference Include="uDropdownHelpers.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="index.html"/>
<None Include="css\app.css"/> <None Include="css\app.css"/>
<None Include="config\config.json"/> <None Include="config\config.json"/>
<None Include="css\spinner.css"/> <None Include="css\spinner.css"/>
<None Include="css\task-items.css"/>
<None Include="css\time-entries.css"/>
<BuildConfiguration Include="Base"> <BuildConfiguration Include="Base">
<Key>Base</Key> <Key>Base</Key>
</BuildConfiguration> </BuildConfiguration>
...@@ -228,6 +242,18 @@ ...@@ -228,6 +242,18 @@
<Overwrite>true</Overwrite> <Overwrite>true</Overwrite>
</Platform> </Platform>
</DeployFile> </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"/>
<DeployFile LocalName="index.html" Configuration="Debug" Class="ProjectFile"> <DeployFile LocalName="index.html" Configuration="Debug" Class="ProjectFile">
<Platform Name="Win32"> <Platform Name="Win32">
......
...@@ -10,6 +10,8 @@ ...@@ -10,6 +10,8 @@
<link href="https://fonts.googleapis.com/icon?family=Material+Icons" rel="stylesheet"/> <link href="https://fonts.googleapis.com/icon?family=Material+Icons" rel="stylesheet"/>
<link href="https://cdnjs.cloudflare.com/ajax/libs/font-awesome/5.15.0/css/all.min.css" rel="stylesheet"/> <link href="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/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"/> <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> <script crossorigin="anonymous" integrity="sha256-eKhayi8LEQwp4NKxN+CfCh+3qOVUtJn3QNZ0TciWLP4=" src="https://code.jquery.com/jquery-3.7.1.js"></script>
...@@ -17,7 +19,7 @@ ...@@ -17,7 +19,7 @@
<script src="https://cdn.jsdelivr.net/npm/bootstrap@5.3.8/dist/js/bootstrap.bundle.min.js"></script> <script src="https://cdn.jsdelivr.net/npm/bootstrap@5.3.8/dist/js/bootstrap.bundle.min.js"></script>
<script src="$(ProjectName).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> <body>
<noscript>Your browser does not support JavaScript!</noscript> <noscript>Your browser does not support JavaScript!</noscript>
<script>rtl.run();</script> <script>rtl.run();</script>
...@@ -27,3 +29,5 @@ ...@@ -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 object ApiDatabase: TApiDatabase
OnCreate = DataModuleCreate OnCreate = DataModuleCreate
Height = 475 Height = 632
Width = 996 Width = 994
object ucETaskApi: TUniConnection object ucETaskApi: TUniConnection
AutoCommit = False AutoCommit = False
ProviderName = 'MySQL' ProviderName = 'MySQL'
Database = 'eTask' Database = 'eTask'
Username = 'root'
Server = '192.168.102.133'
LoginPrompt = False LoginPrompt = False
Left = 267 Left = 435
Top = 395 Top = 359
EncryptedPassword = '9AFF92FF8CFF86FF8CFFCFFFCEFF' EncryptedPassword = '9AFF92FF8CFF86FF8CFFCFFFCEFF'
end end
object MySQLUniProvider1: TMySQLUniProvider object MySQLUniProvider1: TMySQLUniProvider
Left = 416 Left = 546
Top = 398 Top = 356
end end
object uqUsers: TUniQuery object uqUsers: TUniQuery
Connection = ucETaskApi Connection = ucETaskApi
...@@ -142,7 +144,7 @@ object ApiDatabase: TApiDatabase ...@@ -142,7 +144,7 @@ object ApiDatabase: TApiDatabase
'from task_items' 'from task_items'
'where TASK_ID = :TASK_ID' 'where TASK_ID = :TASK_ID'
'order by ITEM_NUM') 'order by ITEM_NUM')
Left = 56 Left = 58
Top = 26 Top = 26
ParamData = < ParamData = <
item item
...@@ -282,7 +284,7 @@ object ApiDatabase: TApiDatabase ...@@ -282,7 +284,7 @@ object ApiDatabase: TApiDatabase
'left join project p' 'left join project p'
' on p.PROJECT_ID = t.PROJECT_ID' ' on p.PROJECT_ID = t.PROJECT_ID'
'where t.TASK_ID = :TASK_ID') 'where t.TASK_ID = :TASK_ID')
Left = 54 Left = 60
Top = 82 Top = 82
ParamData = < ParamData = <
item item
...@@ -367,7 +369,7 @@ object ApiDatabase: TApiDatabase ...@@ -367,7 +369,7 @@ object ApiDatabase: TApiDatabase
'from task_items' 'from task_items'
'where TASK_ITEM_ID = :TASK_ITEM_ID' 'where TASK_ITEM_ID = :TASK_ITEM_ID'
' and TASK_ID = :TASK_ID') ' and TASK_ID = :TASK_ID')
Left = 240 Left = 236
Top = 16 Top = 16
ParamData = < ParamData = <
item item
...@@ -1085,4 +1087,277 @@ object ApiDatabase: TApiDatabase ...@@ -1085,4 +1087,277 @@ object ApiDatabase: TApiDatabase
Value = nil Value = nil
end> end>
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 end
...@@ -88,6 +88,25 @@ type ...@@ -88,6 +88,25 @@ type
uqRenameTaskItemReportedBy: TUniQuery; uqRenameTaskItemReportedBy: TUniQuery;
uqProjectReportedUsersTASK_ITEM_USER_ID: TStringField; uqProjectReportedUsersTASK_ITEM_USER_ID: TStringField;
uqProjectReportedUsersNAME: 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 DataModuleCreate(Sender: TObject);
procedure uqUsersCalcFields(DataSet: TDataSet); procedure uqUsersCalcFields(DataSet: TDataSet);
private private
......
...@@ -53,7 +53,7 @@ uses ...@@ -53,7 +53,7 @@ uses
XData.Sys.Exceptions, XData.Sys.Exceptions,
Common.Logging, Common.Logging,
Common.Middleware.Logging, Common.Middleware.Logging,
Common.Config, Vcl.Forms, IniFiles, Api.Service; Common.Config, Vcl.Forms, IniFiles, TaskItem.Service, TimeEntry.Service;
{%CLASSGROUP 'Vcl.Controls.TControl'} {%CLASSGROUP 'Vcl.Controls.TControl'}
......
object AuthDatabase: TAuthDatabase object AuthDatabase: TAuthDatabase
OnCreate = DataModuleCreate OnCreate = DataModuleCreate
OnDestroy = DataModuleDestroy OnDestroy = DataModuleDestroy
Height = 202 Height = 236
Width = 578 Width = 327
object uqWebTasksUrl: TUniQuery object uqWebTasksUrl: TUniQuery
Connection = ucETaskAuth Connection = ucETaskAuth
SQL.Strings = ( SQL.Strings = (
...@@ -103,10 +103,9 @@ object AuthDatabase: TAuthDatabase ...@@ -103,10 +103,9 @@ object AuthDatabase: TAuthDatabase
ProviderName = 'MySQL' ProviderName = 'MySQL'
Database = 'eTask' Database = 'eTask'
Username = 'root' Username = 'root'
Server = '192.168.102.131' Server = '192.168.102.133'
Connected = True
LoginPrompt = False LoginPrompt = False
Left = 69 Left = 71
Top = 133 Top = 133
EncryptedPassword = '9AFF92FF8CFF86FF8CFFCFFFCEFF' EncryptedPassword = '9AFF92FF8CFF86FF8CFFCFFFCEFF'
end end
...@@ -128,18 +127,19 @@ object AuthDatabase: TAuthDatabase ...@@ -128,18 +127,19 @@ object AuthDatabase: TAuthDatabase
' u.PERSPECTIVE_ID,' ' u.PERSPECTIVE_ID,'
' u.LAST_NAME,' ' u.LAST_NAME,'
' u.FIRST_NAME,' ' u.FIRST_NAME,'
' u.PASSWORD,'
' w.WEB_LOGIN' ' w.WEB_LOGIN'
'from web_tasks_url w' 'from web_tasks_url w'
'join users u on u.USER_ID = w.USER_ID' '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 w.TASK_ID = :TASK_ID'
' and u.PASSWORD = :PASSWORD') ' and w.URL_CODE = :URL_CODE')
Left = 192 Left = 194
Top = 44 Top = 44
ParamData = < ParamData = <
item item
DataType = ftUnknown DataType = ftUnknown
Name = 'USER_ID' Name = 'USER_NAME'
Value = nil Value = nil
end end
item item
...@@ -149,7 +149,7 @@ object AuthDatabase: TAuthDatabase ...@@ -149,7 +149,7 @@ object AuthDatabase: TAuthDatabase
end end
item item
DataType = ftUnknown DataType = ftUnknown
Name = 'PASSWORD' Name = 'URL_CODE'
Value = nil Value = nil
end> end>
object uqWebLoginUSER_ID: TStringField object uqWebLoginUSER_ID: TStringField
...@@ -192,6 +192,10 @@ object AuthDatabase: TAuthDatabase ...@@ -192,6 +192,10 @@ object AuthDatabase: TAuthDatabase
FieldName = 'FIRST_NAME' FieldName = 'FIRST_NAME'
Size = 25 Size = 25
end end
object uqWebLoginPASSWORD: TStringField
FieldName = 'PASSWORD'
Size = 12
end
object uqWebLoginWEB_LOGIN: TStringField object uqWebLoginWEB_LOGIN: TStringField
FieldName = 'WEB_LOGIN' FieldName = 'WEB_LOGIN'
ReadOnly = True ReadOnly = True
......
...@@ -36,6 +36,7 @@ type ...@@ -36,6 +36,7 @@ type
uqWebLoginPERSPECTIVE_ID: TStringField; uqWebLoginPERSPECTIVE_ID: TStringField;
uqWebLoginLAST_NAME: TStringField; uqWebLoginLAST_NAME: TStringField;
uqWebLoginFIRST_NAME: TStringField; uqWebLoginFIRST_NAME: TStringField;
uqWebLoginPASSWORD: TStringField;
uqWebLoginWEB_LOGIN: TStringField; uqWebLoginWEB_LOGIN: TStringField;
procedure DataModuleCreate(Sender: TObject); procedure DataModuleCreate(Sender: TObject);
procedure DataModuleDestroy(Sender: TObject); procedure DataModuleDestroy(Sender: TObject);
......
...@@ -18,9 +18,9 @@ type ...@@ -18,9 +18,9 @@ type
[ServiceContract, Model(AUTH_MODEL)] [ServiceContract, Model(AUTH_MODEL)]
IAuthService = interface(IInvokable) IAuthService = interface(IInvokable)
['{9CFD59B2-A832-4F82-82BB-9A25FC93F305}'] ['{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 VerifyVersion(ClientVersion: string): TJSONObject;
function WebLogin(const userId, taskId, password: string): string; function WebLogin(userName, loginType, loginValue, password: string): string;
end; end;
implementation implementation
......
...@@ -29,12 +29,16 @@ type ...@@ -29,12 +29,16 @@ type
procedure AfterConstruction; override; procedure AfterConstruction; override;
procedure BeforeDestruction; 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 LoadUserFromUrlLoginQuery;
procedure LoadUserFromWebLoginQuery;
public public
function Login(const userId, taskId, urlCode: string): string; function Login(userId, taskId, urlCode: string): string;
function VerifyVersion(ClientVersion: string): TJSONObject; 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; end;
implementation implementation
...@@ -63,12 +67,14 @@ begin ...@@ -63,12 +67,14 @@ begin
end; end;
end; end;
procedure TAuthService.BeforeDestruction; procedure TAuthService.BeforeDestruction;
begin begin
authDB.Free; authDB.Free;
inherited; inherited;
end; end;
function TAuthService.VerifyVersion(ClientVersion: string): TJSONObject; function TAuthService.VerifyVersion(ClientVersion: string): TJSONObject;
var var
iniFile: TIniFile; iniFile: TIniFile;
...@@ -100,7 +106,8 @@ begin ...@@ -100,7 +106,8 @@ begin
end; end;
end; end;
function TAuthService.CheckUrlLogin(const userId, taskId, urlCode: string): Integer;
function TAuthService.CheckUrlLogin(userId, taskId, urlCode: string): Integer;
var var
sql: string; sql: string;
timeNow: TDateTime; timeNow: TDateTime;
...@@ -109,7 +116,8 @@ begin ...@@ -109,7 +116,8 @@ begin
Logger.Log(3, 'TAuthService.CheckUrlLogin(const userId, taskId, urlCode: string): Integer' ); 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 := '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 + 'from web_tasks_url w ';
sql := sql + 'join users u on u.USER_ID = w.USER_ID '; 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 + 'where w.USER_ID = :USER_ID and w.TASK_ID = :TASK_ID and w.URL_CODE = :URL_CODE ';
...@@ -151,28 +159,30 @@ begin ...@@ -151,28 +159,30 @@ begin
Result := 3; Result := 3;
end; end;
procedure TAuthService.LoadUserFromUrlLoginQuery; procedure TAuthService.LoadUserFromUrlLoginQuery;
var var
nameValue: string; nameValue: string;
begin begin
Self.userId := authDB.uqWebTasksUrl.FieldByName('USER_ID').AsString; Self.userId := authDB.uqWebTasksUrlUSER_ID.AsString;
userName := authDB.uqWebTasksUrl.FieldByName('USER_NAME').AsString; userName := authDB.uqWebTasksUrlUSER_NAME.AsString;
userStatus := authDB.uqWebTasksUrl.FieldByName('STATUS').AsString; userStatus := authDB.uqWebTasksUrlSTATUS.AsString;
userEmail := authDB.uqWebTasksUrl.FieldByName('EMAIL').AsString; userEmail := authDB.uqWebTasksUrlEMAIL.AsString;
userAccessLevel := authDB.uqWebTasksUrl.FieldByName('ACCESS_LEVEL').AsString; userAccessLevel := authDB.uqWebTasksUrlACCESS_LEVEL.AsString;
userTaskRights := authDB.uqWebTasksUrl.FieldByName('TASK_RIGHTS').AsString; userTaskRights := authDB.uqWebTasksUrlTASK_RIGHTS.AsString;
userPerspectiveId := authDB.uqWebTasksUrl.FieldByName('PERSPECTIVE_ID').AsString; userPerspectiveId := authDB.uqWebTasksUrlPERSPECTIVE_ID.AsString;
userLastName := authDB.uqWebTasksUrl.FieldByName('LAST_NAME').AsString; userLastName := authDB.uqWebTasksUrlLAST_NAME.AsString;
userFirstName := authDB.uqWebTasksUrl.FieldByName('FIRST_NAME').AsString; userFirstName := authDB.uqWebTasksUrlFIRST_NAME.AsString;
nameValue := Trim(authDB.uqWebTasksUrl.FieldByName('NAME').AsString); nameValue := Trim(authDB.uqWebTasksUrlNAME.AsString);
if nameValue <> '' then if nameValue <> '' then
userFullName := nameValue userFullName := nameValue
else else
userFullName := Trim(userFirstName + ' ' + userLastName); userFullName := Trim(userFirstName + ' ' + userLastName);
end; end;
function TAuthService.Login(const userId, taskId, urlCode: string): string;
function TAuthService.Login(userId, taskId, urlCode: string): string;
var var
userState: Integer; userState: Integer;
jwt: TJWT; jwt: TJWT;
...@@ -230,6 +240,227 @@ begin ...@@ -230,6 +240,227 @@ begin
end; end;
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 initialization
RegisterServiceType(TAuthService); RegisterServiceType(TAuthService);
......
unit Main; unit Main;
//Authors:
//Elias Sarraf
//Mac Stephens
//Cameron Hayes
interface interface
uses uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, Winapi.ShellApi, Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, Winapi.ShellApi,
System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs,
Vcl.StdCtrls, Vcl.ExtCtrls, System.Generics.Collections, System.IniFiles, Vcl.StdCtrls, Vcl.ExtCtrls, System.Generics.Collections, System.IniFiles,
Auth.Service, Auth.Server.Module, Api.Service, Api.Server.Module, App.Server.Module, TaskItem.Service, Auth.Server.Module, Auth.Service, Api.Server.Module, App.Server.Module,
ExeInfo; TimeEntry.Service, TimeEntry.ServiceImpl, ExeInfo;
type type
TFMain = class(TForm) TFMain = class(TForm)
......
unit Api.Service; unit TaskItem.Service;
interface interface
...@@ -115,10 +115,10 @@ type ...@@ -115,10 +115,10 @@ type
type type
[ServiceContract, Model(API_MODEL)] [ServiceContract, Model(API_MODEL)]
IApiService = interface(IInvokable) ITaskItemService = interface(IInvokable)
['{0EFB33D7-8C4C-4F3C-9BC3-8B4D444B5F69}'] ['{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 AddTaskRow(taskId: string; insertAfterItemNum: Integer): Boolean;
[HttpPost] function AddAssignedName(taskId: string; name: string): TTaskUserOptionsResponse; [HttpPost] function AddAssignedName(taskId: string; name: string): TTaskUserOptionsResponse;
...@@ -134,9 +134,10 @@ type ...@@ -134,9 +134,10 @@ type
[HttpPost] function RenameApplicationName(taskId: string; oldName: string; newName: string): TTaskApplicationOptionsResponse; [HttpPost] function RenameApplicationName(taskId: string; oldName: string; newName: string): TTaskApplicationOptionsResponse;
[HttpPost] function DeleteApplicationName(taskId: string; name: string): TTaskApplicationOptionsResponse; [HttpPost] function DeleteApplicationName(taskId: string; name: string): TTaskApplicationOptionsResponse;
procedure MoveTaskRow(const taskId: Integer; const taskItemId: Integer; const newItemNum: Integer); [HttpPost] procedure MoveTaskRow(const taskId: Integer; const taskItemId: Integer; const newItemNum: Integer);
function DeleteTaskRow(const taskId: Integer; const taskItemId: Integer): Boolean; [HttpPost] function DeleteTaskRow(const taskId: Integer; const taskItemId: Integer): Boolean;
function SaveTaskItemField(const Item: TTaskItemFieldSave): Boolean; [HttpPost] function SaveTaskItemField(const Item: TTaskItemFieldSave): Boolean;
end; end;
implementation implementation
...@@ -188,6 +189,6 @@ begin ...@@ -188,6 +189,6 @@ begin
end; end;
initialization initialization
RegisterServiceType(TypeInfo(IApiService)); RegisterServiceType(TypeInfo(ITaskItemService));
end. end.
unit Api.ServiceImpl; unit TaskItem.ServiceImpl;
interface interface
uses uses
XData.Server.Module, XData.Service.Common, XData.Server.Module, XData.Service.Common,
System.Variants, System.DateUtils, Uni, System.Variants, System.DateUtils, Uni,
Api.Service, Api.Database, Common.Logging, TaskItem.Service, Api.Database, Common.Logging,
System.SysUtils, JSON, System.IniFiles, DBAccess; System.SysUtils, JSON, System.IniFiles, DBAccess;
type type
[ServiceImplementation] [ServiceImplementation]
TApiService = class(TInterfacedObject, IApiService) TTaskItemService = class(TInterfacedObject, ITaskItemService)
strict private strict private
apiDB: TApiDatabase; apiDB: TApiDatabase;
private private
...@@ -47,22 +47,23 @@ type ...@@ -47,22 +47,23 @@ type
implementation implementation
procedure TApiService.AfterConstruction; procedure TTaskItemService.AfterConstruction;
begin begin
inherited; inherited;
apiDB := TApiDatabase.Create(nil); apiDB := TApiDatabase.Create(nil);
Logger.Log(4, 'ApiService.AfterConstruction - apiDB created'); Logger.Log(4, 'TaskItemService.AfterConstruction - apiDB created');
end; end;
procedure TApiService.BeforeDestruction;
procedure TTaskItemService.BeforeDestruction;
begin begin
Logger.Log(4, 'ApiService.BeforeDestruction - freeing apiDB'); Logger.Log(4, 'TaskItemService.BeforeDestruction - freeing apiDB');
apiDB.Free; apiDB.Free;
inherited; inherited;
end; end;
function TApiService.GetTaskItems(taskId: string): TTaskItemsResponse; function TTaskItemService.GetTaskItems(taskId: string): TTaskItemsResponse;
var var
taskHeader: TTaskHeader; taskHeader: TTaskHeader;
taskUserOption: TTaskUserOption; taskUserOption: TTaskUserOption;
...@@ -70,7 +71,7 @@ var ...@@ -70,7 +71,7 @@ var
taskApplicationOption: TTaskApplicationOption; taskApplicationOption: TTaskApplicationOption;
item: TTaskItem; item: TTaskItem;
begin begin
Logger.Log(4, Format('ApiService.GetTaskItems - TASK_ID="%s"', [taskId])); Logger.Log(4, Format('TaskItemService.GetTaskItems - TASK_ID="%s"', [taskId]));
Result := TTaskItemsResponse.Create; Result := TTaskItemsResponse.Create;
TXDataOperationContext.Current.Handler.ManagedObjects.Add(Result); TXDataOperationContext.Current.Handler.ManagedObjects.Add(Result);
...@@ -82,7 +83,7 @@ begin ...@@ -82,7 +83,7 @@ begin
if apiDB.uqTaskHeader.IsEmpty then if apiDB.uqTaskHeader.IsEmpty then
begin 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; Result.count := 0;
Exit; Exit;
end; end;
...@@ -205,23 +206,23 @@ begin ...@@ -205,23 +206,23 @@ begin
end; end;
Result.count := Result.items.Count; 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 except
on E: Exception do on E: Exception do
begin begin
Logger.Log(2, 'ApiService.GetTaskItems - ERROR: ' + E.Message); Logger.Log(2, 'TaskItemService.GetTaskItems - ERROR: ' + E.Message);
raise; raise;
end; end;
end; end;
end; end;
function TApiService.AddTaskRow(taskId: string; insertAfterItemNum: Integer): Boolean; function TTaskItemService.AddTaskRow(taskId: string; insertAfterItemNum: Integer): Boolean;
var var
newItemNum: Integer; newItemNum: Integer;
maxItemNum: Integer; maxItemNum: Integer;
begin 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.Close;
apiDB.uqGetTaskMaxItemNum.ParamByName('TASK_ID').AsString := taskId; apiDB.uqGetTaskMaxItemNum.ParamByName('TASK_ID').AsString := taskId;
...@@ -257,21 +258,21 @@ begin ...@@ -257,21 +258,21 @@ begin
apiDB.uqAddTaskRow.Connection.Commit; apiDB.uqAddTaskRow.Connection.Commit;
Result := True; 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 except
on E: Exception do on E: Exception do
begin begin
if apiDB.uqAddTaskRow.Connection.InTransaction then if apiDB.uqAddTaskRow.Connection.InTransaction then
apiDB.uqAddTaskRow.Connection.Rollback; apiDB.uqAddTaskRow.Connection.Rollback;
Logger.Log(2, 'ApiService.AddTaskRow - ERROR: ' + E.Message); Logger.Log(2, 'TaskItemService.AddTaskRow - ERROR: ' + E.Message);
raise; raise;
end; end;
end; 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 var
oldItemNum: Integer; oldItemNum: Integer;
maxItemNum: Integer; maxItemNum: Integer;
...@@ -368,7 +369,7 @@ begin ...@@ -368,7 +369,7 @@ begin
end; end;
function TApiService.SaveTaskItemField(const Item: TTaskItemFieldSave): Boolean; function TTaskItemService.SaveTaskItemField(const Item: TTaskItemFieldSave): Boolean;
var var
uqSaveField: TUniQuery; uqSaveField: TUniQuery;
columnName: string; columnName: string;
...@@ -478,7 +479,7 @@ begin ...@@ -478,7 +479,7 @@ begin
end; end;
function TApiService.BuildTaskNumber: string; function TTaskItemService.BuildTaskNumber: string;
procedure AddPart(const value: string); procedure AddPart(const value: string);
var var
...@@ -506,7 +507,7 @@ begin ...@@ -506,7 +507,7 @@ begin
end; end;
function TApiService.BuildTaskTitle(const taskNumber, projectName, subject: string): string; function TTaskItemService.BuildTaskTitle(const taskNumber, projectName, subject: string): string;
begin begin
Result := 'Task'; Result := 'Task';
...@@ -521,11 +522,11 @@ begin ...@@ -521,11 +522,11 @@ begin
end; end;
function TApiService.DeleteTaskRow(const taskId: Integer; const taskItemId: Integer): Boolean; function TTaskItemService.DeleteTaskRow(const taskId: Integer; const taskItemId: Integer): Boolean;
var var
oldItemNum: Integer; oldItemNum: Integer;
begin 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.Close;
apiDB.uqGetTaskRowPosition.ParamByName('TASK_ID').AsInteger := taskId; apiDB.uqGetTaskRowPosition.ParamByName('TASK_ID').AsInteger := taskId;
...@@ -534,7 +535,7 @@ begin ...@@ -534,7 +535,7 @@ begin
if apiDB.uqGetTaskRowPosition.IsEmpty then if apiDB.uqGetTaskRowPosition.IsEmpty then
begin 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.'); raise Exception.Create('Task row not found.');
end; end;
...@@ -553,21 +554,21 @@ begin ...@@ -553,21 +554,21 @@ begin
apiDB.uqGetTaskRowPosition.Connection.Commit; apiDB.uqGetTaskRowPosition.Connection.Commit;
Result := True; 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 except
on E: Exception do on E: Exception do
begin begin
if apiDB.uqGetTaskRowPosition.Connection.InTransaction then if apiDB.uqGetTaskRowPosition.Connection.InTransaction then
apiDB.uqGetTaskRowPosition.Connection.Rollback; 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; raise;
end; end;
end; end;
end; end;
function TApiService.FindAssignedOptionId(const taskId, name: string): string; function TTaskItemService.FindAssignedOptionId(const taskId, name: string): string;
begin begin
Result := ''; Result := '';
...@@ -587,7 +588,8 @@ begin ...@@ -587,7 +588,8 @@ begin
end; end;
end; end;
function TApiService.FindAssignedOptionName(const taskId, name: string): string;
function TTaskItemService.FindAssignedOptionName(const taskId, name: string): string;
begin begin
Result := ''; Result := '';
...@@ -608,7 +610,7 @@ begin ...@@ -608,7 +610,7 @@ begin
end; end;
function TApiService.AddAssignedName(taskId: string; name: string): TTaskUserOptionsResponse; function TTaskItemService.AddAssignedName(taskId: string; name: string): TTaskUserOptionsResponse;
var var
newName: string; newName: string;
existingName: string; existingName: string;
...@@ -646,7 +648,7 @@ begin ...@@ -646,7 +648,7 @@ begin
end; end;
function TApiService.RenameAssignedName(taskId: string; oldName: string; newName: string): TTaskUserOptionsResponse; function TTaskItemService.RenameAssignedName(taskId: string; oldName: string; newName: string): TTaskUserOptionsResponse;
var var
oldAssignedId: string; oldAssignedId: string;
existingAssignedId: string; existingAssignedId: string;
...@@ -706,7 +708,7 @@ begin ...@@ -706,7 +708,7 @@ begin
end; end;
function TApiService.DeleteAssignedName(taskId: string; name: string): TTaskUserOptionsResponse; function TTaskItemService.DeleteAssignedName(taskId: string; name: string): TTaskUserOptionsResponse;
var var
assignedId: string; assignedId: string;
assignedName: string; assignedName: string;
...@@ -743,7 +745,7 @@ begin ...@@ -743,7 +745,7 @@ begin
end; end;
function TApiService.BuildAssignedOptionsResponse(const taskId: string): TTaskUserOptionsResponse; function TTaskItemService.BuildAssignedOptionsResponse(const taskId: string): TTaskUserOptionsResponse;
var var
taskUserOption: TTaskUserOption; taskUserOption: TTaskUserOption;
begin begin
...@@ -767,7 +769,7 @@ begin ...@@ -767,7 +769,7 @@ begin
end; end;
function TApiService.FindProjectId(const taskId: string): string; function TTaskItemService.FindProjectId(const taskId: string): string;
begin begin
Result := ''; Result := '';
...@@ -780,7 +782,7 @@ begin ...@@ -780,7 +782,7 @@ begin
end; end;
function TApiService.FindApplicationId(const taskId, name: string): Integer; function TTaskItemService.FindApplicationId(const taskId, name: string): Integer;
begin begin
Result := 0; Result := 0;
...@@ -800,7 +802,8 @@ begin ...@@ -800,7 +802,8 @@ begin
end; end;
end; end;
function TApiService.FindApplicationName(const taskId, name: string): string;
function TTaskItemService.FindApplicationName(const taskId, name: string): string;
begin begin
Result := ''; Result := '';
...@@ -821,7 +824,7 @@ begin ...@@ -821,7 +824,7 @@ begin
end; end;
function TApiService.BuildApplicationOptionsResponse(const taskId: string): TTaskApplicationOptionsResponse; function TTaskItemService.BuildApplicationOptionsResponse(const taskId: string): TTaskApplicationOptionsResponse;
var var
taskApplicationOption: TTaskApplicationOption; taskApplicationOption: TTaskApplicationOption;
begin begin
...@@ -845,7 +848,7 @@ begin ...@@ -845,7 +848,7 @@ begin
end; end;
function TApiService.AddApplicationName(taskId: string; name: string): TTaskApplicationOptionsResponse; function TTaskItemService.AddApplicationName(taskId: string; name: string): TTaskApplicationOptionsResponse;
var var
projectId: string; projectId: string;
newName: string; newName: string;
...@@ -884,7 +887,7 @@ begin ...@@ -884,7 +887,7 @@ begin
end; end;
function TApiService.RenameApplicationName(taskId: string; oldName: string; newName: string): TTaskApplicationOptionsResponse; function TTaskItemService.RenameApplicationName(taskId: string; oldName: string; newName: string): TTaskApplicationOptionsResponse;
var var
projectId: string; projectId: string;
oldApplicationId: Integer; oldApplicationId: Integer;
...@@ -949,7 +952,7 @@ begin ...@@ -949,7 +952,7 @@ begin
end; end;
function TApiService.DeleteApplicationName(taskId: string; name: string): TTaskApplicationOptionsResponse; function TTaskItemService.DeleteApplicationName(taskId: string; name: string): TTaskApplicationOptionsResponse;
var var
projectId: string; projectId: string;
applicationId: Integer; applicationId: Integer;
...@@ -990,7 +993,8 @@ begin ...@@ -990,7 +993,8 @@ begin
Result := BuildApplicationOptionsResponse(taskId); Result := BuildApplicationOptionsResponse(taskId);
end; end;
function TApiService.FindReportedOptionId(const taskId, name: string): string;
function TTaskItemService.FindReportedOptionId(const taskId, name: string): string;
begin begin
Result := ''; Result := '';
...@@ -1010,7 +1014,8 @@ begin ...@@ -1010,7 +1014,8 @@ begin
end; end;
end; end;
function TApiService.FindReportedOptionName(const taskId, name: string): string;
function TTaskItemService.FindReportedOptionName(const taskId, name: string): string;
begin begin
Result := ''; Result := '';
...@@ -1030,7 +1035,8 @@ begin ...@@ -1030,7 +1035,8 @@ begin
end; end;
end; end;
function TApiService.BuildReportedOptionsResponse(const taskId: string): TTaskUserOptionsResponse;
function TTaskItemService.BuildReportedOptionsResponse(const taskId: string): TTaskUserOptionsResponse;
var var
taskUserOption: TTaskUserOption; taskUserOption: TTaskUserOption;
begin begin
...@@ -1053,7 +1059,8 @@ begin ...@@ -1053,7 +1059,8 @@ begin
end; end;
end; end;
function TApiService.AddReportedName(taskId: string; name: string): TTaskUserOptionsResponse;
function TTaskItemService.AddReportedName(taskId: string; name: string): TTaskUserOptionsResponse;
var var
newName: string; newName: string;
existingName: string; existingName: string;
...@@ -1090,7 +1097,8 @@ begin ...@@ -1090,7 +1097,8 @@ begin
Result := BuildReportedOptionsResponse(taskId); Result := BuildReportedOptionsResponse(taskId);
end; end;
function TApiService.RenameReportedName(taskId: string; oldName: string; newName: string): TTaskUserOptionsResponse;
function TTaskItemService.RenameReportedName(taskId: string; oldName: string; newName: string): TTaskUserOptionsResponse;
var var
oldReportedId: string; oldReportedId: string;
existingReportedId: string; existingReportedId: string;
...@@ -1149,7 +1157,8 @@ begin ...@@ -1149,7 +1157,8 @@ begin
Result := BuildReportedOptionsResponse(taskId); Result := BuildReportedOptionsResponse(taskId);
end; end;
function TApiService.DeleteReportedName(taskId: string; name: string): TTaskUserOptionsResponse;
function TTaskItemService.DeleteReportedName(taskId: string; name: string): TTaskUserOptionsResponse;
var var
reportedId: string; reportedId: string;
reportedName: string; reportedName: string;
...@@ -1185,11 +1194,8 @@ begin ...@@ -1185,11 +1194,8 @@ begin
Result := BuildReportedOptionsResponse(taskId); Result := BuildReportedOptionsResponse(taskId);
end; end;
initialization initialization
RegisterServiceType(TypeInfo(IApiService)); RegisterServiceType(TTaskItemService);
RegisterServiceType(TApiService);
end. 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] [Settings]
MemoLogLevel=4 MemoLogLevel=4
FileLogLevel=4 FileLogLevel=4
webClientVersion=0.8.8 webClientVersion=0.9.3
LogFileNum=161 LogFileNum=245
[Database] [Database]
Server=192.168.102.131 Server=192.168.102.133
--Server=192.168.116.128 --Server=192.168.116.131
--Server=192.168.102.131
--Server=192.168.159.10 --Server=192.168.159.10
Database=eTask Database=eTask
Username=root Username=root
......
...@@ -20,9 +20,11 @@ uses ...@@ -20,9 +20,11 @@ uses
Auth.Service in 'Source\Auth.Service.pas', Auth.Service in 'Source\Auth.Service.pas',
Auth.ServiceImpl in 'Source\Auth.ServiceImpl.pas', Auth.ServiceImpl in 'Source\Auth.ServiceImpl.pas',
App.Server.Module in 'Source\App.Server.Module.pas' {AppServerModule: TDataModule}, App.Server.Module in 'Source\App.Server.Module.pas' {AppServerModule: TDataModule},
Api.Service in 'Source\Api.Service.pas', TaskItem.Service in 'Source\TaskItem.Service.pas',
Api.ServiceImpl in 'Source\Api.ServiceImpl.pas', TaskItem.ServiceImpl in 'Source\TaskItem.ServiceImpl.pas',
Common.Ini in 'Source\Common.Ini.pas'; Common.Ini in 'Source\Common.Ini.pas',
TimeEntry.Service in 'Source\TimeEntry.Service.pas',
TimeEntry.ServiceImpl in 'Source\TimeEntry.ServiceImpl.pas';
type type
TMemoLogAppender = class( TInterfacedObject, ILogAppender ) TMemoLogAppender = class( TInterfacedObject, ILogAppender )
......
...@@ -114,10 +114,12 @@ ...@@ -114,10 +114,12 @@
<VerInfo_Locale>1033</VerInfo_Locale> <VerInfo_Locale>1033</VerInfo_Locale>
<DCC_ExeOutput>.\bin</DCC_ExeOutput> <DCC_ExeOutput>.\bin</DCC_ExeOutput>
<DCC_UnitSearchPath>C:\RADTOOLS\FastMM4;$(DCC_UnitSearchPath)</DCC_UnitSearchPath> <DCC_UnitSearchPath>C:\RADTOOLS\FastMM4;$(DCC_UnitSearchPath)</DCC_UnitSearchPath>
<VerInfo_Keys>CompanyName=EM Systems;FileDescription=$(MSBuildProjectName);FileVersion=0.8.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_MajorVer>0</VerInfo_MajorVer>
<VerInfo_MinorVer>8</VerInfo_MinorVer> <VerInfo_MinorVer>9</VerInfo_MinorVer>
<VerInfo_Release>8</VerInfo_Release> <VerInfo_AutoIncVersion>true</VerInfo_AutoIncVersion>
<VerInfo_Build>1</VerInfo_Build>
<VerInfo_Release>3</VerInfo_Release>
</PropertyGroup> </PropertyGroup>
<PropertyGroup Condition="'$(Cfg_1_Win64)'!=''"> <PropertyGroup Condition="'$(Cfg_1_Win64)'!=''">
<AppDPIAwarenessMode>PerMonitorV2</AppDPIAwarenessMode> <AppDPIAwarenessMode>PerMonitorV2</AppDPIAwarenessMode>
...@@ -175,9 +177,11 @@ ...@@ -175,9 +177,11 @@
<Form>AppServerModule</Form> <Form>AppServerModule</Form>
<DesignClass>TDataModule</DesignClass> <DesignClass>TDataModule</DesignClass>
</DCCReference> </DCCReference>
<DCCReference Include="Source\Api.Service.pas"/> <DCCReference Include="Source\TaskItem.Service.pas"/>
<DCCReference Include="Source\Api.ServiceImpl.pas"/> <DCCReference Include="Source\TaskItem.ServiceImpl.pas"/>
<DCCReference Include="Source\Common.Ini.pas"/> <DCCReference Include="Source\Common.Ini.pas"/>
<DCCReference Include="Source\TimeEntry.Service.pas"/>
<DCCReference Include="Source\TimeEntry.ServiceImpl.pas"/>
<BuildConfiguration Include="Base"> <BuildConfiguration Include="Base">
<Key>Base</Key> <Key>Base</Key>
</BuildConfiguration> </BuildConfiguration>
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment