Skip to content
Projects
Groups
Snippets
Help
This project
Loading...
Sign in / Register
Toggle navigation
K
kgOrders
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
Cam Hayes
kgOrders
Commits
aaffc371
Commit
aaffc371
authored
Apr 28, 2026
by
Cam Hayes
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
fixed issue with error not displaying when unable to connect to database
parent
5aaae14f
Hide whitespace changes
Inline
Side-by-side
Showing
9 changed files
with
46 additions
and
28 deletions
+46
-28
Auth.Service.pas
kgOrdersClient/Auth.Service.pas
+1
-0
ConnectionModule.pas
kgOrdersClient/ConnectionModule.pas
+6
-2
View.Customer.Add.pas
kgOrdersClient/View.Customer.Add.pas
+1
-0
View.Customers.dfm
kgOrdersClient/View.Customers.dfm
+1
-0
View.Customers.pas
kgOrdersClient/View.Customers.pas
+7
-0
webKGOrders.dpr
kgOrdersClient/webKGOrders.dpr
+22
-21
webKGOrders.dproj
kgOrdersClient/webKGOrders.dproj
+1
-1
Auth.Database.pas
kgOrdersServer/Source/Auth.Database.pas
+1
-3
Auth.ServiceImpl.pas
kgOrdersServer/Source/Auth.ServiceImpl.pas
+6
-1
No files found.
kgOrdersClient/Auth.Service.pas
View file @
aaffc371
...
...
@@ -109,6 +109,7 @@ procedure TAuthService.Login(AUser, APassword: string; ASuccess: TOnLoginSuccess
end
;
begin
console
.
log
(
'login'
);
if
(
AUser
=
''
)
or
(
APassword
=
''
)
then
begin
AError
(
'Please enter a username and a password'
);
...
...
kgOrdersClient/ConnectionModule.pas
View file @
aaffc371
...
...
@@ -107,11 +107,10 @@ begin
LoadConfig
(@
ConfigLoaded
);
end
;
procedure
TDMConnection
.
SetClientConfig
(
Callback
:
TVersionCheckCallback
);
begin
XDataWebClient1
.
Connection
:=
AuthConnection
;
console
.
log
(
'ClientConfig'
);
XDataWebClient1
.
RawInvoke
(
'IAuthService.VerifyVersion'
,
[
clientVersion
],
procedure
(
Response
:
TXDataClientResponse
)
var
...
...
@@ -119,6 +118,7 @@ begin
error
:
string
;
begin
jsonResult
:=
TJSObject
(
Response
.
Result
);
console
.
log
(
jsonResult
);
if
jsonResult
.
HasOwnProperty
(
'error'
)
then
error
:=
string
(
jsonResult
[
'error'
])
...
...
@@ -129,6 +129,10 @@ begin
Callback
(
False
,
error
)
else
Callback
(
True
,
''
);
end
,
procedure
(
Error
:
TXDataClientError
)
begin
Callback
(
False
,
Error
.
ErrorMessage
);
end
);
end
;
...
...
kgOrdersClient/View.Customer.Add.pas
View file @
aaffc371
...
...
@@ -343,6 +343,7 @@ begin
xdwdsShipTo
.
Open
;
console
.
log
(
xdwdsShipTo
.
RecordCount
);
console
.
log
(
notification
[
'ADDRESS'
]);
console
.
log
(
xdwdsShipTo
.
FieldByName
(
'state'
).
AsString
);
edtShippingAddress
.
Text
:=
xdwdsShipTo
.
FieldByName
(
'shipping_address'
).
AsString
;
edtShippingCity
.
Text
:=
xdwdsShipTo
.
FieldByName
(
'city'
).
AsString
;
...
...
kgOrdersClient/View.Customers.dfm
View file @
aaffc371
...
...
@@ -112,6 +112,7 @@ object FViewCustomers: TFViewCustomers
Header.ListItemElementClassName = 'page-item'
Header.ListLinkElementClassName = 'page-link'
WordWrap = True
OnClickCell = wdbtcCustomersClickCell
OnDblClickCell = wdbtcCustomersDblClickCell
Columns = <
item
...
...
kgOrdersClient/View.Customers.pas
View file @
aaffc371
...
...
@@ -38,6 +38,7 @@ type
procedure
wdbtcCustomersDblClickCell
(
Sender
:
TObject
;
ACol
,
ARow
:
Integer
);
procedure
edtFilterChange
(
Sender
:
TObject
);
procedure
wcbPageSizeChange
(
Sender
:
TObject
);
procedure
wdbtcCustomersClickCell
(
Sender
:
TObject
;
ACol
,
ARow
:
Integer
);
private
{ Private declarations }
procedure
GeneratePagination
(
TotalPages
:
Integer
);
...
...
@@ -170,6 +171,12 @@ begin
getCustomers
(
GenerateSearchOptions
());
end
;
procedure
TFViewCustomers
.
wdbtcCustomersClickCell
(
Sender
:
TObject
;
ACol
,
ARow
:
Integer
);
begin
console
.
log
(
xdwdsCustomersSHORT_NAME
.
AsString
);
end
;
procedure
TFViewCustomers
.
wdbtcCustomersDblClickCell
(
Sender
:
TObject
;
ACol
,
ARow
:
Integer
);
begin
...
...
kgOrdersClient/webKGOrders.dpr
View file @
aaffc371
...
...
@@ -89,27 +89,28 @@ begin
end
else
begin
asm
var dlg = document.createElement("dialog");
dlg.classList.add("shadow", "rounded", "border", "p-4");
dlg.style.maxWidth = "500px";
dlg.style.width = "90%";
dlg.style.fontFamily = "system-ui, sans-serif";
dlg.innerHTML =
"<h5 class='fw-bold mb-3 text-danger'>kgOrders web app</h5>" +
"<p class='mb-3' style='white-space: pre-wrap;'>" + ErrorMessage + "</p>" +
"<div class='text-end'>" +
"<button id='refreshBtn' class='btn btn-primary'>Reload</button></div>";
document.body.appendChild(dlg);
dlg.showModal();
document.getElementById("refreshBtn").addEventListener("click", function () {
var base = location.origin + location.pathname;
location.replace(base + "?ver=" + ClientVer + "&r=" + Date.now() + location.hash);
});
end;
// asm
// var dlg = document.createElement("dialog");
// dlg.classList.add("shadow", "rounded", "border", "p-4");
// dlg.style.maxWidth = "500px";
// dlg.style.width = "90%";
// dlg.style.fontFamily = "system-ui, sans-serif";
//
// dlg.innerHTML =
// "<h5 class='fw-bold mb-3 text-danger'>kgOrders web app</h5>" +
// "<p class='mb-3' style='white-space: pre-wrap;'>" + ErrorMessage + "</p>" +
// "<div class='text-end'>" +
// "<button id='refreshBtn' class='btn btn-primary'>Reload</button></div>";
//
// document.body.appendChild(dlg);
// dlg.showModal();
//
// document.getElementById("refreshBtn").addEventListener("click", function () {
// var base = location.origin + location.pathname;
// location.replace(base + "?ver=" + ClientVer + "&r=" + Date.now() + location.hash);
// });
// end;
ShowMessage( 'Error connecting to kgOrdersServer' + sLineBreak + 'Please contact EM Systems support' );
end;
end);
end,
...
...
kgOrdersClient/webKGOrders.dproj
View file @
aaffc371
...
...
@@ -99,9 +99,9 @@
<VerInfo_MajorVer>0</VerInfo_MajorVer>
<VerInfo_MinorVer>9</VerInfo_MinorVer>
<VerInfo_Release>8</VerInfo_Release>
<TMSWebBrowser>1</TMSWebBrowser>
<TMSUseJSDebugger>2</TMSUseJSDebugger>
<TMSWebSingleInstance>1</TMSWebSingleInstance>
<TMSWebBrowser>5</TMSWebBrowser>
<TMSWebOutputPath>..\kgOrdersServer\bin\static</TMSWebOutputPath>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2)'!=''">
...
...
kgOrdersServer/Source/Auth.Database.pas
View file @
aaffc371
...
...
@@ -55,17 +55,15 @@ begin
on
E
:
Exception
do
begin
Logger
.
Log
(
1
,
'--TAuthDatabase.DataModuleCreate -Error connecting to database: '
+
E
.
Message
);
raise
EXDataHttpException
.
Create
(
500
,
'Error Connecting to database! Please try again later or contact a system admin!'
);
raise
;
//
EXDataHttpException.Create(500, 'Error Connecting to database! Please try again later or contact a system admin!');
end
;
end
;
end
;
procedure
TAuthDatabase
.
DataModuleDestroy
(
Sender
:
TObject
);
begin
ucKG
.
Connected
:=
false
;
Logger
.
Log
(
5
,
'TAuthDatabase.DataModuleDestroy'
);
end
;
end
.
kgOrdersServer/Source/Auth.ServiceImpl.pas
View file @
aaffc371
...
...
@@ -51,11 +51,16 @@ begin
try
Logger
.
Log
(
4
,
'TAuthService.AfterConstruction'
);
authDB
:=
TAuthDatabase
.
Create
(
nil
);
if
not
authDB
.
ucKG
.
Connected
then
begin
Logger
.
Log
(
1
,
'Unable to connect to the database: A KGOrders Server Error has occured!'
);
raise
EXDataHttpException
.
Create
(
500
,
'Unable to create Auth database: A KGOrders Server Error has occured!'
);
end
;
except
on
E
:
Exception
do
begin
Logger
.
Log
(
1
,
'Error creating the Auth database: '
+
E
.
Message
);
raise
EXDataHttpException
.
Create
(
500
,
'Unable to create Auth database: A KGOrders Server Error has occured!'
);
raise
;
//
EXDataHttpException.Create(500, 'Unable to create Auth database: A KGOrders Server Error has occured!');
end
;
end
;
end
;
...
...
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