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
15978bbd
Commit
15978bbd
authored
Apr 09, 2026
by
Mac Stephens
Browse files
Options
Browse Files
Download
Plain Diff
Merge branch 'dev'
parents
5c56b645
8a2f5e16
Hide whitespace changes
Inline
Side-by-side
Showing
11 changed files
with
855 additions
and
246 deletions
+855
-246
ConnectionModule.pas
emT3Web/ConnectionModule.pas
+1
-1
View.TaskItems.pas
emT3Web/View.TaskItems.pas
+234
-51
app.css
emT3Web/css/app.css
+14
-0
emT3web.dproj
emT3Web/emT3web.dproj
+3
-3
uNameManager.pas
emT3Web/uNameManager.pas
+125
-84
Api.Database.dfm
emT3XDataServer/Source/Api.Database.dfm
+224
-66
Api.Database.pas
emT3XDataServer/Source/Api.Database.pas
+12
-5
Api.Service.pas
emT3XDataServer/Source/Api.Service.pas
+25
-2
Api.ServiceImpl.pas
emT3XDataServer/Source/Api.ServiceImpl.pas
+213
-30
emT3XDataServer.ini
emT3XDataServer/bin/emT3XDataServer.ini
+2
-2
emT3XDataServer.dproj
emT3XDataServer/emT3XDataServer.dproj
+2
-2
No files found.
emT3Web/ConnectionModule.pas
View file @
15978bbd
...
...
@@ -20,7 +20,7 @@ type
FUnauthorizedAccessProc
:
TUnauthorizedAccessProc
;
public
const
clientVersion
=
'0.8.
5
'
;
const
clientVersion
=
'0.8.
6
'
;
procedure
InitApp
(
SuccessProc
:
TSuccessProc
;
UnauthorizedAccessProc
:
TUnauthorizedAccessProc
);
procedure
SetClientConfig
(
Callback
:
TVersionCheckCallback
);
...
...
emT3Web/View.TaskItems.pas
View file @
15978bbd
...
...
@@ -77,6 +77,14 @@ type
procedure
EditorKeyDown
(
Event
:
TJSEvent
);
procedure
CaptureTableScroll
;
procedure
RestoreTableScroll
;
[
async
]
function
AddAssignedName
(
const
AName
:
string
):
TJSArray
;
[
async
]
function
RenameAssignedName
(
const
AOldName
,
ANewName
:
string
):
TJSArray
;
[
async
]
function
DeleteAssignedName
(
const
AName
:
string
):
TJSArray
;
function
ExtractAssignedOptionNames
(
const
ResponseResult
:
TJSObject
):
TJSArray
;
[
async
]
procedure
HandleAddAssignedName
(
const
ARowIndex
:
Integer
;
const
ANewName
:
string
);
[
async
]
procedure
HandleRenameAssignedName
(
const
AOldName
,
ANewName
:
string
);
[
async
]
procedure
HandleDeleteAssignedName
(
const
AName
:
string
);
function
FindAssignedOptionIgnoreCase
(
const
AItems
:
TJSArray
;
const
AName
:
string
):
string
;
public
end
;
...
...
@@ -106,13 +114,21 @@ begin
begin
Result
:=
GetOptionsForField
(
AFieldName
);
end
,
procedure
begin
RenderTable
;
end
,
procedure
(
const
ATriggerId
:
string
)
begin
FocusTrigger
(
ATriggerId
);
end
,
procedure
(
const
ARowIndex
:
Integer
;
const
ANewName
:
string
)
begin
HandleAddAssignedName
(
ARowIndex
,
ANewName
);
end
,
procedure
(
const
AOldName
,
ANewName
:
string
)
begin
HandleRenameAssignedName
(
AOldName
,
ANewName
);
end
,
procedure
(
const
AName
:
string
)
begin
HandleDeleteAssignedName
(
AName
);
end
);
...
...
@@ -653,54 +669,57 @@ var
'value="'
+
HtmlEncode
(
Value
)
+
'"'
+
w
+
'>'
;
end
;
function
SelectList
(
const
FieldName
,
Current
:
string
;
const
AIdx
:
Integer
;
const
Items
:
TJSArray
):
string
;
var
i
:
Integer
;
itemText
:
string
;
triggerId
:
string
;
begin
triggerId
:=
'task_dd_'
+
FieldName
+
'_'
+
IntToStr
(
AIdx
);
Result
:=
'<div class="dropdown w-100">'
+
'<button id="'
+
triggerId
+
'" class="btn btn-sm btn-light border w-100 d-flex justify-content-between align-items-center text-start task-dd-toggle" '
+
'type="button" data-bs-toggle="dropdown" aria-expanded="false">'
+
'<span class="task-dd-label text-truncate">'
+
HtmlEncode
(
Current
)
+
'</span>'
+
'<span class="dropdown-toggle dropdown-toggle-split border-0 ms-2"></span>'
+
'</button>'
+
'<div class="dropdown-menu w-100 p-0 overflow-hidden">'
;
function
SelectList
(
const
FieldName
,
Current
:
string
;
const
AIdx
:
Integer
;
const
Items
:
TJSArray
;
const
AllowEdit
:
Boolean
):
string
;
var
i
:
Integer
;
itemText
:
string
;
triggerId
:
string
;
begin
triggerId
:=
'task_dd_'
+
FieldName
+
'_'
+
IntToStr
(
AIdx
);
Result
:=
Result
+
'<button type="button" class="dropdown-item task-dd-item" '
+
'data-idx="'
+
IntToStr
(
AIdx
)
+
'" '
+
'data-field="'
+
FieldName
+
'" '
+
'data-value=""></button>'
;
if
Assigned
(
Items
)
then
for
i
:=
0
to
Items
.
length
-
1
do
begin
itemText
:=
string
(
Items
[
i
]);
Result
:=
Result
+
'<button type="button" class="dropdown-item task-dd-item" '
+
'data-idx="'
+
IntToStr
(
AIdx
)
+
'" '
+
'data-field="'
+
FieldName
+
'" '
+
'data-value="'
+
HtmlEncode
(
itemText
)
+
'" '
+
'data-trigger-id="'
+
triggerId
+
'">'
+
HtmlEncode
(
itemText
)
+
'</button>'
;
end
;
Result
:=
'<div class="dropdown w-100">'
+
'<button id="'
+
triggerId
+
'" class="btn btn-sm btn-light border w-100 d-flex justify-content-between align-items-center text-start task-dd-toggle" '
+
'type="button" data-bs-toggle="dropdown" aria-expanded="false">'
+
'<span class="task-dd-label text-truncate">'
+
HtmlEncode
(
Current
)
+
'</span>'
+
'<span class="dropdown-toggle dropdown-toggle-split border-0 ms-2"></span>'
+
'</button>'
+
'<div class="dropdown-menu w-100 p-0 overflow-hidden">'
;
Result
:=
Result
+
'<button type="button" class="dropdown-item task-dd-item" '
+
'data-idx="'
+
IntToStr
(
AIdx
)
+
'" '
+
'data-field="'
+
FieldName
+
'" '
+
'data-value=""></button>'
;
if
Assigned
(
Items
)
then
for
i
:=
0
to
Items
.
length
-
1
do
begin
itemText
:=
string
(
Items
[
i
]);
Result
:=
Result
+
'<button type="button" class="dropdown-item task-dd-item" '
+
'data-idx="'
+
IntToStr
(
AIdx
)
+
'" '
+
'data-field="'
+
FieldName
+
'" '
+
'data-value="'
+
HtmlEncode
(
itemText
)
+
'" '
+
'data-trigger-id="'
+
triggerId
+
'">'
+
HtmlEncode
(
itemText
)
+
'</button>'
;
end
;
if
AllowEdit
then
Result
:=
Result
+
'<div class="dropdown-divider my-1"></div>'
+
'<div class="px-2 py-1 text-end">'
+
'<button type="button" class="btn btn-link btn-sm p-0 text-body task-dd-edit-btn" '
+
'data-idx="'
+
IntToStr
(
AIdx
)
+
'" '
+
'data-field="'
+
FieldName
+
'" '
+
'data-trigger-id="'
+
triggerId
+
'">'
+
'<i class="fas fa-pencil-alt"></i>'
+
'</button>'
+
'</div>'
+
'</div>'
+
'<div class="dropdown-divider my-1"></div>'
+
'<div class="px-2 py-1 text-end">'
+
'<button type="button" class="btn btn-link btn-sm p-0 text-body task-dd-edit-btn" '
+
'data-idx="'
+
IntToStr
(
AIdx
)
+
'" '
+
'data-field="'
+
FieldName
+
'" '
+
'data-trigger-id="'
+
triggerId
+
'">'
+
'<i class="fas fa-pencil-alt"></i>'
+
'</button>'
+
'</div>'
;
end
;
Result
:=
Result
+
'</div>'
+
'</div>'
;
end
;
function
StatusSelect
(
const
Current
:
string
;
const
AIdx
:
Integer
):
string
;
var
...
...
@@ -735,7 +754,7 @@ begin
html
:=
'<div class="tasks-vscroll">'
+
'<div class="tasks-hscroll">'
+
'<table class="table table-sm table-bordered align-middle mb-0" style="min-width:
20
00px;">'
+
'<table class="table table-sm table-bordered align-middle mb-0" style="min-width:
17
00px;">'
+
'<colgroup>'
+
'<col style="width:40px">'
+
// Item Num
'<col style="width:200px">'
+
// App
...
...
@@ -773,8 +792,8 @@ begin
TdNowrap
(
TextInput
(
'application'
,
xdwdsTasksapplication
.
AsString
,
rowIdx
,
180
))
+
TdNowrap
(
TextInput
(
'version'
,
xdwdsTasksversion
.
AsString
,
rowIdx
,
80
))
+
TdNowrap
(
DateInput
(
'taskDate'
,
xdwdsTaskstaskDate
.
AsString
,
rowIdx
,
110
))
+
TdNowrap
(
SelectList
(
'reportedBy'
,
xdwdsTasksreportedBy
.
AsString
,
rowIdx
,
FReportedByOptions
))
+
TdNowrap
(
SelectList
(
'assignedTo'
,
xdwdsTasksassignedTo
.
AsString
,
rowIdx
,
FAssignedToOptions
))
+
TdNowrap
(
SelectList
(
'reportedBy'
,
xdwdsTasksreportedBy
.
AsString
,
rowIdx
,
FReportedByOptions
,
False
))
+
TdNowrap
(
SelectList
(
'assignedTo'
,
xdwdsTasksassignedTo
.
AsString
,
rowIdx
,
FAssignedToOptions
,
True
))
+
TdNowrap
(
StatusSelect
(
xdwdsTasksstatus
.
AsString
,
rowIdx
))
+
TdNowrap
(
DateInput
(
'statusDate'
,
xdwdsTasksstatusDate
.
AsString
,
rowIdx
,
110
))
+
TdNowrap
(
TextInput
(
'formSection'
,
xdwdsTasksformSection
.
AsString
,
rowIdx
,
160
))
+
...
...
@@ -1119,6 +1138,9 @@ begin
if
(
idx
<
0
)
or
(
fieldName
=
''
)
then
Exit
;
if
not
SameText
(
fieldName
,
'assignedTo'
)
then
Exit
;
FNameManager
.
OpenManager
(
fieldName
,
idx
,
triggerId
);
end
;
...
...
@@ -1213,6 +1235,167 @@ begin
end
;
function
TFTaskItems
.
ExtractAssignedOptionNames
(
const
ResponseResult
:
TJSObject
):
TJSArray
;
begin
if
not
Assigned
(
ResponseResult
)
then
Exit
(
TJSArray
.
new
);
Result
:=
ExtractOptionNames
(
TJSArray
(
ResponseResult
[
'assignedToOptions'
]));
end
;
[
async
]
function
TFTaskItems
.
AddAssignedName
(
const
AName
:
string
):
TJSArray
;
var
response
:
TXDataClientResponse
;
resultObj
:
TJSObject
;
begin
Result
:=
nil
;
try
response
:=
await
(
xdwcTasks
.
RawInvokeAsync
(
'IApiService.AddAssignedName'
,
[
FTaskId
,
Trim
(
AName
)]
));
resultObj
:=
TJSObject
(
response
.
Result
);
Result
:=
ExtractAssignedOptionNames
(
resultObj
);
FAssignedToOptions
:=
Result
;
except
on
E
:
EXDataClientRequestException
do
begin
console
.
log
(
'AddAssignedName ERROR: '
+
E
.
ErrorResult
.
ErrorMessage
);
Utils
.
ShowErrorModal
(
E
.
ErrorResult
.
ErrorMessage
);
Exit
;
end
;
end
;
end
;
[
async
]
function
TFTaskItems
.
RenameAssignedName
(
const
AOldName
,
ANewName
:
string
):
TJSArray
;
var
response
:
TXDataClientResponse
;
resultObj
:
TJSObject
;
begin
Result
:=
nil
;
try
response
:=
await
(
xdwcTasks
.
RawInvokeAsync
(
'IApiService.RenameAssignedName'
,
[
FTaskId
,
Trim
(
AOldName
),
Trim
(
ANewName
)]
));
resultObj
:=
TJSObject
(
response
.
Result
);
Result
:=
ExtractAssignedOptionNames
(
resultObj
);
FAssignedToOptions
:=
Result
;
except
on
E
:
EXDataClientRequestException
do
begin
console
.
log
(
'RenameAssignedName ERROR: '
+
E
.
ErrorResult
.
ErrorMessage
);
Utils
.
ShowErrorModal
(
E
.
ErrorResult
.
ErrorMessage
);
Exit
;
end
;
end
;
end
;
[
async
]
function
TFTaskItems
.
DeleteAssignedName
(
const
AName
:
string
):
TJSArray
;
var
response
:
TXDataClientResponse
;
resultObj
:
TJSObject
;
begin
Result
:=
nil
;
try
response
:=
await
(
xdwcTasks
.
RawInvokeAsync
(
'IApiService.DeleteAssignedName'
,
[
FTaskId
,
Trim
(
AName
)]
));
resultObj
:=
TJSObject
(
response
.
Result
);
Result
:=
ExtractAssignedOptionNames
(
resultObj
);
FAssignedToOptions
:=
Result
;
except
on
E
:
EXDataClientRequestException
do
begin
console
.
log
(
'DeleteAssignedName ERROR: '
+
E
.
ErrorResult
.
ErrorMessage
);
Utils
.
ShowErrorModal
(
E
.
ErrorResult
.
ErrorMessage
);
Exit
;
end
;
end
;
end
;
function
TFTaskItems
.
FindAssignedOptionIgnoreCase
(
const
AItems
:
TJSArray
;
const
AName
:
string
):
string
;
var
i
:
Integer
;
itemText
:
string
;
begin
Result
:=
''
;
if
not
Assigned
(
AItems
)
then
Exit
;
for
i
:=
0
to
AItems
.
length
-
1
do
begin
itemText
:=
string
(
AItems
[
i
]);
if
SameText
(
itemText
,
Trim
(
AName
))
then
Exit
(
itemText
);
end
;
end
;
[
async
]
procedure
TFTaskItems
.
HandleAddAssignedName
(
const
ARowIndex
:
Integer
;
const
ANewName
:
string
);
var
newOptions
:
TJSArray
;
resolvedName
:
string
;
begin
newOptions
:=
await
(
AddAssignedName
(
ANewName
));
if
not
Assigned
(
newOptions
)
then
Exit
;
FAssignedToOptions
:=
newOptions
;
resolvedName
:=
FindAssignedOptionIgnoreCase
(
FAssignedToOptions
,
ANewName
);
if
resolvedName
=
''
then
resolvedName
:=
Trim
(
ANewName
);
if
not
xdwdsTasks
.
Active
then
Exit
;
GotoRowIndex
(
ARowIndex
);
if
xdwdsTasks
.
Eof
then
Exit
;
xdwdsTasks
.
Edit
;
xdwdsTasksassignedTo
.
AsString
:=
resolvedName
;
xdwdsTasks
.
Post
;
RenderTable
;
await
(
SaveRow
(
ARowIndex
));
end
;
[
async
]
procedure
TFTaskItems
.
HandleRenameAssignedName
(
const
AOldName
,
ANewName
:
string
);
var
newOptions
:
TJSArray
;
begin
newOptions
:=
await
(
RenameAssignedName
(
AOldName
,
ANewName
));
if
not
Assigned
(
newOptions
)
then
Exit
;
FAssignedToOptions
:=
newOptions
;
CaptureTableScroll
;
LoadTasks
(
FTaskId
);
end
;
[
async
]
procedure
TFTaskItems
.
HandleDeleteAssignedName
(
const
AName
:
string
);
var
newOptions
:
TJSArray
;
begin
newOptions
:=
await
(
DeleteAssignedName
(
AName
));
if
not
Assigned
(
newOptions
)
then
Exit
;
FAssignedToOptions
:=
newOptions
;
CaptureTableScroll
;
LoadTasks
(
FTaskId
);
end
;
end
.
...
...
emT3Web/css/app.css
View file @
15978bbd
...
...
@@ -72,5 +72,19 @@ 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
;
}
emT3Web/emT3web.dproj
View file @
15978bbd
...
...
@@ -94,13 +94,13 @@
<DCC_RemoteDebug>false</DCC_RemoteDebug>
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
<VerInfo_Locale>1033</VerInfo_Locale>
<VerInfo_Keys>CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=0.8.
5
.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.8.
6
.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=0.9.8.0;Comments=;LastCompiledTime=2018/08/27 15:18:29</VerInfo_Keys>
<AppDPIAwarenessMode>PerMonitor</AppDPIAwarenessMode>
<VerInfo_MajorVer>0</VerInfo_MajorVer>
<VerInfo_MinorVer>8</VerInfo_MinorVer>
<VerInfo_Release>5</VerInfo_Release>
<TMSWebBrowser>1</TMSWebBrowser>
<VerInfo_Release>6</VerInfo_Release>
<TMSUseJSDebugger>2</TMSUseJSDebugger>
<TMSWebBrowser>1</TMSWebBrowser>
<TMSWebSingleInstance>1</TMSWebSingleInstance>
<TMSWebOutputPath>..\emT3XDataServer\bin\static</TMSWebOutputPath>
</PropertyGroup>
...
...
emT3Web/uNameManager.pas
View file @
15978bbd
...
...
@@ -7,23 +7,29 @@ uses
type
TGetOptionsEvent
=
reference
to
function
(
const
AFieldName
:
string
):
TJSArray
;
TRenderTableEvent
=
reference
to
procedure
;
TFocusTriggerEvent
=
reference
to
procedure
(
const
ATriggerId
:
string
);
TAddAssignedNameEvent
=
reference
to
procedure
(
const
ARowIndex
:
Integer
;
const
ANewName
:
string
);
TRenameAssignedNameEvent
=
reference
to
procedure
(
const
AOldName
,
ANewName
:
string
);
TDeleteAssignedNameEvent
=
reference
to
procedure
(
const
AName
:
string
);
TNameManager
=
class
private
FCurrentField
:
string
;
FCurrentRowIndex
:
Integer
;
FCurrentTriggerId
:
string
;
FCurrentEditName
:
string
;
FGetOptions
:
TGetOptionsEvent
;
FRenderTable
:
TRenderTableEvent
;
FFocusTrigger
:
TFocusTriggerEvent
;
FAddAssignedName
:
TAddAssignedNameEvent
;
FRenameAssignedName
:
TRenameAssignedNameEvent
;
FDeleteAssignedName
:
TDeleteAssignedNameEvent
;
procedure
AddAnotherClick
(
Event
:
TJSEvent
);
procedure
SaveClick
(
Event
:
TJSEvent
);
procedure
NameInputKeyDown
(
Event
:
TJSEvent
);
procedure
OffcanvasHidden
(
Event
:
TJSEvent
);
procedure
ExistingEditClick
(
Event
:
TJSEvent
);
procedure
ExistingDeleteClick
(
Event
:
TJSEvent
);
function
GetOptionsForField
(
const
AFieldName
:
string
):
TJSArray
;
function
HasExactOption
(
const
AItems
:
TJSArray
;
const
AValue
:
string
):
Boolean
;
procedure
ResetInputArea
;
procedure
ShowValidation
(
const
AMessage
:
string
);
procedure
RenderExistingList
;
...
...
@@ -33,8 +39,10 @@ type
public
constructor
Create
(
const
AGetOptions
:
TGetOptionsEvent
;
const
ARenderTable
:
TRenderTableEvent
;
const
AFocusTrigger
:
TFocusTriggerEvent
const
AFocusTrigger
:
TFocusTriggerEvent
;
const
AAddAssignedName
:
TAddAssignedNameEvent
;
const
ARenameAssignedName
:
TRenameAssignedNameEvent
;
const
ADeleteAssignedName
:
TDeleteAssignedNameEvent
);
procedure
BindControls
;
...
...
@@ -44,22 +52,6 @@ type
implementation
constructor
TNameManager
.
Create
(
const
AGetOptions
:
TGetOptionsEvent
;
const
ARenderTable
:
TRenderTableEvent
;
const
AFocusTrigger
:
TFocusTriggerEvent
);
begin
inherited
Create
;
FGetOptions
:=
AGetOptions
;
FRenderTable
:=
ARenderTable
;
FFocusTrigger
:=
AFocusTrigger
;
FCurrentField
:=
''
;
FCurrentRowIndex
:=
-
1
;
FCurrentTriggerId
:=
''
;
end
;
function
HtmlEncode
(
const
s
:
string
):
string
;
begin
Result
:=
s
;
...
...
@@ -70,12 +62,30 @@ begin
Result
:=
StringReplace
(
Result
,
''''
,
'''
,
[
rfReplaceAll
]);
end
;
function
GetElement
(
const
AId
:
string
):
TJSHTMLElement
;
begin
Result
:=
TJSHTMLElement
(
document
.
getElementById
(
AId
));
end
;
constructor
TNameManager
.
Create
(
const
AGetOptions
:
TGetOptionsEvent
;
const
AFocusTrigger
:
TFocusTriggerEvent
;
const
AAddAssignedName
:
TAddAssignedNameEvent
;
const
ARenameAssignedName
:
TRenameAssignedNameEvent
;
const
ADeleteAssignedName
:
TDeleteAssignedNameEvent
);
begin
inherited
Create
;
FGetOptions
:=
AGetOptions
;
FFocusTrigger
:=
AFocusTrigger
;
FAddAssignedName
:=
AAddAssignedName
;
FRenameAssignedName
:=
ARenameAssignedName
;
FDeleteAssignedName
:=
ADeleteAssignedName
;
FCurrentField
:=
''
;
FCurrentRowIndex
:=
-
1
;
FCurrentTriggerId
:=
''
;
FCurrentEditName
:=
''
;
end
;
function
TNameManager
.
GetOptionsForField
(
const
AFieldName
:
string
):
TJSArray
;
begin
...
...
@@ -85,24 +95,6 @@ begin
Result
:=
nil
;
end
;
function
TNameManager
.
HasExactOption
(
const
AItems
:
TJSArray
;
const
AValue
:
string
):
Boolean
;
var
i
:
Integer
;
begin
Result
:=
False
;
if
not
Assigned
(
AItems
)
then
Exit
;
for
i
:=
0
to
AItems
.
length
-
1
do
begin
if
string
(
AItems
[
i
])
=
AValue
then
Exit
(
True
);
end
;
end
;
procedure
TNameManager
.
ResetInputArea
;
var
addWrap
:
TJSHTMLElement
;
...
...
@@ -115,6 +107,8 @@ begin
inputEl
:=
TJSHTMLInputElement
(
document
.
getElementById
(
'nm_name_input'
));
invalidEl
:=
GetElement
(
'nm_name_invalid'
);
FCurrentEditName
:=
''
;
if
Assigned
(
addWrap
)
then
addWrap
.
classList
.
add
(
'd-none'
);
...
...
@@ -137,7 +131,6 @@ begin
end
;
end
;
procedure
TNameManager
.
ShowValidation
(
const
AMessage
:
string
);
var
inputEl
:
TJSHTMLInputElement
;
...
...
@@ -159,7 +152,6 @@ begin
end
;
end
;
procedure
TNameManager
.
RenderExistingList
;
var
listEl
:
TJSHTMLElement
;
...
...
@@ -167,6 +159,9 @@ var
i
:
Integer
;
itemText
:
string
;
html
:
string
;
editButtons
:
TJSNodeList
;
deleteButtons
:
TJSNodeList
;
btnEl
:
TJSHTMLElement
;
begin
listEl
:=
GetElement
(
'nm_existing_list'
);
if
not
Assigned
(
listEl
)
then
...
...
@@ -174,11 +169,6 @@ begin
items
:=
GetOptionsForField
(
FCurrentField
);
if
Assigned
(
items
)
then
console
.
log
(
'NameManager.RenderExistingList field='
+
FCurrentField
+
' count='
+
IntToStr
(
items
.
length
))
else
console
.
log
(
'NameManager.RenderExistingList field='
+
FCurrentField
+
' count=0'
);
html
:=
''
;
if
Assigned
(
items
)
then
begin
...
...
@@ -186,15 +176,36 @@ begin
begin
itemText
:=
string
(
items
[
i
]);
html
:=
html
+
'<div class="list-group-item disabled text-body bg-body-tertiary">'
+
HtmlEncode
(
itemText
)
+
'<div class="list-group-item d-flex justify-content-between align-items-center">'
+
'<span>'
+
HtmlEncode
(
itemText
)
+
'</span>'
+
'<span class="d-flex gap-2">'
+
'<button type="button" class="btn btn-link btn-sm p-0 text-body nm-edit-existing" data-name="'
+
HtmlEncode
(
itemText
)
+
'">'
+
'<i class="fas fa-pencil-alt"></i>'
+
'</button>'
+
'<button type="button" class="btn btn-link btn-sm p-0 text-danger nm-delete-existing" data-name="'
+
HtmlEncode
(
itemText
)
+
'">'
+
'<i class="fas fa-trash-alt"></i>'
+
'</button>'
+
'</span>'
+
'</div>'
;
end
;
end
;
listEl
.
innerHTML
:=
html
;
end
;
editButtons
:=
listEl
.
querySelectorAll
(
'.nm-edit-existing'
);
for
i
:=
0
to
editButtons
.
length
-
1
do
begin
btnEl
:=
TJSHTMLElement
(
editButtons
.
item
(
i
));
btnEl
.
addEventListener
(
'click'
,
TJSEventHandler
(@
ExistingEditClick
));
end
;
deleteButtons
:=
listEl
.
querySelectorAll
(
'.nm-delete-existing'
);
for
i
:=
0
to
deleteButtons
.
length
-
1
do
begin
btnEl
:=
TJSHTMLElement
(
deleteButtons
.
item
(
i
));
btnEl
.
addEventListener
(
'click'
,
TJSEventHandler
(@
ExistingDeleteClick
));
end
;
end
;
procedure
TNameManager
.
ShowAddArea
;
var
...
...
@@ -202,8 +213,6 @@ var
addButton
:
TJSHTMLButtonElement
;
inputEl
:
TJSHTMLInputElement
;
begin
console
.
log
(
'NameManager.ShowAddArea field='
+
FCurrentField
);
addWrap
:=
GetElement
(
'nm_add_wrap'
);
addButton
:=
TJSHTMLButtonElement
(
document
.
getElementById
(
'btn_nm_add_another'
));
inputEl
:=
TJSHTMLInputElement
(
document
.
getElementById
(
'nm_name_input'
));
...
...
@@ -221,10 +230,8 @@ begin
inputEl
.
focus
;
end
;
procedure
TNameManager
.
HandleAddClick
;
var
items
:
TJSArray
;
inputEl
:
TJSHTMLInputElement
;
invalidEl
:
TJSHTMLElement
;
newName
:
string
;
...
...
@@ -237,8 +244,6 @@ begin
newName
:=
Trim
(
string
(
inputEl
.
value
));
console
.
log
(
'NameManager.HandleAddClick field='
+
FCurrentField
+
'" trimmed="'
+
newName
+
'"'
);
inputEl
.
classList
.
remove
(
'is-invalid'
);
if
Assigned
(
invalidEl
)
then
begin
...
...
@@ -252,28 +257,23 @@ begin
Exit
;
end
;
items
:=
GetOptionsForField
(
FCurrentField
);
if
not
Assigned
(
items
)
then
if
not
SameText
(
FCurrentField
,
'assignedTo'
)
then
Exit
;
if
HasExactOption
(
items
,
newName
)
then
if
FCurrentEditName
<>
''
then
begin
console
.
log
(
'NameManager.DuplicateName field='
+
FCurrentField
+
' value="'
+
newName
+
'"'
);
ShowValidation
(
'This name already exists.'
);
Exit
;
if
Assigned
(
FRenameAssignedName
)
then
FRenameAssignedName
(
FCurrentEditName
,
newName
);
end
else
begin
if
Assigned
(
FAddAssignedName
)
then
FAddAssignedName
(
FCurrentRowIndex
,
newName
);
end
;
items
.
push
(
newName
);
console
.
log
(
'NameManager.AddedName field='
+
FCurrentField
+
' value="'
+
newName
+
'" newCount='
+
IntToStr
(
items
.
length
));
if
Assigned
(
FRenderTable
)
then
FRenderTable
;
CloseManager
;
end
;
procedure
TNameManager
.
BindControls
;
var
el
:
TJSHTMLElement
;
...
...
@@ -319,21 +319,18 @@ begin
end
;
end
;
procedure
TNameManager
.
AddAnotherClick
(
Event
:
TJSEvent
);
begin
Event
.
preventDefault
;
ShowAddArea
;
end
;
procedure
TNameManager
.
SaveClick
(
Event
:
TJSEvent
);
begin
Event
.
preventDefault
;
HandleAddClick
;
end
;
procedure
TNameManager
.
NameInputKeyDown
(
Event
:
TJSEvent
);
var
keyEvent
:
TJSKeyboardEvent
;
...
...
@@ -346,33 +343,78 @@ begin
end
;
end
;
procedure
TNameManager
.
OffcanvasHidden
(
Event
:
TJSEvent
);
begin
HandleHidden
;
end
;
procedure
TNameManager
.
ExistingEditClick
(
Event
:
TJSEvent
);
var
el
:
TJSHTMLElement
;
inputEl
:
TJSHTMLInputElement
;
begin
Event
.
preventDefault
;
Event
.
stopPropagation
;
if
not
SameText
(
FCurrentField
,
'assignedTo'
)
then
Exit
;
el
:=
TJSHTMLElement
(
Event
.
currentTarget
);
FCurrentEditName
:=
string
(
el
.
getAttribute
(
'data-name'
));
ShowAddArea
;
inputEl
:=
TJSHTMLInputElement
(
document
.
getElementById
(
'nm_name_input'
));
if
Assigned
(
inputEl
)
then
begin
inputEl
.
value
:=
FCurrentEditName
;
inputEl
.
focus
;
asm
inputEl
.
select
();
end
;
end
;
end
;
procedure
TNameManager
.
ExistingDeleteClick
(
Event
:
TJSEvent
);
var
el
:
TJSHTMLElement
;
nameToDelete
:
string
;
begin
Event
.
preventDefault
;
Event
.
stopPropagation
;
if
not
SameText
(
FCurrentField
,
'assignedTo'
)
then
Exit
;
el
:=
TJSHTMLElement
(
Event
.
currentTarget
);
nameToDelete
:=
string
(
el
.
getAttribute
(
'data-name'
));
if
nameToDelete
=
''
then
Exit
;
if
Assigned
(
FDeleteAssignedName
)
then
FDeleteAssignedName
(
nameToDelete
);
CloseManager
;
end
;
procedure
TNameManager
.
OpenManager
(
const
AFieldName
:
string
;
const
ARowIndex
:
Integer
;
const
ATriggerId
:
string
);
var
titleEl
:
TJSHTMLElement
;
begin
console
.
log
(
'NameManager.OpenManager field='
+
AFieldName
+
' row='
+
IntToStr
(
ARowIndex
));
if
not
SameText
(
AFieldName
,
'assignedTo'
)
then
Exit
;
FCurrentField
:=
AFieldName
;
FCurrentRowIndex
:=
ARowIndex
;
FCurrentTriggerId
:=
ATriggerId
;
FCurrentEditName
:=
''
;
titleEl
:=
GetElement
(
'nm_title'
);
if
Assigned
(
titleEl
)
then
begin
if
SameText
(
AFieldName
,
'reportedBy'
)
then
titleEl
.
innerHTML
:=
'Add Reported By'
else
titleEl
.
innerHTML
:=
'Add Assigned To'
;
end
;
titleEl
.
innerHTML
:=
'Manage Assigned To'
;
RenderExistingList
;
ResetInputArea
;
RenderExistingList
;
asm
var
el
=
document
.
getElementById
(
'offcanvasNameManager'
);
...
...
@@ -383,7 +425,6 @@ begin
end
;
end
;
procedure
TNameManager
.
CloseManager
;
begin
asm
...
...
@@ -395,7 +436,6 @@ begin
end
;
end
;
procedure
TNameManager
.
HandleHidden
;
begin
ResetInputArea
;
...
...
@@ -406,6 +446,7 @@ begin
FCurrentField
:=
''
;
FCurrentRowIndex
:=
-
1
;
FCurrentTriggerId
:=
''
;
FCurrentEditName
:=
''
;
end
;
end
.
emT3XDataServer/Source/Api.Database.dfm
View file @
15978bbd
object ApiDatabase: TApiDatabase
OnCreate = DataModuleCreate
Height =
358
Width =
519
Height =
453
Width =
641
object ucETaskApi: TUniConnection
AutoCommit = False
ProviderName = 'MySQL'
Database = 'eTask'
LoginPrompt = False
Left =
51
Top =
67
Left =
255
Top =
379
end
object MySQLUniProvider1: TMySQLUniProvider
Left =
56
Top =
14
Left =
354
Top =
378
end
object uqUsers: TUniQuery
Connection = ucETaskApi
SQL.Strings = (
'SELECT USER_ID, NAME, STATUS from users ORDER BY NAME')
OnCalcFields = uqUsersCalcFields
Left =
40
8
Top = 2
0
Left =
53
8
Top = 2
4
object uqUsersUSER_ID: TIntegerField
FieldName = 'USER_ID'
Required = True
...
...
@@ -56,8 +56,8 @@ object ApiDatabase: TApiDatabase
' ISSUE = :ISSUE,'
' NOTES = :NOTES'
'WHERE TASK_ITEM_ID = :TASK_ITEM_ID')
Left =
40
8
Top = 2
4
2
Left =
53
8
Top = 2
3
2
ParamData = <
item
DataType = ftUnknown
...
...
@@ -141,8 +141,8 @@ object ApiDatabase: TApiDatabase
'from task_items'
'where TASK_ID = :TASK_ID'
'order by ITEM_NUM')
Left =
62
Top =
138
Left =
56
Top =
26
ParamData = <
item
DataType = ftUnknown
...
...
@@ -248,8 +248,8 @@ object ApiDatabase: TApiDatabase
' '#39#39','
' '#39#39
')')
Left =
412
Top =
300
Left =
536
Top =
282
ParamData = <
item
DataType = ftUnknown
...
...
@@ -281,8 +281,8 @@ object ApiDatabase: TApiDatabase
'left join project p'
' on p.PROJECT_ID = t.PROJECT_ID'
'where t.TASK_ID = :TASK_ID')
Left =
60
Top =
24
2
Left =
54
Top =
8
2
ParamData = <
item
DataType = ftUnknown
...
...
@@ -330,46 +330,6 @@ object ApiDatabase: TApiDatabase
Size = 30
end
end
object uqTaskItemUsers: TUniQuery
Connection = ucETaskApi
SQL.Strings = (
'select'
' TASK_ITEM_USER_ID,'
' TASK_ID,'
' USER_TYPE,'
' NAME'
'from task_item_user'
'where TASK_ID = :TASK_ID'
'order by USER_TYPE, NAME')
Left = 62
Top = 188
ParamData = <
item
DataType = ftUnknown
Name = 'TASK_ID'
Value = nil
end>
object uqTaskItemUsersTASK_ITEM_USER_ID: TStringField
FieldName = 'TASK_ITEM_USER_ID'
Required = True
Size = 50
end
object uqTaskItemUsersTASK_ID: TStringField
FieldName = 'TASK_ID'
Required = True
Size = 7
end
object uqTaskItemUsersUSER_TYPE: TStringField
FieldName = 'USER_TYPE'
Required = True
Size = 8
end
object uqTaskItemUsersNAME: TStringField
FieldName = 'NAME'
Required = True
Size = 50
end
end
object uqTaskItemCodes: TUniQuery
Connection = ucETaskApi
SQL.Strings = (
...
...
@@ -381,7 +341,7 @@ object ApiDatabase: TApiDatabase
'WHERE CODE_TYPE = '#39'STATUS'#39
'ORDER BY CODE')
Left = 60
Top =
296
Top =
140
object uqTaskItemCodesCODE: TStringField
FieldName = 'CODE'
Required = True
...
...
@@ -521,7 +481,7 @@ object ApiDatabase: TApiDatabase
'where TASK_ITEM_ID = :TASK_ITEM_ID'
' and TASK_ID = :TASK_ID')
Left = 234
Top = 2
3
2
Top = 2
4
2
ParamData = <
item
DataType = ftUnknown
...
...
@@ -546,8 +506,8 @@ object ApiDatabase: TApiDatabase
' coalesce(max(ITEM_NUM), 0) as MAX_ITEM_NUM'
'from task_items'
'where TASK_ID = :TASK_ID')
Left = 23
6
Top = 29
0
Left = 23
4
Top = 29
6
ParamData = <
item
DataType = ftUnknown
...
...
@@ -561,8 +521,8 @@ object ApiDatabase: TApiDatabase
'delete from task_items'
'where TASK_ITEM_ID = :TASK_ITEM_ID'
' and TASK_ID = :TASK_ID')
Left =
408
Top = 18
2
Left =
536
Top = 18
0
ParamData = <
item
DataType = ftUnknown
...
...
@@ -582,8 +542,8 @@ object ApiDatabase: TApiDatabase
'set ITEM_NUM = ITEM_NUM - 1'
'where TASK_ID = :TASK_ID'
' and ITEM_NUM > :OLD_ITEM_NUM')
Left =
408
Top = 1
30
Left =
536
Top = 1
26
ParamData = <
item
DataType = ftUnknown
...
...
@@ -603,8 +563,8 @@ object ApiDatabase: TApiDatabase
'set ITEM_NUM = ITEM_NUM + 1'
'where TASK_ID = :TASK_ID'
' and ITEM_NUM > :INSERT_AFTER_ITEM_NUM')
Left =
40
8
Top =
80
Left =
53
8
Top =
76
ParamData = <
item
DataType = ftUnknown
...
...
@@ -617,4 +577,202 @@ object ApiDatabase: TApiDatabase
Value = nil
end>
end
object uqProjectReportedUsers: TUniQuery
Connection = ucETaskApi
SQL.Strings = (
'select distinct'
' tiu.NAME'
'from task_item_user tiu'
'join tasks project_tasks'
' on project_tasks.TASK_ID = tiu.TASK_ID'
'join tasks target_task'
' on target_task.PROJECT_ID = project_tasks.PROJECT_ID'
'where target_task.TASK_ID = :TASK_ID'
' and tiu.USER_TYPE = '#39'Reported'#39
'order by tiu.NAME')
Left = 58
Top = 256
ParamData = <
item
DataType = ftUnknown
Name = 'TASK_ID'
Value = nil
end>
object uqProjectReportedUsersNAME: TStringField
FieldName = 'NAME'
Required = True
Size = 50
end
end
object uqTaskAssignedUsers: TUniQuery
Connection = ucETaskApi
SQL.Strings = (
'select distinct'
' TASK_ITEM_USER_ID,'
' TASK_ID,'
' USER_TYPE,'
' NAME'
'from task_item_user'
'where TASK_ID = :TASK_ID'
' and USER_TYPE = '#39'Assigned'#39
'order by NAME')
Left = 60
Top = 200
ParamData = <
item
DataType = ftUnknown
Name = 'TASK_ID'
Value = nil
end>
object uqTaskAssignedUsersTASK_ITEM_USER_ID: TStringField
FieldName = 'TASK_ITEM_USER_ID'
Required = True
Size = 50
end
object uqTaskAssignedUsersTASK_ID: TStringField
FieldName = 'TASK_ID'
Required = True
Size = 7
end
object uqTaskAssignedUsersUSER_TYPE: TStringField
FieldName = 'USER_TYPE'
Required = True
Size = 8
end
object uqTaskAssignedUsersNAME: TStringField
FieldName = 'NAME'
Required = True
Size = 50
end
end
object uqAssignedInsert: TUniQuery
Connection = ucETaskApi
SQL.Strings = (
'insert into task_item_user ('
' TASK_ITEM_USER_ID,'
' TASK_ID,'
' USER_TYPE,'
' NAME'
')'
'values ('
' :TASK_ITEM_USER_ID,'
' :TASK_ID,'
' '#39'Assigned'#39','
' :NAME'
')')
Left = 382
Top = 24
ParamData = <
item
DataType = ftUnknown
Name = 'TASK_ITEM_USER_ID'
Value = nil
end
item
DataType = ftUnknown
Name = 'TASK_ID'
Value = nil
end
item
DataType = ftUnknown
Name = 'NAME'
Value = nil
end>
end
object uqAssignedRename: TUniQuery
LocalUpdate = True
Connection = ucETaskApi
SQL.Strings = (
'update task_item_user'
'set NAME = :NEW_NAME'
'where TASK_ITEM_USER_ID = :TASK_ITEM_USER_ID'
' and TASK_ID = :TASK_ID'
' and USER_TYPE = '#39'Assigned'#39)
Left = 382
Top = 84
ParamData = <
item
DataType = ftUnknown
Name = 'NEW_NAME'
Value = nil
end
item
DataType = ftUnknown
Name = 'TASK_ITEM_USER_ID'
Value = nil
end
item
DataType = ftUnknown
Name = 'TASK_ID'
Value = nil
end>
end
object uqAssignedDelete: TUniQuery
Connection = ucETaskApi
SQL.Strings = (
'delete from task_item_user'
'where TASK_ITEM_USER_ID = :TASK_ITEM_USER_ID'
' and TASK_ID = :TASK_ID'
' and USER_TYPE = '#39'Assigned'#39)
Left = 384
Top = 140
ParamData = <
item
DataType = ftUnknown
Name = 'TASK_ITEM_USER_ID'
Value = nil
end
item
DataType = ftUnknown
Name = 'TASK_ID'
Value = nil
end>
end
object uqRenameAssignedTo: TUniQuery
Connection = ucETaskApi
SQL.Strings = (
'update task_items'
'set ASSIGNED_TO = :NEW_NAME'
'where TASK_ID = :TASK_ID'
' and lower(ASSIGNED_TO) = lower(:OLD_NAME)')
Left = 386
Top = 196
ParamData = <
item
DataType = ftUnknown
Name = 'NEW_NAME'
Value = nil
end
item
DataType = ftUnknown
Name = 'TASK_ID'
Value = nil
end
item
DataType = ftUnknown
Name = 'OLD_NAME'
Value = nil
end>
end
object uqBlankAssignedTo: TUniQuery
Connection = ucETaskApi
SQL.Strings = (
'update task_items'
'set ASSIGNED_TO = '#39#39
'where TASK_ID = :TASK_ID'
' and lower(ASSIGNED_TO) = lower(:NAME)')
Left = 388
Top = 254
ParamData = <
item
DataType = ftUnknown
Name = 'TASK_ID'
Value = nil
end
item
DataType = ftUnknown
Name = 'NAME'
Value = nil
end>
end
end
emT3XDataServer/Source/Api.Database.pas
View file @
15978bbd
...
...
@@ -44,11 +44,6 @@ type
uqTaskHeaderPROJECT_ID
:
TStringField
;
uqTaskHeaderSUBJECT
:
TStringField
;
uqTaskHeaderPROJECT_NAME
:
TStringField
;
uqTaskItemUsers
:
TUniQuery
;
uqTaskItemUsersTASK_ITEM_USER_ID
:
TStringField
;
uqTaskItemUsersTASK_ID
:
TStringField
;
uqTaskItemUsersUSER_TYPE
:
TStringField
;
uqTaskItemUsersNAME
:
TStringField
;
uqTaskItemCodes
:
TUniQuery
;
uqTaskItemCodesCODE
:
TStringField
;
uqTaskItemCodesCODE_DESC
:
TStringField
;
...
...
@@ -66,6 +61,18 @@ type
uqDeleteTaskRow
:
TUniQuery
;
uqShiftTaskRowsAfterDelete
:
TUniQuery
;
uqShiftTaskRowsForInsert
:
TUniQuery
;
uqProjectReportedUsers
:
TUniQuery
;
uqTaskAssignedUsers
:
TUniQuery
;
uqAssignedInsert
:
TUniQuery
;
uqAssignedRename
:
TUniQuery
;
uqAssignedDelete
:
TUniQuery
;
uqRenameAssignedTo
:
TUniQuery
;
uqBlankAssignedTo
:
TUniQuery
;
uqProjectReportedUsersNAME
:
TStringField
;
uqTaskAssignedUsersTASK_ITEM_USER_ID
:
TStringField
;
uqTaskAssignedUsersTASK_ID
:
TStringField
;
uqTaskAssignedUsersUSER_TYPE
:
TStringField
;
uqTaskAssignedUsersNAME
:
TStringField
;
procedure
DataModuleCreate
(
Sender
:
TObject
);
procedure
uqUsersCalcFields
(
DataSet
:
TDataSet
);
private
...
...
emT3XDataServer/Source/Api.Service.pas
View file @
15978bbd
...
...
@@ -26,7 +26,7 @@ type
reportedBy
:
string
;
assignedTo
:
string
;
status
:
string
;
statusDate
:
Variant
;
statusDate
:
TDateTime
;
fixedVersion
:
string
;
formSection
:
string
;
issue
:
string
;
...
...
@@ -68,6 +68,13 @@ type
destructor
Destroy
;
override
;
end
;
TTaskUserOptionsResponse
=
class
public
assignedToOptions
:
TList
<
TTaskUserOption
>;
constructor
Create
;
destructor
Destroy
;
override
;
end
;
TTaskRowSave
=
class
public
taskItemId
:
integer
;
...
...
@@ -87,6 +94,8 @@ type
end
;
type
[
ServiceContract
,
Model
(
API_MODEL
)]
IApiService
=
interface
(
IInvokable
)
...
...
@@ -94,7 +103,9 @@ type
function
GetTaskItems
(
taskId
:
string
):
TTaskItemsResponse
;
[
HttpPost
]
function
AddTaskRow
(
taskId
:
string
;
insertAfterItemNum
:
Integer
):
Boolean
;
[
HttpPost
]
function
SaveTaskRow
(
Item
:
TTaskRowSave
):
Boolean
;
function
TestApi
(
messageText
:
string
):
TJSONObject
;
[
HttpPost
]
function
AddAssignedName
(
taskId
:
string
;
name
:
string
):
TTaskUserOptionsResponse
;
[
HttpPost
]
function
RenameAssignedName
(
taskId
:
string
;
oldName
:
string
;
newName
:
string
):
TTaskUserOptionsResponse
;
[
HttpPost
]
function
DeleteAssignedName
(
taskId
:
string
;
name
:
string
):
TTaskUserOptionsResponse
;
procedure
MoveTaskRow
(
const
taskId
:
Integer
;
const
taskItemId
:
Integer
;
const
newItemNum
:
Integer
);
function
DeleteTaskRow
(
const
taskId
:
Integer
;
const
taskItemId
:
Integer
):
Boolean
;
end
;
...
...
@@ -119,6 +130,18 @@ begin
inherited
;
end
;
constructor
TTaskUserOptionsResponse
.
Create
;
begin
inherited
;
assignedToOptions
:=
TList
<
TTaskUserOption
>.
Create
;
end
;
destructor
TTaskUserOptionsResponse
.
Destroy
;
begin
assignedToOptions
.
Free
;
inherited
;
end
;
initialization
RegisterServiceType
(
TypeInfo
(
IApiService
));
...
...
emT3XDataServer/Source/Api.ServiceImpl.pas
View file @
15978bbd
...
...
@@ -20,10 +20,14 @@ type
private
function
BuildTaskNumber
:
string
;
function
BuildTaskTitle
(
const
taskNumber
,
projectName
,
subject
:
string
):
string
;
function
FindAssignedOptionId
(
const
taskId
,
name
:
string
):
string
;
function
FindAssignedOptionName
(
const
taskId
,
name
:
string
):
string
;
function
AddTaskRow
(
taskId
:
string
;
insertAfterItemNum
:
Integer
):
Boolean
;
function
SaveTaskRow
(
Item
:
TTaskRowSave
):
Boolean
;
function
TestApi
(
messageText
:
string
):
TJSONObject
;
function
GetWebClientVersion
:
string
;
function
BuildAssignedOptionsResponse
(
const
taskId
:
string
):
TTaskUserOptionsResponse
;
function
AddAssignedName
(
taskId
:
string
;
name
:
string
):
TTaskUserOptionsResponse
;
function
RenameAssignedName
(
taskId
:
string
;
oldName
:
string
;
newName
:
string
):
TTaskUserOptionsResponse
;
function
DeleteAssignedName
(
taskId
:
string
;
name
:
string
):
TTaskUserOptionsResponse
;
procedure
MoveTaskRow
(
const
taskId
:
Integer
;
const
taskItemId
:
Integer
;
const
newItemNum
:
Integer
);
function
DeleteTaskRow
(
const
taskId
,
taskItemId
:
Integer
):
Boolean
;
public
...
...
@@ -89,23 +93,34 @@ begin
Result
.
task
:=
taskHeader
;
apiDB
.
uq
TaskItem
Users
.
Close
;
apiDB
.
uq
TaskItem
Users
.
ParamByName
(
'TASK_ID'
).
AsString
:=
taskId
;
apiDB
.
uq
TaskItem
Users
.
Open
;
apiDB
.
uq
ProjectReported
Users
.
Close
;
apiDB
.
uq
ProjectReported
Users
.
ParamByName
(
'TASK_ID'
).
AsString
:=
taskId
;
apiDB
.
uq
ProjectReported
Users
.
Open
;
while
not
apiDB
.
uq
TaskItem
Users
.
Eof
do
while
not
apiDB
.
uq
ProjectReported
Users
.
Eof
do
begin
taskUserOption
:=
TTaskUserOption
.
Create
;
TXDataOperationContext
.
Current
.
Handler
.
ManagedObjects
.
Add
(
taskUserOption
);
taskUserOption
.
name
:=
apiDB
.
uqTaskItemUsersNAME
.
AsString
;
taskUserOption
.
name
:=
apiDB
.
uqProjectReportedUsersNAME
.
AsString
;
Result
.
reportedByOptions
.
Add
(
taskUserOption
);
if
SameText
(
apiDB
.
uqTaskItemUsersUSER_TYPE
.
AsString
,
'Reported'
)
then
Result
.
reportedByOptions
.
Add
(
taskUserOption
)
else
if
SameText
(
apiDB
.
uqTaskItemUsersUSER_TYPE
.
AsString
,
'Assigned'
)
then
Result
.
assignedToOptions
.
Add
(
taskUserOption
);
apiDB
.
uqProjectReportedUsers
.
Next
;
end
;
apiDB
.
uqTaskAssignedUsers
.
Close
;
apiDB
.
uqTaskAssignedUsers
.
ParamByName
(
'TASK_ID'
).
AsString
:=
taskId
;
apiDB
.
uqTaskAssignedUsers
.
Open
;
while
not
apiDB
.
uqTaskAssignedUsers
.
Eof
do
begin
taskUserOption
:=
TTaskUserOption
.
Create
;
TXDataOperationContext
.
Current
.
Handler
.
ManagedObjects
.
Add
(
taskUserOption
);
apiDB
.
uqTaskItemUsers
.
Next
;
taskUserOption
.
name
:=
apiDB
.
uqTaskAssignedUsersNAME
.
AsString
;
Result
.
assignedToOptions
.
Add
(
taskUserOption
);
apiDB
.
uqTaskAssignedUsers
.
Next
;
end
;
apiDB
.
uqTaskItemCodes
.
Close
;
...
...
@@ -137,7 +152,6 @@ begin
item
.
taskItemId
:=
apiDB
.
uqTaskItemsTASK_ITEM_ID
.
AsInteger
;
item
.
taskId
:=
apiDB
.
uqTaskItemsTASK_ID
.
AsString
;
item
.
itemNum
:=
apiDB
.
uqTaskItemsITEM_NUM
.
AsInteger
;
item
.
application
:=
apiDB
.
uqTaskItemsAPPLICATION
.
AsString
;
item
.
version
:=
apiDB
.
uqTaskItemsAPP_VERSION
.
AsString
;
...
...
@@ -151,7 +165,7 @@ begin
item
.
status
:=
apiDB
.
uqTaskItemsSTATUS
.
AsString
;
if
apiDB
.
uqTaskItemsSTATUS_DATE
.
IsNull
then
item
.
statusDate
:=
Null
item
.
statusDate
:=
0
else
item
.
statusDate
:=
apiDB
.
uqTaskItemsSTATUS_DATE
.
AsDateTime
;
...
...
@@ -474,33 +488,202 @@ begin
end
;
function
TApiService
.
TestApi
(
messageText
:
string
):
TJSONObject
;
function
TApiService
.
FindAssignedOptionId
(
const
taskId
,
name
:
string
):
string
;
begin
Result
:=
''
;
apiDB
.
uqTaskAssignedUsers
.
Close
;
apiDB
.
uqTaskAssignedUsers
.
ParamByName
(
'TASK_ID'
).
AsString
:=
taskId
;
apiDB
.
uqTaskAssignedUsers
.
Open
;
while
not
apiDB
.
uqTaskAssignedUsers
.
Eof
do
begin
if
SameText
(
Trim
(
apiDB
.
uqTaskAssignedUsersNAME
.
AsString
),
Trim
(
name
))
then
begin
Result
:=
apiDB
.
uqTaskAssignedUsersTASK_ITEM_USER_ID
.
AsString
;
Exit
;
end
;
apiDB
.
uqTaskAssignedUsers
.
Next
;
end
;
end
;
function
TApiService
.
FindAssignedOptionName
(
const
taskId
,
name
:
string
):
string
;
begin
Result
:=
''
;
apiDB
.
uqTaskAssignedUsers
.
Close
;
apiDB
.
uqTaskAssignedUsers
.
ParamByName
(
'TASK_ID'
).
AsString
:=
taskId
;
apiDB
.
uqTaskAssignedUsers
.
Open
;
while
not
apiDB
.
uqTaskAssignedUsers
.
Eof
do
begin
if
SameText
(
Trim
(
apiDB
.
uqTaskAssignedUsersNAME
.
AsString
),
Trim
(
name
))
then
begin
Result
:=
apiDB
.
uqTaskAssignedUsersNAME
.
AsString
;
Exit
;
end
;
apiDB
.
uqTaskAssignedUsers
.
Next
;
end
;
end
;
function
TApiService
.
AddAssignedName
(
taskId
:
string
;
name
:
string
):
TTaskUserOptionsResponse
;
var
requiredVersion
:
string
;
newName
:
string
;
existingName
:
string
;
newGuid
:
TGuid
;
begin
Logger
.
Log
(
3
,
'IApiService.TestApi called'
);
newName
:=
Trim
(
name
);
if
newName
=
''
then
raise
Exception
.
Create
(
'Assigned name cannot be blank.'
);
Result
:=
TJSONObject
.
Create
;
TXDataOperationContext
.
Current
.
Handler
.
ManagedObjects
.
Add
(
Result
);
existingName
:=
FindAssignedOptionName
(
taskId
,
newName
);
if
existingName
=
''
then
begin
CreateGUID
(
newGuid
);
apiDB
.
uqAssignedInsert
.
Connection
.
StartTransaction
;
try
apiDB
.
uqAssignedInsert
.
Close
;
apiDB
.
uqAssignedInsert
.
ParamByName
(
'TASK_ITEM_USER_ID'
).
AsString
:=
GuidToString
(
newGuid
);
apiDB
.
uqAssignedInsert
.
ParamByName
(
'TASK_ID'
).
AsString
:=
taskId
;
apiDB
.
uqAssignedInsert
.
ParamByName
(
'NAME'
).
AsString
:=
newName
;
apiDB
.
uqAssignedInsert
.
ExecSQL
;
apiDB
.
uqAssignedInsert
.
Connection
.
Commit
;
except
on
E
:
Exception
do
begin
if
apiDB
.
uqAssignedInsert
.
Connection
.
InTransaction
then
apiDB
.
uqAssignedInsert
.
Connection
.
Rollback
;
raise
;
end
;
end
;
end
;
Result
:=
BuildAssignedOptionsResponse
(
taskId
);
end
;
function
TApiService
.
RenameAssignedName
(
taskId
:
string
;
oldName
:
string
;
newName
:
string
):
TTaskUserOptionsResponse
;
var
oldAssignedId
:
string
;
existingAssignedId
:
string
;
trimmedOldName
:
string
;
trimmedNewName
:
string
;
begin
trimmedOldName
:=
Trim
(
oldName
);
trimmedNewName
:=
Trim
(
newName
);
if
trimmedOldName
=
''
then
raise
Exception
.
Create
(
'Old assigned name cannot be blank.'
);
if
trimmedNewName
=
''
then
raise
Exception
.
Create
(
'New assigned name cannot be blank.'
);
requiredVersion
:=
GetWebClientVersion
;
oldAssignedId
:=
FindAssignedOptionId
(
taskId
,
trimmedOldName
);
if
oldAssignedId
=
''
then
raise
Exception
.
Create
(
'Assigned name not found.'
);
existingAssignedId
:=
FindAssignedOptionId
(
taskId
,
trimmedNewName
);
apiDB
.
uqAssignedRename
.
Connection
.
StartTransaction
;
try
apiDB
.
uqRenameAssignedTo
.
Close
;
apiDB
.
uqRenameAssignedTo
.
ParamByName
(
'TASK_ID'
).
AsString
:=
taskId
;
apiDB
.
uqRenameAssignedTo
.
ParamByName
(
'OLD_NAME'
).
AsString
:=
trimmedOldName
;
apiDB
.
uqRenameAssignedTo
.
ParamByName
(
'NEW_NAME'
).
AsString
:=
trimmedNewName
;
apiDB
.
uqRenameAssignedTo
.
ExecSQL
;
Result
.
AddPair
(
'messageEcho'
,
messageText
);
Result
.
AddPair
(
'serverTime'
,
DateTimeToStr
(
Now
));
Result
.
AddPair
(
'requiredWebClientVersion'
,
requiredVersion
);
Result
.
AddPair
(
'note'
,
'If this endpoint is reachable, JWT auth passed. Version enforcement on every API call is a separate step (middleware).'
);
if
(
existingAssignedId
<>
''
)
and
(
not
SameText
(
existingAssignedId
,
oldAssignedId
))
then
begin
apiDB
.
uqAssignedDelete
.
Close
;
apiDB
.
uqAssignedDelete
.
ParamByName
(
'TASK_ITEM_USER_ID'
).
AsString
:=
oldAssignedId
;
apiDB
.
uqAssignedDelete
.
ParamByName
(
'TASK_ID'
).
AsString
:=
taskId
;
apiDB
.
uqAssignedDelete
.
ExecSQL
;
end
else
begin
apiDB
.
uqAssignedRename
.
Close
;
apiDB
.
uqAssignedRename
.
ParamByName
(
'TASK_ITEM_USER_ID'
).
AsString
:=
oldAssignedId
;
apiDB
.
uqAssignedRename
.
ParamByName
(
'TASK_ID'
).
AsString
:=
taskId
;
apiDB
.
uqAssignedRename
.
ParamByName
(
'NEW_NAME'
).
AsString
:=
trimmedNewName
;
apiDB
.
uqAssignedRename
.
ExecSQL
;
end
;
apiDB
.
uqAssignedRename
.
Connection
.
Commit
;
except
on
E
:
Exception
do
begin
if
apiDB
.
uqAssignedRename
.
Connection
.
InTransaction
then
apiDB
.
uqAssignedRename
.
Connection
.
Rollback
;
raise
;
end
;
end
;
Result
:=
BuildAssignedOptionsResponse
(
taskId
);
end
;
function
TApiService
.
GetWebClientVersion
:
string
;
function
TApiService
.
DeleteAssignedName
(
taskId
:
string
;
name
:
string
):
TTaskUserOptionsResponse
;
var
iniFile
:
TIniFile
;
assignedId
:
string
;
assignedName
:
string
;
begin
iniFile
:=
TIniFile
.
Create
(
ChangeFileExt
(
ParamStr
(
0
),
'.ini'
));
assignedId
:=
FindAssignedOptionId
(
taskId
,
name
);
assignedName
:=
FindAssignedOptionName
(
taskId
,
name
);
if
assignedId
=
''
then
raise
Exception
.
Create
(
'Assigned name not found.'
);
apiDB
.
uqAssignedDelete
.
Connection
.
StartTransaction
;
try
Result
:=
iniFile
.
ReadString
(
'Settings'
,
'webClientVersion'
,
''
);
finally
iniFile
.
Free
;
apiDB
.
uqBlankAssignedTo
.
Close
;
apiDB
.
uqBlankAssignedTo
.
ParamByName
(
'TASK_ID'
).
AsString
:=
taskId
;
apiDB
.
uqBlankAssignedTo
.
ParamByName
(
'NAME'
).
AsString
:=
assignedName
;
apiDB
.
uqBlankAssignedTo
.
ExecSQL
;
apiDB
.
uqAssignedDelete
.
Close
;
apiDB
.
uqAssignedDelete
.
ParamByName
(
'TASK_ITEM_USER_ID'
).
AsString
:=
assignedId
;
apiDB
.
uqAssignedDelete
.
ParamByName
(
'TASK_ID'
).
AsString
:=
taskId
;
apiDB
.
uqAssignedDelete
.
ExecSQL
;
apiDB
.
uqAssignedDelete
.
Connection
.
Commit
;
except
on
E
:
Exception
do
begin
if
apiDB
.
uqAssignedDelete
.
Connection
.
InTransaction
then
apiDB
.
uqAssignedDelete
.
Connection
.
Rollback
;
raise
;
end
;
end
;
Result
:=
BuildAssignedOptionsResponse
(
taskId
);
end
;
function
TApiService
.
BuildAssignedOptionsResponse
(
const
taskId
:
string
):
TTaskUserOptionsResponse
;
var
taskUserOption
:
TTaskUserOption
;
begin
Result
:=
TTaskUserOptionsResponse
.
Create
;
TXDataOperationContext
.
Current
.
Handler
.
ManagedObjects
.
Add
(
Result
);
apiDB
.
uqTaskAssignedUsers
.
Close
;
apiDB
.
uqTaskAssignedUsers
.
ParamByName
(
'TASK_ID'
).
AsString
:=
taskId
;
apiDB
.
uqTaskAssignedUsers
.
Open
;
while
not
apiDB
.
uqTaskAssignedUsers
.
Eof
do
begin
taskUserOption
:=
TTaskUserOption
.
Create
;
TXDataOperationContext
.
Current
.
Handler
.
ManagedObjects
.
Add
(
taskUserOption
);
taskUserOption
.
name
:=
apiDB
.
uqTaskAssignedUsersNAME
.
AsString
;
Result
.
assignedToOptions
.
Add
(
taskUserOption
);
apiDB
.
uqTaskAssignedUsers
.
Next
;
end
;
end
;
...
...
emT3XDataServer/bin/emT3XDataServer
2
.ini
→
emT3XDataServer/bin/emT3XDataServer.ini
View file @
15978bbd
[Settings]
MemoLogLevel
=
4
FileLogLevel
=
4
webClientVersion
=
0.8.
5
LogFileNum
=
1
46
webClientVersion
=
0.8.
6
LogFileNum
=
1
52
[Database]
Server
=
192.168.116.131
...
...
emT3XDataServer/emT3XDataServer.dproj
View file @
15978bbd
...
...
@@ -114,10 +114,10 @@
<VerInfo_Locale>1033</VerInfo_Locale>
<DCC_ExeOutput>.\bin</DCC_ExeOutput>
<DCC_UnitSearchPath>C:\RADTOOLS\FastMM4;$(DCC_UnitSearchPath)</DCC_UnitSearchPath>
<VerInfo_Keys>CompanyName=EM Systems;FileDescription=$(MSBuildProjectName);FileVersion=0.8.
5
.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.8.
6
.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=0.9.11;Comments=</VerInfo_Keys>
<VerInfo_MajorVer>0</VerInfo_MajorVer>
<VerInfo_MinorVer>8</VerInfo_MinorVer>
<VerInfo_Release>
5
</VerInfo_Release>
<VerInfo_Release>
6
</VerInfo_Release>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_1_Win64)'!=''">
<AppDPIAwarenessMode>PerMonitorV2</AppDPIAwarenessMode>
...
...
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