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
7068c939
Commit
7068c939
authored
Dec 01, 2025
by
Cam Hayes
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
cleaned up some code, and added a change log into view home.
parent
c15c23b4
Hide whitespace changes
Inline
Side-by-side
Showing
23 changed files
with
156 additions
and
297 deletions
+156
-297
View.Customer.Add.pas
kgOrdersClient/View.Customer.Add.pas
+0
-3
View.Customer.Select.pas
kgOrdersClient/View.Customer.Select.pas
+0
-1
View.Customers.pas
kgOrdersClient/View.Customers.pas
+0
-5
View.Home.dfm
kgOrdersClient/View.Home.dfm
+13
-3
View.Home.pas
kgOrdersClient/View.Home.pas
+4
-4
View.Main.pas
kgOrdersClient/View.Main.pas
+3
-4
View.OrderEntryWeb.pas
kgOrdersClient/View.OrderEntryWeb.pas
+1
-5
View.Orders.pas
kgOrdersClient/View.Orders.pas
+2
-2
View.SetStatus.dfm
kgOrdersClient/View.SetStatus.dfm
+4
-4
View.SetStatus.pas
kgOrdersClient/View.SetStatus.pas
+42
-5
Auth.Database.dfm
kgOrdersServer/Source/Auth.Database.dfm
+40
-0
Auth.Database.pas
kgOrdersServer/Source/Auth.Database.pas
+10
-0
Auth.ServiceImpl.pas
kgOrdersServer/Source/Auth.ServiceImpl.pas
+1
-9
Common.Config.pas
kgOrdersServer/Source/Common.Config.pas
+9
-1
Main.pas
kgOrdersServer/Source/Main.pas
+10
-4
QBService.pas
kgOrdersServer/Source/QBService.pas
+0
-24
QBServiceImplementation.pas
kgOrdersServer/Source/QBServiceImplementation.pas
+0
-185
rOrderCorrugated.pas
kgOrdersServer/Source/rOrderCorrugated.pas
+5
-8
rOrderCutting.pas
kgOrdersServer/Source/rOrderCutting.pas
+1
-7
rOrderList.pas
kgOrdersServer/Source/rOrderList.pas
+1
-7
rOrderWeb.pas
kgOrdersServer/Source/rOrderWeb.pas
+1
-7
kgOrdersServer.ini
kgOrdersServer/bin/kgOrdersServer.ini
+3
-3
kgOrdersServer.dpr
kgOrdersServer/kgOrdersServer.dpr
+6
-6
No files found.
kgOrdersClient/View.Customer.Add.pas
View file @
7068c939
...
...
@@ -223,7 +223,6 @@ procedure TFViewAddCustomer.SendAddressToServer;
// Creates an Address JSON and then sends it to the server for the address to be
// Added or edited.
var
Field
:
TField
;
AddressJSON
:
TJSONObject
;
Response
:
TXDataClientResponse
;
notification
:
TJSObject
;
...
...
@@ -516,8 +515,6 @@ procedure TFViewAddCustomer.GetCustomer;
var
xdcResponse
:
TXDataClientResponse
;
customer
,
RepUsers
:
TJSObject
;
items
:
TJSObject
;
ship_block
:
TStringList
;
begin
xdcResponse
:=
await
(
XDataWebClient1
.
RawInvokeAsync
(
'ILookupService.GetCustomer'
,
[
customerID
]));
customer
:=
TJSObject
(
xdcResponse
.
Result
);
...
...
kgOrdersClient/View.Customer.Select.pas
View file @
7068c939
...
...
@@ -109,7 +109,6 @@ procedure TFSelectCustomer.getCustomers();
var
xdcResponse
:
TXDataClientResponse
;
customerList
:
TJSObject
;
i
:
integer
;
begin
try
Utils
.
ShowSpinner
(
'spinner'
);
...
...
kgOrdersClient/View.Customers.pas
View file @
7068c939
...
...
@@ -49,8 +49,6 @@ type
PageNumber
:
integer
;
PageSize
:
integer
;
TotalPages
:
integer
;
info
:
string
;
public
{ Public declarations }
end
;
...
...
@@ -93,8 +91,6 @@ Procedure TFViewCustomers.WebFormCreate(Sender: TObject);
// PageNumber: What page number the user is on IE 1: 1-10, 2: 11-20 etc
// TotalPages: Total number of pages returned from the search.
// PageSize: Number of entries per page.
var
today
:
TDateTime
;
begin
DMConnection
.
ApiConnection
.
Connected
:=
True
;
PageNumber
:=
1
;
...
...
@@ -163,7 +159,6 @@ end;
procedure
TFViewCustomers
.
HideNotification
;
begin
pnlMessage
.
ElementHandle
.
hidden
:=
True
;
info
:=
''
;
end
;
...
...
kgOrdersClient/View.Home.dfm
View file @
7068c939
object FViewHome: TFViewHome
Width = 640
Height = 480
OnCreate = WebFormCreate
object WebLabel1: TWebLabel
Left = 24
Top = 43
...
...
@@ -12,7 +13,7 @@ object FViewHome: TFViewHome
Transparent = False
WidthPercent = 100.000000000000000000
end
object
WebMemo1
: TWebMemo
object
mmoNotes
: TWebMemo
Left = 24
Top = 62
Width = 471
...
...
@@ -20,10 +21,19 @@ object FViewHome: TFViewHome
ElementID = 'view.home.notesmemo'
HeightPercent = 100.000000000000000000
Lines.Strings = (
'KG Orders Alpha Version')
'Change Log:'
'1) Setting a status now autofills due dates.'
'2) Fixed order dates displaying on 3 lines rather than 2.'
'3) Adjusted pdfs so that special instructions would have enough ' +
'space.'
'4) Fixed issue with PDF generation.'
'5) Removed ability to put 0 or a negative number for price and q' +
'uantity on order entry fields.')
ReadOnly = True
SelLength = 0
SelStart =
25
SelStart =
323
WidthPercent = 100.000000000000000000
end
end
kgOrdersClient/View.Home.pas
View file @
7068c939
...
...
@@ -5,12 +5,12 @@ interface
uses
System
.
SysUtils
,
System
.
Classes
,
WEBLib
.
Graphics
,
WEBLib
.
Forms
,
WEBLib
.
Dialogs
,
Vcl
.
Controls
,
Vcl
.
StdCtrls
,
WEBLib
.
StdCtrls
,
WEBLib
.
Controls
,
WEBLib
.
Grids
,
XData
.
Web
.
Client
,
WEBLib
.
ExtCtrls
,
DB
;
XData
.
Web
.
Client
,
WEBLib
.
ExtCtrls
,
DB
,
JS
;
type
TFViewHome
=
class
(
TWebForm
)
WebLabel1
:
TWebLabel
;
WebMemo1
:
TWebMemo
;
mmoNotes
:
TWebMemo
;
procedure
WebFormCreate
(
Sender
:
TObject
);
end
;
...
...
@@ -20,7 +20,7 @@ var
implementation
uses
JS
,
XData
.
Model
.
Classes
,
XData
.
Model
.
Classes
,
ConnectionModule
;
{$R *.dfm}
...
...
@@ -28,7 +28,7 @@ uses
procedure
TFViewHome
.
WebFormCreate
(
Sender
:
TObject
);
begin
WebLabel1
.
Caption
:=
'Please select a menu option to continue!'
;
mmoNotes
.
Lines
.
Insert
(
0
,
'Welcome to KG Orders Version '
+
TDMConnection
.
clientVersion
)
;
end
;
end
.
kgOrdersClient/View.Main.pas
View file @
7068c939
...
...
@@ -125,10 +125,9 @@ procedure TFViewMain.lblHomeClick(Sender: TObject);
begin
if
(
not
(
change
)
)
then
begin
ShowToast
(
'Home page is not currently implemented'
,
'info'
);
//ShowForm(TFViewHome);
//lblAppTitle.Caption := 'Koehler-Gibson Home';
//setActive('Home');
ShowForm
(
TFViewHome
);
lblAppTitle
.
Caption
:=
'Koehler-Gibson Home'
;
setActive
(
'Home'
);
end
else
ShowToast
(
'Please Save or Cancel your changes'
,
'danger'
);
...
...
kgOrdersClient/View.OrderEntryWeb.pas
View file @
7068c939
...
...
@@ -777,10 +777,7 @@ var
tempString
,
strColorList
:
string
;
colorObject
:
TJSObject
;
colorList
:
TJSArray
;
colorLength
:
integer
;
color
:
TJSObject
;
colorJSON
:
TJSONObject
;
colorListJSON
:
TJSONArray
;
items
:
TJSObject
;
begin
Utils
.
ShowSpinner
(
'spinner'
);
...
...
@@ -840,7 +837,6 @@ procedure TFOrderEntryWeb.SetNewOrderInfo(customerID: string);
var
xdcResponse
:
TXDataClientResponse
;
customer
:
TJSObject
;
address
:
string
;
items
:
TJSObject
;
begin
xdcResponse
:=
await
(
XDataWebClient1
.
RawInvokeAsync
(
'ILookupService.GetCustomer'
,
...
...
@@ -1031,7 +1027,7 @@ end;
function
TFOrderEntryWeb
.
VerifyQBOrder
:
Boolean
;
var
msg
,
SQL
:
string
;
msg
:
string
;
begin
Result
:=
True
;
msg
:=
'To add an order to QuickBooks, the following must be present:'
+
sLineBreak
;
...
...
kgOrdersClient/View.Orders.pas
View file @
7068c939
...
...
@@ -476,12 +476,12 @@ var
begin
newform
:=
TFSetStatus
.
CreateNew
;
newform
.
Caption
:=
'
Input Search Option
s'
;
newform
.
Caption
:=
'
Set Statu
s'
;
newForm
.
Popup
:=
True
;
newForm
.
Border
:=
fbDialog
;
newForm
.
Position
:=
poScreenCenter
;
newForm
.
OrderID
:=
statusOrderID
;
newForm
.
JobName
:=
wdbtcOrders
.
Cells
[
3
,
row
];
newForm
.
JobName
:=
wdbtcOrders
.
Cells
[
4
,
row
];
if
wdbtcOrders
.
Cells
[
15
,
row
]
<>
''
then
newForm
.
ShipDue
:=
StrToDateTime
(
wdbtcOrders
.
Cells
[
15
,
row
])
else
...
...
kgOrdersClient/View.SetStatus.dfm
View file @
7068c939
...
...
@@ -48,7 +48,7 @@ object FSetStatus: TFSetStatus
WidthPercent = 100.000000000000000000
end
object WebLabel3: TWebLabel
Left =
174
Left =
90
Top = 14
Width = 57
Height = 14
...
...
@@ -184,7 +184,7 @@ object FSetStatus: TFSetStatus
object edtOrderID: TWebEdit
Left = 16
Top = 34
Width =
145
Width =
63
Height = 22
HelpType = htKeyword
TabStop = False
...
...
@@ -204,9 +204,9 @@ object FSetStatus: TFSetStatus
WidthPercent = 100.000000000000000000
end
object edtJobName: TWebEdit
Left =
174
Left =
90
Top = 34
Width =
145
Width =
229
Height = 22
HelpType = htKeyword
TabStop = False
...
...
kgOrdersClient/View.SetStatus.pas
View file @
7068c939
...
...
@@ -170,7 +170,13 @@ procedure TFSetStatus.SetDueDates();
begin
if
OrderType
=
'corrugated plate'
then
begin
if
wlcbStatus
.
DisplayText
=
'Art Done'
then
if
wlcbStatus
.
DisplayText
=
'Proof Done'
then
begin
dtpPlateDue
.
Date
:=
plateDue
;
dtpMountDue
.
Date
:=
mountDue
;
dtpShipDue
.
Date
:=
shipDue
;
end
else
if
wlcbStatus
.
DisplayText
=
'Art Done'
then
begin
dtpPlateDue
.
Date
:=
getNextDate
(
dtpDate
.
Date
);
dtpMountDue
.
Date
:=
getNextDate
(
dtpPlateDue
.
Date
);
...
...
@@ -178,29 +184,60 @@ begin
end
else
if
wlcbStatus
.
DisplayText
=
'Plate Done'
then
begin
dtpPlateDue
.
Date
:=
plateDue
;
dtpMountDue
.
Date
:=
getNextDate
(
dtpDate
.
Date
);
dtpShipDue
.
Date
:=
getNextDate
(
dtpMountDue
.
Date
);
end
else
if
wlcbStatus
.
DisplayText
=
'Mount Done'
then
begin
dtpPlateDue
.
Date
:=
plateDue
;
dtpMountDue
.
Date
:=
mountDue
;
dtpShipDue
.
Date
:=
getNextDate
(
dtpDate
.
Date
);
end
else
if
wlcbStatus
.
DisplayText
=
'Ship Done'
then
begin
dtpPlateDue
.
Date
:=
plateDue
;
dtpMountDue
.
Date
:=
mountDue
;
dtpShipDue
.
Date
:=
shipDue
;
end
;
end
else
if
OrderType
=
'web plate'
then
begin
if
wlcbStatus
.
DisplayText
=
'Art Done'
then
if
wlcbStatus
.
DisplayText
=
'Proof Done'
then
begin
dtpPlateDue
.
Date
:=
plateDue
;
dtpShipDue
.
Date
:=
shipDue
;
end
else
if
wlcbStatus
.
DisplayText
=
'Art Done'
then
begin
dtpPlateDue
.
Date
:=
getNextDate
(
dtpDate
.
Date
);
dtpShipDue
.
Date
:=
getNextDate
(
dtp
Mount
Due
.
Date
);
dtpShipDue
.
Date
:=
getNextDate
(
dtp
Plate
Due
.
Date
);
end
else
if
wlcbStatus
.
DisplayText
=
'Plate Done'
then
begin
dtpShipDue
.
Date
:=
getNextDate
(
dtpMountDue
.
Date
);
dtpPlateDue
.
Date
:=
plateDue
;
dtpShipDue
.
Date
:=
getNextDate
(
dtpDate
.
Date
);
end
else
if
wlcbStatus
.
DisplayText
=
'Ship Done'
then
begin
dtpPlateDue
.
Date
:=
plateDue
;
dtpShipDue
.
Date
:=
shipDue
;
end
;
end
else
begin
if
wlcbStatus
.
DisplayText
=
'Art Done'
then
if
wlcbStatus
.
DisplayText
=
'Proof Done'
then
begin
dtpShipDue
.
Date
:=
shipDue
;
end
else
if
wlcbStatus
.
DisplayText
=
'Art Done'
then
begin
dtpShipDue
.
Date
:=
getNextDate
(
dtpDate
.
Date
);
end
else
if
wlcbStatus
.
DisplayText
=
'Ship Done'
then
begin
dtpShipDue
.
Date
:=
shipDue
;
end
;
end
;
end
;
...
...
kgOrdersServer/Source/Auth.Database.dfm
View file @
7068c939
...
...
@@ -10,6 +10,45 @@ object AuthDatabase: TAuthDatabase
FetchRows = 100
Left = 162
Top = 45
object uqUSER_ID: TIntegerField
FieldName = 'USER_ID'
end
object uqUSER_NAME: TStringField
FieldName = 'USER_NAME'
Required = True
Size = 56
end
object uqPASSWORD: TStringField
FieldName = 'PASSWORD'
Size = 128
end
object uqNAME: TStringField
FieldName = 'NAME'
Size = 40
end
object uqSTATUS: TStringField
FieldName = 'STATUS'
Size = 7
end
object uqEMAIL: TStringField
FieldName = 'EMAIL'
Size = 50
end
object uqACCESS_TYPE: TStringField
FieldName = 'ACCESS_TYPE'
Size = 5
end
object uqSYSTEM_RIGHTS: TIntegerField
FieldName = 'SYSTEM_RIGHTS'
end
object uqPERSPECTIVE_ID: TStringField
FieldName = 'PERSPECTIVE_ID'
Size = 128
end
object uqQB_ID: TStringField
FieldName = 'QB_ID'
Size = 45
end
end
object uqMisc: TUniQuery
FetchRows = 100
...
...
@@ -18,6 +57,7 @@ object AuthDatabase: TAuthDatabase
end
object ucKG: TUniConnection
ProviderName = 'MySQL'
Database = 'kg_order_entry'
LoginPrompt = False
Left = 67
Top = 131
...
...
kgOrdersServer/Source/Auth.Database.pas
View file @
7068c939
...
...
@@ -14,6 +14,16 @@ type
uqMisc
:
TUniQuery
;
ucKG
:
TUniConnection
;
MySQLUniProvider1
:
TMySQLUniProvider
;
uqUSER_ID
:
TIntegerField
;
uqUSER_NAME
:
TStringField
;
uqPASSWORD
:
TStringField
;
uqNAME
:
TStringField
;
uqSTATUS
:
TStringField
;
uqEMAIL
:
TStringField
;
uqACCESS_TYPE
:
TStringField
;
uqSYSTEM_RIGHTS
:
TIntegerField
;
uqPERSPECTIVE_ID
:
TStringField
;
uqQB_ID
:
TStringField
;
procedure
DataModuleCreate
(
Sender
:
TObject
);
procedure
DataModuleDestroy
(
Sender
:
TObject
);
private
...
...
kgOrdersServer/Source/Auth.ServiceImpl.pas
View file @
7068c939
...
...
@@ -18,15 +18,6 @@ type
strict
private
authDB
:
TAuthDatabase
;
private
userName
:
string
;
userFullName
:
string
;
userId
:
string
;
userPerspectiveID
:
string
;
userQBID
:
string
;
userAccessType
:
string
;
userEmail
:
string
;
userStatus
:
string
;
qbEnabled
:
boolean
;
function
CheckUser
(
const
user
,
password
:
string
):
Integer
;
public
function
Login
(
const
user
,
password
:
string
):
string
;
...
...
@@ -110,6 +101,7 @@ var
userState
:
Integer
;
iniFile
:
TIniFile
;
JWT
:
TJWT
;
qbEnabled
:
boolean
;
begin
Logger
.
Log
(
3
,
Format
(
'AuthService.Login - User: "%s"'
,
[
User
]));
try
...
...
kgOrdersServer/Source/Common.Config.pas
View file @
7068c939
...
...
@@ -64,6 +64,13 @@ begin
Logger
.
Log
(
1
,
'-- jwtTokenSecret: '
+
serverConfig
.
jwtTokenSecret
+
IfThen
(
serverConfig
.
jwtTokenSecret
=
'super_secret0123super_secret4567'
,
' [default]'
,
' [from config]'
));
Logger
.
Log
(
1
,
'-- webAppFolder: '
+
serverConfig
.
webAppFolder
+
IfThen
(
serverConfig
.
webAppFolder
=
'static'
,
' [default]'
,
' [from config]'
));
Logger
.
Log
(
1
,
'-- serverConfig.reportsFolder: '
+
serverConfig
.
reportsFolder
);
if
not
DirectoryExists
(
serverConfig
.
reportsFolder
+
'reports\'
)
then
begin
ForceDirectories
(
serverConfig
.
reportsFolder
+
'reports\'
);
Logger
.
Log
(
1
,
'-- Reports directory created: '
+
serverConfig
.
reportsFolder
+
'reports\'
);
end
;
Logger
.
Log
(
1
,
'--LoadServerConfig - end'
);
end
;
...
...
@@ -78,7 +85,8 @@ begin
adminPassword
:=
'whatisthisusedfor'
;
jwtTokenSecret
:=
'super_secret0123super_secret4567'
;
webAppFolder
:=
'static'
;
reportsFolder
:=
'static/'
;
reportsFolder
:=
'static\'
;
ServerConfigStr
:=
Bcl
.
Json
.
TJson
.
Serialize
(
ServerConfig
);
Logger
.
Log
(
1
,
'--ServerConfigSerialize: '
+
ServerConfigStr
);
Logger
.
Log
(
1
,
'--TServerConfig.Create - end'
);
...
...
kgOrdersServer/Source/Main.pas
View file @
7068c939
...
...
@@ -127,15 +127,15 @@ begin
Logger
.
Log
(
1
,
'--- Settings ---'
);
iniStr
:=
iniFile
.
ReadString
(
'Settings'
,
'MemoLogLevel'
,
''
);
if
iniStr
.
IsEmpty
then
Logger
.
Log
(
1
,
'--Settings->
m
emoLogLevel: Entry not found - default: 3'
)
Logger
.
Log
(
1
,
'--Settings->
M
emoLogLevel: Entry not found - default: 3'
)
else
Logger
.
Log
(
1
,
'--Settings->
m
emoLogLevel: '
+
iniStr
);
Logger
.
Log
(
1
,
'--Settings->
M
emoLogLevel: '
+
iniStr
);
iniStr
:=
iniFile
.
ReadString
(
'Settings'
,
'FileLogLevel'
,
''
);
if
iniStr
.
IsEmpty
then
Logger
.
Log
(
1
,
'--Settings->
f
ileLogLevel: Entry not found - default: 4'
)
Logger
.
Log
(
1
,
'--Settings->
F
ileLogLevel: Entry not found - default: 4'
)
else
Logger
.
Log
(
1
,
'--Settings->
f
ileLogLevel: '
+
iniStr
);
Logger
.
Log
(
1
,
'--Settings->
F
ileLogLevel: '
+
iniStr
);
Logger
.
Log
(
1
,
''
);
iniStr
:=
iniFile
.
ReadString
(
'Settings'
,
'LogFileNum'
,
''
);
...
...
@@ -144,6 +144,12 @@ begin
else
Logger
.
Log
(
1
,
'--Settings->LogFileNum: '
+
IntToStr
(
StrToInt
(
iniStr
)
-
1
)
);
iniStr
:=
iniFile
.
ReadString
(
'Settings'
,
'WebClientVersion'
,
''
);
if
iniStr
.
IsEmpty
then
Logger
.
Log
(
1
,
'--Settings->WebClientVersion: Entry not found - ERROR: ini entry required!!!'
)
else
Logger
.
Log
(
1
,
'--Settings->WebClientVersion: '
+
iniStr
);
Logger
.
Log
(
1
,
'--- Database ---'
);
iniStr
:=
IniFile
.
ReadString
(
'Database'
,
'Server'
,
''
);
if
iniStr
.
IsEmpty
then
...
...
kgOrdersServer/Source/QBService.pas
deleted
100644 → 0
View file @
c15c23b4
unit
QBService
;
interface
uses
XData
.
Service
.
Common
,
Aurelius
.
Mapping
.
Attributes
,
System
.
JSON
,
System
.
Generics
.
Collections
,
System
.
Classes
;
type
[
ServiceContract
]
IQBService
=
interface
(
IInvokable
)
[
'{D119A273-0644-484B-B75E-B6FE57BB422C}'
]
[
HttpGet
]
function
getCustomers
():
TJSONArray
;
end
;
implementation
initialization
RegisterServiceType
(
TypeInfo
(
IQBService
));
end
.
kgOrdersServer/Source/QBServiceImplementation.pas
deleted
100644 → 0
View file @
c15c23b4
unit
QBServiceImplementation
;
interface
uses
XData
.
Server
.
Module
,
XData
.
Service
.
Common
,
Api
.
Database
,
Data
.
DB
,
frxClass
,
frxExportPDF
,
JS
,
System
.
Hash
,
System
.
JSON
,
Winapi
.
Windows
,
Winapi
.
Messages
,
System
.
SysUtils
,
System
.
Variants
,
System
.
Classes
,
Vcl
.
Graphics
,
Vcl
.
Controls
,
Vcl
.
Forms
,
Vcl
.
Dialogs
,
MemDS
,
DBAccess
,
Uni
,
hyiedefs
,
hyieutils
,
iexBitmaps
,
iesettings
,
iexLayers
,
iexRulers
,
iexToolbars
,
iexUserInteractions
,
imageenio
,
imageenproc
,
QuickRpt
,
QRCtrls
,
dbimageen
,
Vcl
.
ExtCtrls
,
ieview
,
imageenview
,
IdBaseComponent
,
IdComponent
,
IdTCPConnection
,
IdTCPClient
,
IdExplicitTLSClientServerBase
,
IdFTP
,
iexProcEffects
,
frCoreClasses
,
Common
.
Logging
,
DateUtils
,
QBService
,
WEBLib
.
REST
,
WEBLib
.
WebTools
,
System
.
Net
.
HttpClient
,
System
.
Net
.
URLClient
,
System
.
Net
.
HttpClientComponent
,
System
.
netencoding
,
IdHTTP
,
IdSSLOpenSSL
,
IdSSLOpenSSLHeaders
,
System
.
IniFiles
,
REST
.
Client
,
REST
.
Types
;
type
[
ServiceImplementation
]
TQBService
=
class
(
TInterfacedObject
,
IQBService
)
private
procedure
SaveTokens
(
AccessToken
,
RefreshToken
:
string
);
function
getCustomers
():
TJSONArray
;
function
refreshAccessToken
():
string
;
var
AccessToken
,
RefreshToken
,
CompanyID
,
Client
,
Secret
:
string
;
LastRefresh
:
TDateTime
;
end
;
implementation
function
TQBService
.
getCustomers
:
TJSONArray
;
var
restClient
:
TRESTClient
;
restRequest
:
TRESTRequest
;
restResponse
:
TRESTResponse
;
param
:
TRESTRequestParameter
;
res
:
string
;
jsValue
:
TJSONValue
;
Customer
:
TJSONValue
;
jsObj
:
TJSONObject
;
CustomerList
:
TJSONArray
;
pair
:
TJSONPair
;
begin
restClient
:=
TRESTClient
.
Create
(
nil
);
restClient
.
BaseURL
:=
'https://sandbox-quickbooks.api.intuit.com'
;
restRequest
:=
TRESTRequest
.
Create
(
nil
);
restRequest
.
Client
:=
restClient
;
restResponse
:=
TRESTResponse
.
Create
(
nil
);
restRequest
.
Response
:=
restResponse
;
if
MinutesBetween
(
Now
,
LastRefresh
)
>
58
then
begin
RefreshAccessToken
();
end
;
restRequest
.
Method
:=
rmGET
;
//GET /v3/company/<realmId>/customer/<customerId>
res
:=
'/v3/company/'
+
companyid
+
'/customer/58'
;
restRequest
.
Resource
:=
res
;
param
:=
restRequest
.
Params
.
AddItem
;
param
.
Name
:=
'Authorization'
;
param
.
Kind
:=
pkHTTPHEADER
;
param
.
Options
:=
param
.
Options
+
[
TRESTRequestParameterOption
.
poDoNotEncode
];
param
.
Value
:=
'Bearer '
+
AccessToken
;
restRequest
.
Execute
;
jsValue
:=
restResponse
.
JSONValue
;
jsObj
:=
TJSONObject
(
jsValue
);
CustomerList
:=
TJSONArray
(
TJSONObject
(
jsObj
.
GetValue
(
'QueryResponse'
)
).
GetValue
(
'Customer'
))
;
result
:=
CustomerList
;
// LoadJSONArray( CustomerList );
restClient
.
Free
;
restRequest
.
Free
;
restResponse
.
Free
;
end
;
function
TQBService
.
RefreshAccessToken
:
string
;
// Refresh Token changes so make sure to save refresh token.
var
IdHTTP
:
TIdHTTP
;
SSLIO
:
TIdSSLIOHandlerSocketOpenSSL
;
RequestStream
:
TStringStream
;
EncodedAuth
,
EncodedAuth2
,
PostData
,
response
:
string
;
f
:
TStringList
;
fi
:
string
;
JSObj
:
TJSONObject
;
Encoder
:
TBase64Encoding
;
begin
// 1. Encode credentials (same as working Postman request)
// TNetEncoding.Base64.Encode adds a new line every 72 chars, this stops that
Encoder
:=
TBase64Encoding
.
Create
(
0
);
if
(
(
Client
=
''
)
or
(
Secret
=
''
)
)
then
begin
Exit
();
end
;
EncodedAuth
:=
Encoder
.
Encode
(
Client
+
':'
+
Secret
);
if
RefreshToken
=
''
then
begin
Exit
();
end
;
// 2. Prepare POST data (EXACTLY as in Postman)
PostData
:=
'grant_type=refresh_token&refresh_token='
+
RefreshToken
;
// 3. Configure HTTP client
IdHTTP
:=
TIdHTTP
.
Create
(
nil
);
SSLIO
:=
TIdSSLIOHandlerSocketOpenSSL
.
Create
(
nil
);
try
// Force TLS 1.2
SSLIO
.
SSLOptions
.
Method
:=
sslvTLSv1_2
;
SSLIO
.
SSLOptions
.
SSLVersions
:=
[
sslvTLSv1_2
];
IdHTTP
.
IOHandler
:=
SSLIO
;
// Set headers
IdHTTP
.
Request
.
ContentType
:=
'application/x-www-form-urlencoded'
;
IdHTTP
.
Request
.
Accept
:=
'application/json'
;
IdHTTP
.
Request
.
CustomHeaders
.
AddValue
(
'Authorization'
,
'Basic '
+
EncodedAuth
);
// 4. Create and send request
RequestStream
:=
TStringStream
.
Create
(
PostData
,
TEncoding
.
UTF8
);
try
// Execute POST
try
response
:=
IdHTTP
.
Post
(
'https://oauth.platform.intuit.com/oauth2/v1/tokens/bearer'
,
RequestStream
);
JSObj
:=
TJSONObject
.
ParseJSONValue
(
response
)
as
TJSONObject
;
RefreshToken
:=
JSObj
.
GetValue
(
'refresh_token'
).
ToString
.
Trim
([
'"'
]);
AccessToken
:=
JSObj
.
GetValue
(
'access_token'
).
ToString
.
Trim
([
'"'
]);
SaveTokens
(
AccessToken
,
RefreshToken
);
Result
:=
AccessToken
;
except
on
E
:
EIdHTTPProtocolException
do
// Memo2.Lines.Add('Error: ' + E.Message + #13#10 + 'Response: ' + E.ErrorMessage);
end
;
finally
RequestStream
.
Free
;
end
;
finally
SSLIO
.
Free
;
IdHTTP
.
Free
;
end
;
end
;
procedure
TQBService
.
SaveTokens
(
AccessToken
,
RefreshToken
:
string
);
var
f
:
TStringList
;
iniFile
:
TIniFile
;
begin
iniFile
:=
TIniFile
.
Create
(
ExtractFilePath
(
Application
.
ExeName
)
+
'kgOrdersServer.ini'
);
try
iniFile
.
WriteString
(
'Quickbooks'
,
'RefreshToken'
,
RefreshToken
);
LastRefresh
:=
Now
;
finally
IniFile
.
Free
;
end
;
f
:=
TStringList
.
Create
;
// Save to file (overwrites existing file)
f
.
SaveToFile
(
'QB.txt'
);
f
.
Free
;
end
;
initialization
RegisterServiceType
(
TQBService
);
end
.
kgOrdersServer/Source/rOrderCorrugated.pas
View file @
7068c939
...
...
@@ -133,7 +133,7 @@ implementation
{$R *.dfm}
uses
uLibrary
,
Common
.
Config
;
uLibrary
,
Common
.
Config
,
XData
.
Sys
.
Exceptions
;
procedure
TrptOrderCorrugated
.
DataModuleCreate
(
Sender
:
TObject
);
begin
...
...
@@ -200,12 +200,6 @@ var
begin
ReportDir
:=
ServerConfig
.
reportsFolder
;
if
not
DirectoryExists
(
ReportDir
+
'reports\'
)
then
begin
ForceDirectories
(
ReportDir
+
'reports\'
);
Logger
.
Log
(
1
,
'Reports directory created: '
+
ReportDir
+
'reports\'
);
end
;
reportURL
:=
'reports/'
+
FormatDateTime
(
'yyyymmdd_hhnnss'
,
Now
)
+
'.pdf'
;
ReportFileName
:=
reportDir
+
reportUrl
;
...
...
@@ -216,10 +210,13 @@ begin
frxOrderCorrugated
.
PrepareReport
;
frxOrderCorrugated
.
Export
(
frxPDFExport1
);
//frxOrders.ShowPreparedReport;
finally
frxOrderCorrugated
.
Clear
;
// Clears the report to avoid memory bloat
frxOrderCorrugated
.
Clear
;
// Clears the report to avoid memory bloat
end
;
Logger
.
Log
(
5
,
'PDF saved to: '
+
ReportFileName
);
result
:=
reportURL
;
end
;
...
...
kgOrdersServer/Source/rOrderCutting.pas
View file @
7068c939
...
...
@@ -60,7 +60,7 @@ var
implementation
uses
uLibrary
,
Common
.
Config
;
uLibrary
,
Common
.
Config
,
XData
.
Sys
.
Exceptions
;
{%CLASSGROUP 'Vcl.Controls.TControl'}
...
...
@@ -98,12 +98,6 @@ var
begin
ReportDir
:=
ServerConfig
.
reportsFolder
;
if
not
DirectoryExists
(
ReportDir
+
'reports\'
)
then
begin
ForceDirectories
(
ReportDir
+
'reports\'
);
Logger
.
Log
(
1
,
'Reports directory created: '
+
ReportDir
+
'reports\'
);
end
;
reportURL
:=
'reports\'
+
FormatDateTime
(
'yyyymmdd_hhnnss'
,
Now
)
+
'.pdf'
;
ReportFileName
:=
reportDir
+
reportUrl
;
...
...
kgOrdersServer/Source/rOrderList.pas
View file @
7068c939
...
...
@@ -59,7 +59,7 @@ var
implementation
uses
uLibrary
,
Common
.
Config
;
uLibrary
,
Common
.
Config
,
XData
.
Sys
.
Exceptions
;
{%CLASSGROUP 'Vcl.Controls.TControl'}
...
...
@@ -201,12 +201,6 @@ var
begin
ReportDir
:=
ServerConfig
.
reportsFolder
;
if
not
DirectoryExists
(
ReportDir
+
'reports\'
)
then
begin
ForceDirectories
(
ReportDir
+
'reports\'
);
Logger
.
Log
(
1
,
'Reports directory created: '
+
ReportDir
+
'reports\'
);
end
;
reportURL
:=
'reports/'
+
FormatDateTime
(
'yyyymmdd_hhnnss'
,
Now
)
+
'.pdf'
;
ReportFileName
:=
reportDir
+
reportUrl
;
...
...
kgOrdersServer/Source/rOrderWeb.pas
View file @
7068c939
...
...
@@ -132,7 +132,7 @@ implementation
{$R *.dfm}
uses
uLibrary
,
Common
.
Config
;
uLibrary
,
Common
.
Config
,
XData
.
Sys
.
Exceptions
;
procedure
TrptOrderWeb
.
DataModuleCreate
(
Sender
:
TObject
);
begin
...
...
@@ -200,12 +200,6 @@ var
begin
ReportDir
:=
ServerConfig
.
reportsFolder
;
if
not
DirectoryExists
(
ReportDir
+
'reports\'
)
then
begin
ForceDirectories
(
ReportDir
+
'reports\'
);
Logger
.
Log
(
1
,
'Reports directory created: '
+
ReportDir
+
'reports\'
);
end
;
reportURL
:=
'reports\'
+
FormatDateTime
(
'yyyymmdd_hhnnss'
,
Now
)
+
'.pdf'
;
ReportFileName
:=
reportDir
+
reportUrl
;
...
...
kgOrdersServer/bin/kgOrdersServer.ini
View file @
7068c939
[Settings]
MemoLogLevel
=
0
FileLogLevel
=
0
MemoLogLevel
=
5
FileLogLevel
=
5
webClientVersion
=
0.9.11
LogFileNum
=
187
LogFileNum
=
205
[Database]
--Server
=
192.168.116.132
...
...
kgOrdersServer/kgOrdersServer.dpr
View file @
7068c939
...
...
@@ -158,8 +158,8 @@ end;
var
iniFile: TIniFile;
m
emoLogLevel: Integer;
f
ileLogLevel: Integer;
M
emoLogLevel: Integer;
F
ileLogLevel: Integer;
begin
ReportMemoryLeaksOnShutdown := True;
...
...
@@ -168,12 +168,12 @@ begin
Application.CreateForm(TFMain, FMain);
iniFile := TIniFile.Create( ExtractFilePath(Application.ExeName) + 'kgOrdersServer.ini' );
try
memoLogLevel := iniFile.ReadInteger( 'Settings', 'm
emoLogLevel', 3 );
fileLogLevel := iniFile.ReadInteger( 'Settings', 'memo
LogLevel', 4 );
MemoLogLevel := iniFile.ReadInteger( 'Settings', 'M
emoLogLevel', 3 );
FileLogLevel := iniFile.ReadInteger( 'Settings', 'File
LogLevel', 4 );
finally
iniFile.Free;
end;
Logger.AddAppender(TMemoLogAppender.Create(
m
emoLogLevel, FMain.memoinfo ));
Logger.AddAppender(TFileLogAppender.Create(
f
ileLogLevel, 'kgOrdersServer' ));
Logger.AddAppender(TMemoLogAppender.Create(
M
emoLogLevel, FMain.memoinfo ));
Logger.AddAppender(TFileLogAppender.Create(
F
ileLogLevel, 'kgOrdersServer' ));
Application.Run;
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