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
59c3c0cc
Commit
59c3c0cc
authored
Nov 21, 2025
by
Cam Hayes
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
QB is now disabled from the ini
parent
962f9e80
Hide whitespace changes
Inline
Side-by-side
Showing
8 changed files
with
101 additions
and
65 deletions
+101
-65
View.Customers.pas
kgOrdersClient/View.Customers.pas
+4
-1
View.Items.pas
kgOrdersClient/View.Items.pas
+28
-22
View.OrderEntryCorrugated.pas
kgOrdersClient/View.OrderEntryCorrugated.pas
+18
-11
View.OrderEntryCuttingDie.pas
kgOrdersClient/View.OrderEntryCuttingDie.pas
+18
-13
View.OrderEntryWeb.pas
kgOrdersClient/View.OrderEntryWeb.pas
+18
-13
Auth.ServiceImpl.pas
kgOrdersServer/Source/Auth.ServiceImpl.pas
+12
-1
QBServiceImplementation.pas
kgOrdersServer/Source/QBServiceImplementation.pas
+1
-3
kgOrdersServer.ini
kgOrdersServer/bin/kgOrdersServer.ini
+2
-1
No files found.
kgOrdersClient/View.Customers.pas
View file @
59c3c0cc
...
@@ -181,7 +181,10 @@ end;
...
@@ -181,7 +181,10 @@ end;
procedure
TFViewCustomers
.
btnAddCustomerClick
(
Sender
:
TObject
);
procedure
TFViewCustomers
.
btnAddCustomerClick
(
Sender
:
TObject
);
begin
begin
ShowSelectCustomerForm
();
if
AuthService
.
TokenPayload
.
Properties
[
'qb_enabled'
]
then
ShowSelectCustomerForm
()
else
ShowToast
(
'QB interface not currently active'
,
'info'
);
end
;
end
;
procedure
TFViewCustomers
.
edtFilterChange
(
Sender
:
TObject
);
procedure
TFViewCustomers
.
edtFilterChange
(
Sender
:
TObject
);
...
...
kgOrdersClient/View.Items.pas
View file @
59c3c0cc
...
@@ -444,34 +444,40 @@ var
...
@@ -444,34 +444,40 @@ var
itemOptions
:
string
;
itemOptions
:
string
;
newform
:
TFViewAddItem
;
newform
:
TFViewAddItem
;
begin
begin
newform
:=
TFViewAddItem
.
CreateNew
;
console
.
log
(
AuthService
.
TokenPayload
.
Properties
[
'qb_enabled'
]);
if
AuthService
.
TokenPayload
.
Properties
[
'qb_enabled'
]
then
begin
newform
:=
TFViewAddItem
.
CreateNew
;
newform
.
Caption
:=
'Select Item to Add'
;
newform
.
Caption
:=
'Select Item to Add'
;
newForm
.
Popup
:=
True
;
newForm
.
Popup
:=
True
;
newForm
.
position
:=
poScreenCenter
;
newForm
.
position
:=
poScreenCenter
;
newForm
.
Border
:=
fbDialog
;
newForm
.
Border
:=
fbDialog
;
// used to manage Back button handling to close subform
// used to manage Back button handling to close subform
window
.
location
.
hash
:=
'subform'
;
window
.
location
.
hash
:=
'subform'
;
newform
.
ShowModal
(
newform
.
ShowModal
(
procedure
(
AValue
:
TModalResult
)
procedure
(
AValue
:
TModalResult
)
begin
if
newform
.
confirm
then
begin
begin
xdwdsItems
.
Append
;
if
newform
.
confirm
then
begin
xdwdsItems
.
Append
;
xdwdsItems
.
FieldByName
(
'QB_ID'
).
AsString
:=
newform
.
QB_ID
;
xdwdsItems
.
FieldByName
(
'QB_ID'
).
AsString
:=
newform
.
QB_ID
;
xdwdsItems
.
FieldByName
(
'name'
).
AsString
:=
newform
.
name
;
xdwdsItems
.
FieldByName
(
'name'
).
AsString
:=
newform
.
name
;
xdwdsItems
.
FieldByName
(
'description'
).
AsString
:=
newform
.
description
;
xdwdsItems
.
FieldByName
(
'description'
).
AsString
:=
newform
.
description
;
xdwdsItems
.
FieldByName
(
'status'
).
AsString
:=
newform
.
status
;
xdwdsItems
.
FieldByName
(
'status'
).
AsString
:=
newform
.
status
;
xdwdsItems
.
Post
;
xdwdsItems
.
Post
;
EditMode
();
EditMode
();
lblFormState
.
Caption
:=
'Add Mode'
;
lblFormState
.
Caption
:=
'Add Mode'
;
end
;
end
;
end
end
);
);
end
else
ShowToast
(
'QB interface not currently active'
,
'info'
);
end
;
end
;
procedure
TFViewItems
.
btnCancelClick
(
Sender
:
TObject
);
procedure
TFViewItems
.
btnCancelClick
(
Sender
:
TObject
);
...
...
kgOrdersClient/View.OrderEntryCorrugated.pas
View file @
59c3c0cc
...
@@ -389,24 +389,31 @@ procedure TFOrderEntryCorrugated.btnQBClick(Sender: TObject);
...
@@ -389,24 +389,31 @@ procedure TFOrderEntryCorrugated.btnQBClick(Sender: TObject);
var
var
orderJSON
:
TJSONObject
;
orderJSON
:
TJSONObject
;
begin
begin
if
JS
.
toString
(
AuthService
.
TokenPayload
.
Properties
[
'user_qb_id'
])
<>
''
then
if
AuthService
.
TokenPayload
.
Properties
[
'qb_enabled'
]
then
begin
begin
if
(
VerifyQBOrder
()
)
then
begin
begin
if
wdbcbINQB
.
Checked
=
false
then
if
JS
.
toString
(
AuthService
.
TokenPayload
.
Properties
[
'user_qb_id'
])
<>
''
then
begin
begin
Utils
.
ShowSpinner
(
'spinner'
);
if
(
VerifyQBOrder
()
)
then
orderJSON
:=
TJSONObject
.
Create
;
begin
orderJSON
.
AddPair
(
'ORDER_ID'
,
xdwdsOrder
.
FieldByName
(
'ORDER_ID'
).
AsString
);
if
wdbcbINQB
.
Checked
=
false
then
orderJSON
.
AddPair
(
'USER_ID'
,
JS
.
toString
(
AuthService
.
TokenPayload
.
Properties
[
'user_id'
]));
begin
addEstimate
(
orderJSON
.
ToString
);
Utils
.
ShowSpinner
(
'spinner'
);
orderJSON
:=
TJSONObject
.
Create
;
orderJSON
.
AddPair
(
'ORDER_ID'
,
xdwdsOrder
.
FieldByName
(
'ORDER_ID'
).
AsString
);
orderJSON
.
AddPair
(
'USER_ID'
,
JS
.
toString
(
AuthService
.
TokenPayload
.
Properties
[
'user_id'
]));
addEstimate
(
orderJSON
.
ToString
);
end
else
ShowToast
(
'Failure:Cannot submit orders already in QuickBooks'
,
'failure'
);
end
;
end
end
else
else
ShowToast
(
'Failure:
Cannot submit orders already in
QuickBooks'
,
'failure'
);
ShowToast
(
'Failure:
User not authorized to add to
QuickBooks'
,
'failure'
);
end
;
end
end
end
else
else
ShowToast
(
'
Failure:User not authorized to add to QuickBooks'
,
'failure
'
);
ShowToast
(
'
QB interface not currently active'
,
'info
'
);
end
;
end
;
[
async
]
procedure
TFOrderEntryCorrugated
.
GenerateReportPDF
;
[
async
]
procedure
TFOrderEntryCorrugated
.
GenerateReportPDF
;
...
...
kgOrdersClient/View.OrderEntryCuttingDie.pas
View file @
59c3c0cc
...
@@ -193,24 +193,29 @@ procedure TFOrderEntryCuttingDie.btnQBClick(Sender: TObject);
...
@@ -193,24 +193,29 @@ procedure TFOrderEntryCuttingDie.btnQBClick(Sender: TObject);
var
var
orderJSON
:
TJSONObject
;
orderJSON
:
TJSONObject
;
begin
begin
if
JS
.
toString
(
AuthService
.
TokenPayload
.
Properties
[
'user_qb_id'
])
<>
''
then
if
AuthService
.
TokenPayload
.
Properties
[
'qb_enabled'
]
then
begin
begin
if
(
VerifyQBOrder
()
)
then
if
JS
.
toString
(
AuthService
.
TokenPayload
.
Properties
[
'user_qb_id'
])
<>
''
then
begin
begin
if
wdbcbINQB
.
Checked
=
false
then
if
(
VerifyQBOrder
()
)
then
begin
begin
Utils
.
ShowSpinner
(
'spinner'
);
if
wdbcbINQB
.
Checked
=
false
then
orderJSON
:=
TJSONObject
.
Create
;
begin
orderJSON
.
AddPair
(
'ORDER_ID'
,
xdwdsOrder
.
FieldByName
(
'ORDER_ID'
).
AsString
);
Utils
.
ShowSpinner
(
'spinner'
);
orderJSON
.
AddPair
(
'USER_ID'
,
JS
.
toString
(
AuthService
.
TokenPayload
.
Properties
[
'user_id'
]));
orderJSON
:=
TJSONObject
.
Create
;
addEstimate
(
orderJSON
.
ToString
);
orderJSON
.
AddPair
(
'ORDER_ID'
,
xdwdsOrder
.
FieldByName
(
'ORDER_ID'
).
AsString
);
end
orderJSON
.
AddPair
(
'USER_ID'
,
JS
.
toString
(
AuthService
.
TokenPayload
.
Properties
[
'user_id'
]));
else
addEstimate
(
orderJSON
.
ToString
);
ShowToast
(
'Failure:Cannot submit orders already in QuickBooks'
,
'failure'
);
end
end
;
else
ShowToast
(
'Failure:Cannot submit orders already in QuickBooks'
,
'failure'
);
end
;
end
else
ShowToast
(
'Failure:User not authorized to add to QuickBooks'
,
'failure'
);
end
end
else
else
ShowToast
(
'
Failure:User not authorized to add to QuickBooks'
,
'failure
'
);
ShowToast
(
'
QB interface not currently active'
,
'info
'
);
end
;
end
;
procedure
TFOrderEntryCuttingDie
.
WebButton2Click
(
Sender
:
TObject
);
procedure
TFOrderEntryCuttingDie
.
WebButton2Click
(
Sender
:
TObject
);
...
...
kgOrdersClient/View.OrderEntryWeb.pas
View file @
59c3c0cc
...
@@ -454,24 +454,29 @@ procedure TFOrderEntryWeb.btnQBClick(Sender: TObject);
...
@@ -454,24 +454,29 @@ procedure TFOrderEntryWeb.btnQBClick(Sender: TObject);
var
var
orderJSON
:
TJSONObject
;
orderJSON
:
TJSONObject
;
begin
begin
if
JS
.
toString
(
AuthService
.
TokenPayload
.
Properties
[
'user_qb_id'
])
<>
''
then
if
AuthService
.
TokenPayload
.
Properties
[
'qb_enabled'
]
then
begin
begin
if
(
VerifyQBOrder
()
)
then
if
JS
.
toString
(
AuthService
.
TokenPayload
.
Properties
[
'user_qb_id'
])
<>
''
then
begin
begin
if
wdbcbINQB
.
Checked
=
false
then
if
(
VerifyQBOrder
()
)
then
begin
begin
Utils
.
ShowSpinner
(
'spinner'
);
if
wdbcbINQB
.
Checked
=
false
then
orderJSON
:=
TJSONObject
.
Create
;
begin
orderJSON
.
AddPair
(
'ORDER_ID'
,
xdwdsOrder
.
FieldByName
(
'ORDER_ID'
).
AsString
);
Utils
.
ShowSpinner
(
'spinner'
);
orderJSON
.
AddPair
(
'USER_ID'
,
JS
.
toString
(
AuthService
.
TokenPayload
.
Properties
[
'user_id'
]));
orderJSON
:=
TJSONObject
.
Create
;
addEstimate
(
orderJSON
.
ToString
);
orderJSON
.
AddPair
(
'ORDER_ID'
,
xdwdsOrder
.
FieldByName
(
'ORDER_ID'
).
AsString
);
end
orderJSON
.
AddPair
(
'USER_ID'
,
JS
.
toString
(
AuthService
.
TokenPayload
.
Properties
[
'user_id'
]));
else
addEstimate
(
orderJSON
.
ToString
);
ShowToast
(
'Failure:Cannot submit orders already in QuickBooks'
,
'failure'
);
end
end
;
else
ShowToast
(
'Failure:Cannot submit orders already in QuickBooks'
,
'failure'
);
end
;
end
else
ShowToast
(
'Failure:User not authorized to add to QuickBooks'
,
'failure'
);
end
end
else
else
ShowToast
(
'
Failure:User not authorized to add to QuickBooks'
,
'failure
'
);
ShowToast
(
'
QB interface not currently active'
,
'info
'
);
end
;
end
;
procedure
TFOrderEntryWeb
.
AddEstimate
(
orderID
:
string
);
procedure
TFOrderEntryWeb
.
AddEstimate
(
orderID
:
string
);
...
...
kgOrdersServer/Source/Auth.ServiceImpl.pas
View file @
59c3c0cc
...
@@ -27,9 +27,9 @@ type
...
@@ -27,9 +27,9 @@ type
userAccessType
:
string
;
userAccessType
:
string
;
userEmail
:
string
;
userEmail
:
string
;
userStatus
:
string
;
userStatus
:
string
;
qbEnabled
:
boolean
;
procedure
AfterConstruction
;
override
;
procedure
AfterConstruction
;
override
;
procedure
BeforeDestruction
;
override
;
procedure
BeforeDestruction
;
override
;
property
Query
:
TUniQuery
read
GetQuery
;
function
CheckUser
(
const
user
,
password
:
string
):
Integer
;
function
CheckUser
(
const
user
,
password
:
string
):
Integer
;
public
public
function
Login
(
const
user
,
password
:
string
):
string
;
function
Login
(
const
user
,
password
:
string
):
string
;
...
@@ -81,6 +81,7 @@ begin
...
@@ -81,6 +81,7 @@ begin
try
try
webClientVersion
:=
iniFile
.
ReadString
(
'Settings'
,
'webClientVersion'
,
''
);
webClientVersion
:=
iniFile
.
ReadString
(
'Settings'
,
'webClientVersion'
,
''
);
Result
.
AddPair
(
'webClientVersion'
,
webClientVersion
);
Result
.
AddPair
(
'webClientVersion'
,
webClientVersion
);
qbEnabled
:=
iniFile
.
ReadBool
(
'Quickbooks'
,
'Enabled'
,
false
);
if
webClientVersion
=
''
then
if
webClientVersion
=
''
then
begin
begin
...
@@ -102,6 +103,7 @@ end;
...
@@ -102,6 +103,7 @@ end;
function
TAuthService
.
Login
(
const
user
,
password
:
string
):
string
;
function
TAuthService
.
Login
(
const
user
,
password
:
string
):
string
;
var
var
userState
:
Integer
;
userState
:
Integer
;
iniFile
:
TIniFile
;
JWT
:
TJWT
;
JWT
:
TJWT
;
begin
begin
Logger
.
Log
(
3
,
Format
(
'AuthService.Login - User: "%s"'
,
[
User
]));
Logger
.
Log
(
3
,
Format
(
'AuthService.Login - User: "%s"'
,
[
User
]));
...
@@ -131,6 +133,14 @@ begin
...
@@ -131,6 +133,14 @@ begin
raise
EXDataHttpUnauthorized
.
Create
(
'User not active!'
);
raise
EXDataHttpUnauthorized
.
Create
(
'User not active!'
);
logger
.
Log
(
2
,
'Login Error: User not active!'
);
logger
.
Log
(
2
,
'Login Error: User not active!'
);
iniFile
:=
TIniFile
.
Create
(
ChangeFileExt
(
ParamStr
(
0
),
'.ini'
));
try
qbEnabled
:=
iniFile
.
ReadBool
(
'Quickbooks'
,
'Enabled'
,
false
);
finally
iniFile
.
Free
;
end
;
JWT
:=
TJWT
.
Create
;
JWT
:=
TJWT
.
Create
;
try
try
JWT
.
Claims
.
JWTId
:=
LowerCase
(
Copy
(
TUtils
.
GuidToVariant
(
TUtils
.
NewGuid
),
2
,
36
));
JWT
.
Claims
.
JWTId
:=
LowerCase
(
Copy
(
TUtils
.
GuidToVariant
(
TUtils
.
NewGuid
),
2
,
36
));
...
@@ -144,6 +154,7 @@ begin
...
@@ -144,6 +154,7 @@ begin
JWT
.
Claims
.
SetClaimOfType
<
string
>(
'user_email'
,
userEmail
);
JWT
.
Claims
.
SetClaimOfType
<
string
>(
'user_email'
,
userEmail
);
JWT
.
Claims
.
SetClaimOfType
<
string
>(
'user_qb_id'
,
userQBID
);
JWT
.
Claims
.
SetClaimOfType
<
string
>(
'user_qb_id'
,
userQBID
);
JWT
.
Claims
.
SetClaimOfType
<
string
>(
'user_access_type'
,
userAccessType
);
JWT
.
Claims
.
SetClaimOfType
<
string
>(
'user_access_type'
,
userAccessType
);
JWT
.
Claims
.
SetClaimOfType
<
boolean
>(
'qb_enabled'
,
qbEnabled
);
Result
:=
TJOSE
.
SHA256CompactToken
(
serverConfig
.
jwtTokenSecret
,
JWT
);
Result
:=
TJOSE
.
SHA256CompactToken
(
serverConfig
.
jwtTokenSecret
,
JWT
);
finally
finally
...
...
kgOrdersServer/Source/QBServiceImplementation.pas
View file @
59c3c0cc
...
@@ -98,7 +98,6 @@ var
...
@@ -98,7 +98,6 @@ var
f
:
TStringList
;
f
:
TStringList
;
fi
:
string
;
fi
:
string
;
JSObj
:
TJSONObject
;
JSObj
:
TJSONObject
;
iniFile
:
TIniFile
;
Encoder
:
TBase64Encoding
;
Encoder
:
TBase64Encoding
;
begin
begin
// 1. Encode credentials (same as working Postman request)
// 1. Encode credentials (same as working Postman request)
...
@@ -129,7 +128,7 @@ begin
...
@@ -129,7 +128,7 @@ begin
SSLIO
.
SSLOptions
.
SSLVersions
:=
[
sslvTLSv1_2
];
SSLIO
.
SSLOptions
.
SSLVersions
:=
[
sslvTLSv1_2
];
IdHTTP
.
IOHandler
:=
SSLIO
;
IdHTTP
.
IOHandler
:=
SSLIO
;
// Set headers
(EXACT match with Postman)
// Set headers
IdHTTP
.
Request
.
ContentType
:=
'application/x-www-form-urlencoded'
;
IdHTTP
.
Request
.
ContentType
:=
'application/x-www-form-urlencoded'
;
IdHTTP
.
Request
.
Accept
:=
'application/json'
;
IdHTTP
.
Request
.
Accept
:=
'application/json'
;
IdHTTP
.
Request
.
CustomHeaders
.
AddValue
(
'Authorization'
,
'Basic '
+
EncodedAuth
);
IdHTTP
.
Request
.
CustomHeaders
.
AddValue
(
'Authorization'
,
'Basic '
+
EncodedAuth
);
...
@@ -162,7 +161,6 @@ end;
...
@@ -162,7 +161,6 @@ end;
procedure
TQBService
.
SaveTokens
(
AccessToken
,
RefreshToken
:
string
);
procedure
TQBService
.
SaveTokens
(
AccessToken
,
RefreshToken
:
string
);
var
var
f
:
TStringList
;
f
:
TStringList
;
iniStr
,
line
:
string
;
iniFile
:
TIniFile
;
iniFile
:
TIniFile
;
begin
begin
iniFile
:=
TIniFile
.
Create
(
ExtractFilePath
(
Application
.
ExeName
)
+
'kgOrdersServer.ini'
);
iniFile
:=
TIniFile
.
Create
(
ExtractFilePath
(
Application
.
ExeName
)
+
'kgOrdersServer.ini'
);
...
...
kgOrdersServer/bin/kgOrdersServer.ini
View file @
59c3c0cc
...
@@ -2,7 +2,7 @@
...
@@ -2,7 +2,7 @@
MemoLogLevel
=
4
MemoLogLevel
=
4
FileLogLevel
=
4
FileLogLevel
=
4
webClientVersion
=
1.0.0
webClientVersion
=
1.0.0
LogFileNum
=
1
37
LogFileNum
=
1
41
[Database]
[Database]
--Server
=
192.168.116.138
--Server
=
192.168.116.138
...
@@ -15,6 +15,7 @@ Password=emsys01
...
@@ -15,6 +15,7 @@ Password=emsys01
--Password
=
emsys!012
--Password
=
emsys!012
[Quickbooks]
[Quickbooks]
Enabled
=
0
CompanyID
=
9341454336461805
CompanyID
=
9341454336461805
ClientID
=
ABYqlDx1EsacZYXvHIJ7RDB7zmnQdwABU3fwQLIZPmBgU0VW1P
ClientID
=
ABYqlDx1EsacZYXvHIJ7RDB7zmnQdwABU3fwQLIZPmBgU0VW1P
ClientSecret
=
PM7OnvQWsgOqjWfDpZAnyRttDN9446Am6d85pDxr
ClientSecret
=
PM7OnvQWsgOqjWfDpZAnyRttDN9446Am6d85pDxr
...
...
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