Skip to content
Projects
Groups
Snippets
Help
This project
Loading...
Sign in / Register
Toggle navigation
E
emT3web
Overview
Overview
Details
Activity
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
0
Issues
0
List
Board
Labels
Milestones
Merge Requests
0
Merge Requests
0
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Charts
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
Mac Stephens
emT3web
Commits
30fc30ba
Commit
30fc30ba
authored
May 01, 2026
by
Mac Stephens
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Time entries startup added, wip
parent
77fd1936
Show whitespace changes
Inline
Side-by-side
Showing
14 changed files
with
244 additions
and
32 deletions
+244
-32
Auth.Service.pas
emT3Web/Auth.Service.pas
+5
-6
View.Login.dfm
emT3Web/View.Login.dfm
+15
-3
View.Login.html
emT3Web/View.Login.html
+6
-3
View.Login.pas
emT3Web/View.Login.pas
+46
-5
View.Main.pas
emT3Web/View.Main.pas
+11
-1
View.TaskItems.pas
emT3Web/View.TaskItems.pas
+1
-0
View.TimeEntries.dfm
emT3Web/View.TimeEntries.dfm
+5
-0
View.TimeEntries.html
emT3Web/View.TimeEntries.html
+11
-0
View.TimeEntries.pas
emT3Web/View.TimeEntries.pas
+25
-0
emT3web.dpr
emT3Web/emT3web.dpr
+22
-4
emT3web.dproj
emT3Web/emT3web.dproj
+4
-3
Auth.Service.pas
emT3XDataServer/Source/Auth.Service.pas
+1
-1
Auth.ServiceImpl.pas
emT3XDataServer/Source/Auth.ServiceImpl.pas
+91
-5
emT3XDataServer.ini
emT3XDataServer/bin/emT3XDataServer.ini
+1
-1
No files found.
emT3Web/Auth.Service.pas
View file @
30fc30ba
...
...
@@ -24,7 +24,7 @@ type
constructor
Create
;
reintroduce
;
destructor
Destroy
;
override
;
procedure
Login
(
AUserId
,
ATaskId
,
AUrlCode
:
string
;
ASuccess
:
TOnLoginSuccess
;
AError
:
TOnLoginError
);
[
async
]
procedure
WebLogin
(
AUserName
,
A
TaskId
,
APassword
:
string
;
ASuccess
:
TOnLoginSuccess
;
AError
:
TOnLoginError
);
[
async
]
procedure
WebLogin
(
AUserName
,
A
LoginType
,
ALoginValue
,
APassword
:
string
;
ASuccess
:
TOnLoginSuccess
;
AError
:
TOnLoginError
);
procedure
Logout
;
function
GetToken
:
string
;
function
Authenticated
:
Boolean
;
...
...
@@ -122,8 +122,7 @@ begin
end
;
[
async
]
procedure
TAuthService
.
WebLogin
(
AUserName
,
ATaskId
,
APassword
:
string
;
ASuccess
:
TOnLoginSuccess
;
AError
:
TOnLoginError
);
[
async
]
procedure
TAuthService
.
WebLogin
(
AUserName
,
ALoginType
,
ALoginValue
,
APassword
:
string
;
ASuccess
:
TOnLoginSuccess
;
AError
:
TOnLoginError
);
var
sha
:
TWebSHAHash
;
passwordHash
:
string
;
...
...
@@ -143,9 +142,9 @@ var
end
;
begin
if
(
AUserName
=
''
)
or
(
A
TaskId
=
''
)
or
(
APassword
=
''
)
then
if
(
AUserName
=
''
)
or
(
A
LoginType
=
''
)
or
(
ALoginValue
=
''
)
or
(
APassword
=
''
)
then
begin
AError
(
'Please enter
user id, task id, and password
.'
);
AError
(
'Please enter
all required login fields
.'
);
Exit
;
end
;
...
...
@@ -157,7 +156,7 @@ begin
end
;
FClient
.
RawInvoke
(
'IAuthService.WebLogin'
,
[
AUserName
,
A
TaskId
,
passwordHash
],
'IAuthService.WebLogin'
,
[
AUserName
,
A
LoginType
,
ALoginValue
,
passwordHash
],
@
OnLoad
,
@
OnError
);
end
;
...
...
emT3Web/View.Login.dfm
View file @
30fc30ba
...
...
@@ -21,7 +21,7 @@ object FViewLogin: TFViewLogin
end
object edtUsername: TWebEdit
Left = 240
Top = 1
6
0
Top = 1
8
0
Width = 121
Height = 21
ElementID = 'view.login.edtusername'
...
...
@@ -31,7 +31,7 @@ object FViewLogin: TFViewLogin
end
object edtPassword: TWebEdit
Left = 240
Top =
18
7
Top =
20
7
Width = 121
Height = 21
ElementID = 'view.login.edtpassword'
...
...
@@ -43,7 +43,7 @@ object FViewLogin: TFViewLogin
end
object btnLogin: TWebButton
Left = 240
Top = 2
1
4
Top = 2
3
4
Width = 121
Height = 25
Caption = 'Login'
...
...
@@ -92,6 +92,18 @@ object FViewLogin: TFViewLogin
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
...
...
emT3Web/View.Login.html
View file @
30fc30ba
<nav
class=
"navbar navbar-light bg-light login-navbar"
>
<div
class=
"container-fluid"
>
<a
class=
"navbar-brand"
href=
"#"
>
Envoy Calls
</a>
<a
class=
"navbar-brand"
href=
"#"
>
emT3web
</a>
</div>
</nav>
<div
class=
"container mt-5"
>
...
...
@@ -17,8 +17,11 @@
<span
id=
"view.login.message.label"
></span>
</div>
<fieldset>
<div
class=
"mb-3"
>
<input
id=
"view.login.edttaskid"
class=
"form-control"
type=
"text"
autofocus
placeholder=
"Task Id"
>
<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"
>
...
...
emT3Web/View.Login.pas
View file @
30fc30ba
...
...
@@ -19,6 +19,7 @@ type
btnCloseNotification
:
TWebButton
;
XDataWebClient
:
TXDataWebClient
;
edtTaskId
:
TWebEdit
;
edtDate
:
TWebEdit
;
procedure
btnLoginClick
(
Sender
:
TObject
);
procedure
btnCloseNotificationClick
(
Sender
:
TObject
);
procedure
WebFormCreate
(
Sender
:
TObject
);
...
...
@@ -47,10 +48,16 @@ uses
{$R *.dfm}
procedure
TFViewLogin
.
btnLoginClick
(
Sender
:
TObject
);
var
timeEntriesParam
:
string
;
procedure
LoginSuccess
;
begin
if
SameText
(
timeEntriesParam
,
'true'
)
then
DMConnection
.
currentTaskId
:=
''
else
DMConnection
.
currentTaskId
:=
edtTaskId
.
Text
;
FLoginProc
;
end
;
...
...
@@ -60,11 +67,30 @@ procedure TFViewLogin.btnLoginClick(Sender: TObject);
end
;
begin
timeEntriesParam
:=
Application
.
Parameters
.
Values
[
'time_entries'
];
if
SameText
(
timeEntriesParam
,
'true'
)
then
begin
AuthService
.
WebLogin
(
edtUsername
.
Text
,
'time_entries'
,
edtDate
.
Text
,
edtPassword
.
Text
,
@
LoginSuccess
,
@
LoginError
);
end
else
begin
AuthService
.
WebLogin
(
edtUsername
.
Text
,
edtTaskId
.
Text
,
edtPassword
.
Text
,
edtUsername
.
Text
,
'task_items'
,
edtTaskId
.
Text
,
edtPassword
.
Text
,
@
LoginSuccess
,
@
LoginError
);
end
;
end
;
class
procedure
TFViewLogin
.
Display
(
LoginProc
:
TSuccessProc
);
...
...
@@ -110,14 +136,29 @@ begin
end
;
procedure
TFViewLogin
.
WebFormCreate
(
Sender
:
TObject
);
var
timeEntriesParam
:
string
;
begin
console
.
log
(
'TFViewLogin.WebFormCreate FUserId='
+
FUserId
+
' FTaskId='
+
FTaskId
+
' FMessage='
+
FMessage
);
console
.
log
(
'TFViewLogin.WebFormCreate URL task_id='
+
Application
.
Parameters
.
Values
[
'task_id'
]);
edtUsername
.
Text
:=
''
;
edtTaskId
.
Text
:=
Application
.
Parameters
.
Values
[
'task_id'
];
timeEntriesParam
:=
Application
.
Parameters
.
Values
[
'time_entries'
];
edtUsername
.
Text
:=
FUserId
;
edtTaskId
.
Text
:=
FTaskId
;
edtDate
.
Text
:=
Application
.
Parameters
.
Values
[
'date'
];
console
.
log
(
'TFViewLogin.WebFormCreate after assign edtUsername='
+
edtUsername
.
Text
+
' edtTaskId='
+
edtTaskId
.
Text
);
if
SameText
(
timeEntriesParam
,
'true'
)
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
)
...
...
emT3Web/View.Main.pas
View file @
30fc30ba
...
...
@@ -35,7 +35,8 @@ implementation
uses
Auth
.
Service
,
View
.
TaskItems
;
View
.
TaskItems
,
View
.
TimeEntries
;
{$R *.dfm}
...
...
@@ -47,7 +48,16 @@ begin
lblUsername
.
Caption
:=
userName
;
lblVersion
.
Caption
:=
'v'
+
DMConnection
.
clientVersion
;
if
SameText
(
Application
.
Parameters
.
Values
[
'time_entries'
],
'true'
)
then
begin
lblAppTitle
.
Caption
:=
'Time Entries'
;
ShowForm
(
TFTimeEntries
);
end
else
begin
lblAppTitle
.
Caption
:=
'Task Items'
;
ShowForm
(
TFTaskItems
);
end
;
end
;
procedure
TFViewMain
.
lblLogoutClick
(
Sender
:
TObject
);
...
...
emT3Web/View.TaskItems.pas
View file @
30fc30ba
...
...
@@ -1436,6 +1436,7 @@ begin
await
(
SaveField
(
ARowIndex
,
AFieldName
));
end
;
[
async
]
procedure
TFTaskItems
.
HandleRenameManagedName
(
const
AFieldName
,
AOldName
,
ANewName
:
string
);
var
newOptions
:
TJSArray
;
...
...
emT3Web/View.TimeEntries.dfm
0 → 100644
View file @
30fc30ba
object FTimeEntries: TFTimeEntries
Width = 640
Height = 480
ElementFont = efCSS
end
emT3Web/View.TimeEntries.html
0 → 100644
View file @
30fc30ba
<html>
<head>
<meta
http-equiv=
"Content-type"
content=
"text/html; charset=utf-8"
/>
<title>
TMS Web Project
</title>
<style>
</style>
</head>
<body>
</body>
</html>
\ No newline at end of file
emT3Web/View.TimeEntries.pas
0 → 100644
View file @
30fc30ba
unit
View
.
TimeEntries
;
interface
uses
System
.
SysUtils
,
System
.
Classes
,
JS
,
Web
,
WEBLib
.
Graphics
,
WEBLib
.
Controls
,
WEBLib
.
Forms
,
WEBLib
.
Dialogs
;
type
TFTimeEntries
=
class
(
TWebForm
)
private
{ Private declarations }
public
{ Public declarations }
end
;
var
FTimeEntries
:
TFTimeEntries
;
implementation
{$R *.dfm}
end
.
\ No newline at end of file
emT3Web/emT3web.dpr
View file @
30fc30ba
...
...
@@ -2,6 +2,7 @@ program emT3Web;
uses
System.Classes,
System.SysUtils,
Vcl.Forms,
XData.Web.Connection,
WEBLib.Dialogs,
...
...
@@ -15,7 +16,8 @@ uses
uNameOffCanvas in 'uNameOffCanvas.pas',
uDropdownHelpers in 'uDropdownHelpers.pas',
View.Login in 'View.Login.pas' {FViewLogin: TWebForm} {*.html},
View.ErrorPage in 'View.ErrorPage.pas' {FViewErrorPage: TWebForm} {*.html};
View.ErrorPage in 'View.ErrorPage.pas' {FViewErrorPage: TWebForm} {*.html},
View.TimeEntries in 'View.TimeEntries.pas' {FTimeEntries: TWebForm} {*.html};
{$R *.res}
...
...
@@ -76,7 +78,16 @@ var
userIdParam: string;
taskIdParam: string;
codeParam: string;
timeEntriesParam: string;
begin
timeEntriesParam := Application.Parameters.Values['time_entries'];
if SameText(timeEntriesParam, 'true') then
begin
DisplayLoginView('', '', '');
Exit;
end;
userIdParam := Application.Parameters.Values['user_id'];
taskIdParam := Application.Parameters.Values['task_id'];
codeParam := Application.Parameters.Values['url_code'];
...
...
@@ -101,22 +112,29 @@ procedure DoLogout(AMsg: string);
var
userIdParam: string;
taskIdParam: string;
timeEntriesParam: string;
begin
AuthService.Logout;
timeEntriesParam := Application.Parameters.Values['time_entries'];
if SameText(timeEntriesParam, 'true') then
begin
DisplayLoginView('', '', AMsg);
Exit;
end;
userIdParam := Application.Parameters.Values['user_id'];
taskIdParam := Application.Parameters.Values['task_id'];
DisplayLoginView(userIdParam, taskIdParam);
DisplayLoginView(userIdParam, taskIdParam
, AMsg
);
end;
procedure UnauthorizedAccessProc(AMessage: string);
begin
ShowAppDialog('UnauthorizedAccessProc: ' + AMessage);
end;
procedure StartApplication;
var
ClientVer: string;
...
...
emT3Web/emT3web.dproj
View file @
30fc30ba
...
...
@@ -140,19 +140,20 @@
<DCCReference Include="Utils.pas"/>
<DCCReference Include="View.TaskItems.pas">
<Form>FTaskItems</Form>
<FormType>dfm</FormType>
<DesignClass>TWebForm</DesignClass>
</DCCReference>
<DCCReference Include="uNameOffCanvas.pas"/>
<DCCReference Include="uDropdownHelpers.pas"/>
<DCCReference Include="View.Login.pas">
<Form>FViewLogin</Form>
<FormType>dfm</FormType>
<DesignClass>TWebForm</DesignClass>
</DCCReference>
<DCCReference Include="View.ErrorPage.pas">
<Form>FViewErrorPage</Form>
<FormType>dfm</FormType>
<DesignClass>TWebForm</DesignClass>
</DCCReference>
<DCCReference Include="View.TimeEntries.pas">
<Form>FTimeEntries</Form>
<DesignClass>TWebForm</DesignClass>
</DCCReference>
<None Include="index.html"/>
...
...
emT3XDataServer/Source/Auth.Service.pas
View file @
30fc30ba
...
...
@@ -20,7 +20,7 @@ type
[
'{9CFD59B2-A832-4F82-82BB-9A25FC93F305}'
]
function
Login
(
userId
,
taskId
,
urlCode
:
string
):
string
;
function
VerifyVersion
(
ClientVersion
:
string
):
TJSONObject
;
function
WebLogin
(
userName
,
taskId
,
password
:
string
):
string
;
function
WebLogin
(
userName
,
loginType
,
loginValue
,
password
:
string
):
string
;
end
;
implementation
...
...
emT3XDataServer/Source/Auth.ServiceImpl.pas
View file @
30fc30ba
...
...
@@ -37,7 +37,8 @@ type
public
function
Login
(
userId
,
taskId
,
urlCode
:
string
):
string
;
function
VerifyVersion
(
ClientVersion
:
string
):
TJSONObject
;
function
WebLogin
(
userName
,
taskId
,
password
:
string
):
string
;
function
WebLogin
(
userName
,
loginType
,
loginValue
,
password
:
string
):
string
;
function
CheckTimeEntriesLogin
(
userName
,
password
:
string
):
Integer
;
end
;
implementation
...
...
@@ -240,16 +241,27 @@ begin
end
;
function
TAuthService
.
WebLogin
(
userName
,
taskId
,
password
:
string
):
string
;
function
TAuthService
.
WebLogin
(
userName
,
loginType
,
loginValue
,
password
:
string
):
string
;
var
userState
:
Integer
;
jwt
:
TJWT
;
begin
Logger
.
Log
(
3
,
Format
(
'AuthService.WebLogin - UserName: %s, TaskID: %s'
,
[
userName
,
taskId
]));
Logger
.
Log
(
3
,
Format
(
'AuthService.WebLogin - UserName: %s, LoginType: %s, LoginValue: %s'
,
[
userName
,
loginType
,
loginValue
]));
try
userState
:=
CheckUserLogin
(
userName
,
taskId
,
password
);
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
);
...
...
@@ -259,9 +271,17 @@ begin
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
...
...
@@ -282,7 +302,7 @@ begin
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_name'
,
Self
.
userName
);
jwt
.
Claims
.
SetClaimOfType
<
string
>(
'user_fullname'
,
userFullName
);
jwt
.
Claims
.
SetClaimOfType
<
string
>(
'user_status'
,
userStatus
);
jwt
.
Claims
.
SetClaimOfType
<
string
>(
'user_email'
,
userEmail
);
...
...
@@ -353,6 +373,72 @@ begin
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
;
...
...
emT3XDataServer/bin/emT3XDataServer.ini
View file @
30fc30ba
...
...
@@ -2,7 +2,7 @@
MemoLogLevel
=
4
FileLogLevel
=
4
webClientVersion
=
0.8.9
LogFileNum
=
1
87
LogFileNum
=
1
90
[Database]
Server
=
192.168.102.131
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment