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
5aaae14f
Commit
5aaae14f
authored
Apr 26, 2026
by
Elias Sarraf
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
ver 0.9.15.1 changes -trying to figure out server / client EXDataHttpException handling
parent
f7e6f7f0
Hide whitespace changes
Inline
Side-by-side
Showing
15 changed files
with
247 additions
and
130 deletions
+247
-130
ConnectionModule.pas
kgOrdersClient/ConnectionModule.pas
+25
-5
View.Customer.Add.pas
kgOrdersClient/View.Customer.Add.pas
+18
-4
Api.Database.pas
kgOrdersServer/Source/Api.Database.pas
+1
-4
Auth.Database.pas
kgOrdersServer/Source/Auth.Database.pas
+1
-3
Auth.ServiceImpl.pas
kgOrdersServer/Source/Auth.ServiceImpl.pas
+9
-1
Common.Ini.pas
kgOrdersServer/Source/Common.Ini.pas
+88
-0
Main.pas
kgOrdersServer/Source/Main.pas
+15
-44
rOrderCorrugated.pas
kgOrdersServer/Source/rOrderCorrugated.pas
+1
-1
rOrderCutting.pas
kgOrdersServer/Source/rOrderCutting.pas
+1
-1
rOrderList.pas
kgOrdersServer/Source/rOrderList.pas
+1
-1
rOrderWeb.dfm
kgOrdersServer/Source/rOrderWeb.dfm
+0
-1
rOrderWeb.pas
kgOrdersServer/Source/rOrderWeb.pas
+1
-1
uLibrary.pas
kgOrdersServer/Source/uLibrary.pas
+10
-17
kgOrdersServer.dpr
kgOrdersServer/kgOrdersServer.dpr
+75
-47
kgOrdersServer.dproj
kgOrdersServer/kgOrdersServer.dproj
+1
-0
No files found.
kgOrdersClient/ConnectionModule.pas
View file @
5aaae14f
unit
ConnectionModule
;
unit
ConnectionModule
;
interface
interface
uses
uses
System
.
SysUtils
,
System
.
Classes
,
WEBLib
.
Modules
,
XData
.
Web
.
Connection
,
System
.
SysUtils
,
System
.
Classes
,
WEBLib
.
Modules
,
WEBLib
.
Dialogs
,
App
.
Types
,
App
.
Config
,
XData
.
Web
.
Client
;
App
.
Types
,
App
.
Config
,
XData
.
Web
.
C
onnection
,
XData
.
Web
.
C
lient
;
type
type
TDMConnection
=
class
(
TWebDataModule
)
TDMConnection
=
class
(
TWebDataModule
)
...
@@ -42,8 +42,17 @@ uses
...
@@ -42,8 +42,17 @@ uses
{$R *.dfm}
{$R *.dfm}
procedure
TDMConnection
.
ApiConnectionError
(
Error
:
TXDataWebConnectionError
);
procedure
TDMConnection
.
ApiConnectionError
(
Error
:
TXDataWebConnectionError
);
var
errorMsg
:
string
;
begin
begin
TFViewErrorPage
.
DisplayConnectionError
(
Error
);
errorMsg
:=
Error
.
ErrorMessage
;
if
errorMsg
=
''
then
errorMsg
:=
'Connection error'
;
if
Assigned
(
FUnauthorizedAccessProc
)
then
FUnauthorizedAccessProc
(
errorMsg
)
else
ShowMessage
(
errorMsg
);
end
;
end
;
...
@@ -63,8 +72,19 @@ end;
...
@@ -63,8 +72,19 @@ end;
procedure
TDMConnection
.
AuthConnectionError
(
Error
:
TXDataWebConnectionError
);
procedure
TDMConnection
.
AuthConnectionError
(
Error
:
TXDataWebConnectionError
);
var
errorMsg
:
string
;
begin
begin
TFViewErrorPage
.
DisplayConnectionError
(
Error
);
errorMsg
:=
Error
.
ErrorMessage
;
if
errorMsg
=
''
then
errorMsg
:=
'Connection error'
;
if
errorMsg
=
'Error connecting to XData server'
then
ShowMessage
(
'Error connecting to kgOrdersServer'
+
sLineBreak
+
'Please contact EM Systems support'
)
else
if
Assigned
(
FUnauthorizedAccessProc
)
then
FUnauthorizedAccessProc
(
errorMsg
)
else
ShowMessage
(
errorMsg
);
end
;
end
;
...
...
kgOrdersClient/View.Customer.Add.pas
View file @
5aaae14f
...
@@ -276,6 +276,7 @@ begin
...
@@ -276,6 +276,7 @@ begin
Utils
.
HideSpinner
(
'spinner'
);
Utils
.
HideSpinner
(
'spinner'
);
end
;
end
;
procedure
TFViewAddCustomer
.
SendAddressToServer
;
procedure
TFViewAddCustomer
.
SendAddressToServer
;
// Creates an Address JSON and then sends it to the server for the address to be
// Creates an Address JSON and then sends it to the server for the address to be
// Added or edited.
// Added or edited.
...
@@ -341,7 +342,6 @@ begin
...
@@ -341,7 +342,6 @@ begin
xdwdsShipTo
.
SetJSONData
(
notification
[
'ADDRESS'
]);
xdwdsShipTo
.
SetJSONData
(
notification
[
'ADDRESS'
]);
xdwdsShipTo
.
Open
;
xdwdsShipTo
.
Open
;
console
.
log
(
xdwdsShipTo
.
RecordCount
);
console
.
log
(
xdwdsShipTo
.
RecordCount
);
console
.
log
(
xdwdsShipTo
.
FieldByName
(
'state'
).
AsString
);
console
.
log
(
xdwdsShipTo
.
FieldByName
(
'state'
).
AsString
);
edtShippingAddress
.
Text
:=
xdwdsShipTo
.
FieldByName
(
'shipping_address'
).
AsString
;
edtShippingAddress
.
Text
:=
xdwdsShipTo
.
FieldByName
(
'shipping_address'
).
AsString
;
...
@@ -386,13 +386,13 @@ begin
...
@@ -386,13 +386,13 @@ begin
end
;
end
;
procedure
TFViewAddCustomer
.
btnClearClick
(
Sender
:
TObject
);
procedure
TFViewAddCustomer
.
btnClearClick
(
Sender
:
TObject
);
// Clears the shipping address fields.
// Clears the shipping address fields.
begin
begin
Clear
();
Clear
();
end
;
end
;
procedure
TFViewAddCustomer
.
btnCloseClick
(
Sender
:
TObject
);
procedure
TFViewAddCustomer
.
btnCloseClick
(
Sender
:
TObject
);
// closes the Add Customer page.
// closes the Add Customer page.
begin
begin
...
@@ -444,6 +444,8 @@ begin
...
@@ -444,6 +444,8 @@ begin
end
end
);
);
end
;
end
;
procedure
TFViewAddCustomer
.
edtShippingAddressChange
(
Sender
:
TObject
);
procedure
TFViewAddCustomer
.
edtShippingAddressChange
(
Sender
:
TObject
);
// Puts the form into Address Edit Mode
// Puts the form into Address Edit Mode
begin
begin
...
@@ -457,12 +459,14 @@ begin
...
@@ -457,12 +459,14 @@ begin
EditMode
();
EditMode
();
end
;
end
;
procedure
TFViewAddCustomer
.
wdblcbRepChange
(
Sender
:
TObject
);
procedure
TFViewAddCustomer
.
wdblcbRepChange
(
Sender
:
TObject
);
begin
begin
if
lblFormState
.
Caption
<>
'Edit Mode'
then
if
lblFormState
.
Caption
<>
'Edit Mode'
then
EditMode
();
EditMode
();
end
;
end
;
procedure
TFViewAddCustomer
.
wdbtcAddressesClickCell
(
Sender
:
TObject
;
ACol
,
procedure
TFViewAddCustomer
.
wdbtcAddressesClickCell
(
Sender
:
TObject
;
ACol
,
ARow
:
Integer
);
ARow
:
Integer
);
begin
begin
...
@@ -481,6 +485,7 @@ begin
...
@@ -481,6 +485,7 @@ begin
edtFirstLine
.
Text
:=
''
;
edtFirstLine
.
Text
:=
''
;
end
;
end
;
procedure
TFViewAddCustomer
.
btnUpdateClick
(
Sender
:
TObject
);
procedure
TFViewAddCustomer
.
btnUpdateClick
(
Sender
:
TObject
);
begin
begin
if
XDataWebDataSet1QB_LIST_ID
.
AsString
=
''
then
if
XDataWebDataSet1QB_LIST_ID
.
AsString
=
''
then
...
@@ -489,6 +494,7 @@ begin
...
@@ -489,6 +494,7 @@ begin
UpdateCustomer
();
UpdateCustomer
();
end
;
end
;
procedure
TFViewAddCustomer
.
UpdateCustomer
;
procedure
TFViewAddCustomer
.
UpdateCustomer
;
var
var
customer
:
TJSObject
;
customer
:
TJSObject
;
...
@@ -574,6 +580,7 @@ begin
...
@@ -574,6 +580,7 @@ begin
end
;
end
;
end
;
end
;
procedure
TFViewAddCustomer
.
SendCustomerToServer
();
procedure
TFViewAddCustomer
.
SendCustomerToServer
();
// Creates the customer JSON and then sends it to the server.
// Creates the customer JSON and then sends it to the server.
var
var
...
@@ -661,6 +668,7 @@ begin
...
@@ -661,6 +668,7 @@ begin
end
;
end
;
end
;
end
;
procedure
TFViewAddCustomer
.
btnSaveClick
(
Sender
:
TObject
);
procedure
TFViewAddCustomer
.
btnSaveClick
(
Sender
:
TObject
);
// Sends the customer JSON to the server
// Sends the customer JSON to the server
begin
begin
...
@@ -670,6 +678,7 @@ begin
...
@@ -670,6 +678,7 @@ begin
end
;
end
;
end
;
end
;
procedure
TFViewAddCustomer
.
Save
;
procedure
TFViewAddCustomer
.
Save
;
var
var
input
:
TJSHTMLInputElement
;
input
:
TJSHTMLInputElement
;
...
@@ -682,6 +691,7 @@ begin
...
@@ -682,6 +691,7 @@ begin
ViewMode
();
ViewMode
();
end
;
end
;
procedure
TFViewAddCustomer
.
btnShipAddClick
(
Sender
:
TObject
);
procedure
TFViewAddCustomer
.
btnShipAddClick
(
Sender
:
TObject
);
// Sets the form to address edit mode and allows the user to add a shipping address.
// Sets the form to address edit mode and allows the user to add a shipping address.
begin
begin
...
@@ -795,6 +805,7 @@ begin
...
@@ -795,6 +805,7 @@ begin
xdwdsUsers
.
Open
;
xdwdsUsers
.
Open
;
end
;
end
;
procedure
TFViewAddCustomer
.
tmrReturnTimer
(
Sender
:
TObject
);
procedure
TFViewAddCustomer
.
tmrReturnTimer
(
Sender
:
TObject
);
// Timer to returnto the customer page because it takes slightly too long to
// Timer to returnto the customer page because it takes slightly too long to
// Delete customers causing ghost customers to show up.
// Delete customers causing ghost customers to show up.
...
@@ -820,7 +831,6 @@ begin
...
@@ -820,7 +831,6 @@ begin
else
else
input
.
classList
.
remove
(
'is-invalid'
);
input
.
classList
.
remove
(
'is-invalid'
);
input
:=
TJSHTMLInputElement
(
document
.
getElementById
(
'edtcompanyaccountname'
));
input
:=
TJSHTMLInputElement
(
document
.
getElementById
(
'edtcompanyaccountname'
));
if
edtShortName
.
Text
=
''
then
if
edtShortName
.
Text
=
''
then
begin
begin
...
@@ -830,7 +840,6 @@ begin
...
@@ -830,7 +840,6 @@ begin
else
else
input
.
classList
.
remove
(
'is-invalid'
);
input
.
classList
.
remove
(
'is-invalid'
);
// Billing Information Verification
// Billing Information Verification
input
:=
TJSHTMLInputElement
(
document
.
getElementById
(
'edtbillingaddress'
));
input
:=
TJSHTMLInputElement
(
document
.
getElementById
(
'edtbillingaddress'
));
if
edtBillAddress
.
Text
=
''
then
if
edtBillAddress
.
Text
=
''
then
...
@@ -878,6 +887,7 @@ begin
...
@@ -878,6 +887,7 @@ begin
// input.classList.remove('is-invalid');
// input.classList.remove('is-invalid');
end
;
end
;
function
TFViewAddCustomer
.
VerifyAddress
:
Boolean
;
function
TFViewAddCustomer
.
VerifyAddress
:
Boolean
;
// Verifies all the shipping information is filled in.
// Verifies all the shipping information is filled in.
var
var
...
@@ -940,6 +950,7 @@ begin
...
@@ -940,6 +950,7 @@ begin
end
;
end
;
procedure
TFViewAddCustomer
.
EditMode
;
procedure
TFViewAddCustomer
.
EditMode
;
// Enables Customer Fields while disabling shipping address fields.
// Enables Customer Fields while disabling shipping address fields.
begin
begin
...
@@ -972,6 +983,7 @@ begin
...
@@ -972,6 +983,7 @@ begin
lblFormState
.
ElementHandle
.
classList
.
add
(
'text-success'
);
lblFormState
.
ElementHandle
.
classList
.
add
(
'text-success'
);
end
;
end
;
procedure
TFViewAddCustomer
.
AddressEditMode
;
procedure
TFViewAddCustomer
.
AddressEditMode
;
// Enables Shipping Address fields while disabling customer fields.
// Enables Shipping Address fields while disabling customer fields.
begin
begin
...
@@ -1037,4 +1049,5 @@ begin
...
@@ -1037,4 +1049,5 @@ begin
lblFormState
.
ElementHandle
.
classList
.
add
(
'text-danger'
);
lblFormState
.
ElementHandle
.
classList
.
add
(
'text-danger'
);
end
;
end
;
end
.
end
.
\ No newline at end of file
kgOrdersServer/Source/Api.Database.pas
View file @
5aaae14f
// Where the database is kept. Only used by Lookup.ServiceImpl to retrieve info
// from the data base and send it to the client.
// Author: ???
unit
Api
.
Database
;
unit
Api
.
Database
;
interface
interface
...
@@ -136,7 +133,7 @@ uses
...
@@ -136,7 +133,7 @@ uses
procedure
TApiDatabase
.
DataModuleCreate
(
Sender
:
TObject
);
procedure
TApiDatabase
.
DataModuleCreate
(
Sender
:
TObject
);
begin
begin
Logger
.
Log
(
5
,
'TApiDatabase.DataModuleCreate'
);
Logger
.
Log
(
5
,
'TApiDatabase.DataModuleCreate'
);
LoadDatabaseSettings
(
ucKG
,
'kgOrdersServer.ini'
);
LoadDatabaseSettings
(
ucKG
);
try
try
ucKG
.
Connect
;
ucKG
.
Connect
;
except
except
...
...
kgOrdersServer/Source/Auth.Database.pas
View file @
5aaae14f
// Auth Database to verify logins
unit
Auth
.
Database
;
unit
Auth
.
Database
;
interface
interface
...
@@ -50,7 +48,7 @@ uses
...
@@ -50,7 +48,7 @@ uses
procedure
TAuthDatabase
.
DataModuleCreate
(
Sender
:
TObject
);
procedure
TAuthDatabase
.
DataModuleCreate
(
Sender
:
TObject
);
begin
begin
Logger
.
Log
(
5
,
'TAuthDatabase.DataModuleCreate'
);
Logger
.
Log
(
5
,
'TAuthDatabase.DataModuleCreate'
);
LoadDatabaseSettings
(
ucKG
,
'kgOrdersServer.ini'
);
LoadDatabaseSettings
(
ucKG
);
try
try
ucKG
.
Connect
;
ucKG
.
Connect
;
except
except
...
...
kgOrdersServer/Source/Auth.ServiceImpl.pas
View file @
5aaae14f
...
@@ -49,22 +49,25 @@ procedure TAuthService.AfterConstruction;
...
@@ -49,22 +49,25 @@ procedure TAuthService.AfterConstruction;
begin
begin
inherited
;
inherited
;
try
try
Logger
.
Log
(
4
,
'TAuthService.AfterConstruction'
);
authDB
:=
TAuthDatabase
.
Create
(
nil
);
authDB
:=
TAuthDatabase
.
Create
(
nil
);
except
except
on
E
:
Exception
do
on
E
:
Exception
do
begin
begin
Logger
.
Log
(
1
,
'Error
when
creating the Auth database: '
+
E
.
Message
);
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
;
end
;
end
;
end
;
procedure
TAuthService
.
BeforeDestruction
;
procedure
TAuthService
.
BeforeDestruction
;
begin
begin
authDB
.
Free
;
authDB
.
Free
;
inherited
;
inherited
;
end
;
end
;
function
TAuthService
.
VerifyVersion
(
clientVersion
:
string
):
TJSONObject
;
function
TAuthService
.
VerifyVersion
(
clientVersion
:
string
):
TJSONObject
;
var
var
iniFile
:
TIniFile
;
iniFile
:
TIniFile
;
...
@@ -146,6 +149,7 @@ begin
...
@@ -146,6 +149,7 @@ begin
end
;
end
;
end
;
end
;
function
TAuthService
.
CheckUser
(
const
user
,
password
:
string
):
Integer
;
function
TAuthService
.
CheckUser
(
const
user
,
password
:
string
):
Integer
;
var
var
SQL
:
string
;
SQL
:
string
;
...
@@ -175,6 +179,7 @@ begin
...
@@ -175,6 +179,7 @@ begin
end
;
end
;
end
;
end
;
function
TAuthService
.
QBAuthorize
(
code
,
realmId
,
state
:
string
):
string
;
function
TAuthService
.
QBAuthorize
(
code
,
realmId
,
state
:
string
):
string
;
var
var
iniFile
:
TIniFile
;
iniFile
:
TIniFile
;
...
@@ -187,6 +192,7 @@ begin
...
@@ -187,6 +192,7 @@ begin
Logger
.
Log
(
3
,
'TAuthService.QBAuthorize - end - result: '
+
result
);
Logger
.
Log
(
3
,
'TAuthService.QBAuthorize - end - result: '
+
result
);
end
;
end
;
function
TAuthService
.
ExchangeQBAuthCode
(
code
:
string
):
string
;
function
TAuthService
.
ExchangeQBAuthCode
(
code
:
string
):
string
;
var
var
iniFile
:
TIniFile
;
iniFile
:
TIniFile
;
...
@@ -280,6 +286,8 @@ begin
...
@@ -280,6 +286,8 @@ begin
end
;
end
;
end
;
end
;
initialization
initialization
RegisterServiceType
(
TAuthService
);
RegisterServiceType
(
TAuthService
);
end
.
end
.
kgOrdersServer/Source/Common.Ini.pas
0 → 100644
View file @
5aaae14f
unit
Common
.
Ini
;
interface
uses
System
.
SysUtils
,
System
.
IniFiles
,
Vcl
.
Forms
;
type
TIniEntries
=
class
private
// [Settings]
FMemoLogLevel
:
Integer
;
FFileLogLevel
:
Integer
;
FLogFileNum
:
Integer
;
// [Database]
FDBServer
:
string
;
FDBPort
:
Integer
;
FDBDatabase
:
string
;
FDBUsername
:
string
;
FDBPassword
:
string
;
public
constructor
Create
;
// Properties
property
memoLogLevel
:
Integer
read
FMemoLogLevel
;
property
fileLogLevel
:
Integer
read
FFileLogLevel
;
property
logFileNum
:
Integer
read
FLogFileNum
;
property
dbServer
:
string
read
FDBServer
;
property
dbPort
:
Integer
read
FDBPort
;
property
dbDatabase
:
string
read
FDBDatabase
;
property
dbUsername
:
string
read
FDBUsername
;
property
dbPassword
:
string
read
FDBPassword
;
end
;
procedure
LoadIniEntries
;
var
IniEntries
:
TIniEntries
;
implementation
uses
Common
.
Logging
;
procedure
LoadIniEntries
;
begin
Logger
.
Log
(
1
,
'IniEntries global variable instantiated'
);
end
;
{ TIniEntries }
constructor
TIniEntries
.
Create
;
var
iniFile
:
TIniFile
;
begin
iniFile
:=
TIniFile
.
Create
(
ChangeFileExt
(
Application
.
ExeName
,
'.ini'
));
try
// [Settings]
FMemoLogLevel
:=
iniFile
.
ReadInteger
(
'Settings'
,
'MemoLogLevel'
,
3
);
FFileLogLevel
:=
iniFile
.
ReadInteger
(
'Settings'
,
'FileLogLevel'
,
3
);
FLogFileNum
:=
iniFile
.
ReadInteger
(
'Settings'
,
'LogFileNum'
,
0
);
Inc
(
FLogFileNum
);
iniFile
.
WriteInteger
(
'Settings'
,
'LogFileNum'
,
FLogFileNum
);
// [Database]
FDBServer
:=
iniFile
.
ReadString
(
'Database'
,
'Server'
,
''
);
FDBPort
:=
iniFile
.
ReadInteger
(
'Database'
,
'Port'
,
0
);
FDBDatabase
:=
iniFile
.
ReadString
(
'Database'
,
'Database'
,
'kg_order_entry'
);
FDBUsername
:=
iniFile
.
ReadString
(
'Database'
,
'Username'
,
'root'
);
FDBPassword
:=
iniFile
.
ReadString
(
'Database'
,
'Password'
,
'emsys01'
);
finally
iniFile
.
Free
;
end
;
end
;
initialization
IniEntries
:=
TIniEntries
.
Create
;
finalization
IniEntries
.
Free
;
end
.
kgOrdersServer/Source/Main.pas
View file @
5aaae14f
...
@@ -42,6 +42,7 @@ implementation
...
@@ -42,6 +42,7 @@ implementation
uses
uses
Common
.
Logging
,
Common
.
Logging
,
Common
.
Ini
,
Common
.
Config
,
Common
.
Config
,
Sparkle
.
Utils
,
Sparkle
.
Utils
,
Api
.
Database
,
Api
.
Database
,
...
@@ -110,50 +111,19 @@ end;
...
@@ -110,50 +111,19 @@ end;
procedure
TFMain
.
StartServers
;
procedure
TFMain
.
StartServers
;
// Reads from the ini file to figure out what IP the database is located at and
// whether or not Twilio automatic updates should be enabled
var
var
iniFile
:
TIniFile
;
iniFile
:
TIniFile
;
iniStr
:
string
;
iniStr
:
string
;
bContinue
:
boolean
;
bContinue
:
boolean
;
de
bug
Mode
:
boolean
;
de
v
Mode
:
boolean
;
begin
begin
// The version is centered when the app is running
Logger
.
Log
(
1
,
'*******************************************************'
);
Logger
.
Log
(
1
,
'* kgOrdersServer *'
);
Logger
.
Log
(
1
,
Format
(
' Version: %s '
,
[
FMain
.
ExeInfo1
.
FileVersion
]));
Logger
.
Log
(
1
,
'* Developed by EM Systems, Inc. *'
);
Logger
.
Log
(
1
,
'*******************************************************'
);
Logger
.
Log
(
1
,
''
);
bContinue
:=
True
;
bContinue
:=
True
;
iniFile
:=
TIniFile
.
Create
(
ExtractFilePath
(
Application
.
ExeName
)
+
'kgOrdersServer.ini'
);
iniFile
:=
TIniFile
.
Create
(
ExtractFilePath
(
Application
.
ExeName
)
+
'kgOrdersServer.ini'
);
try
try
Logger
.
Log
(
1
,
'iniFile: '
+
ExtractFilePath
(
Application
.
ExeName
)
+
'kgOrdersServer.ini'
);
Logger
.
Log
(
1
,
'iniFile: '
+
ExtractFilePath
(
Application
.
ExeName
)
+
'kgOrdersServer.ini'
);
debugMode
:=
iniFile
.
ReadBool
(
'Settings'
,
'DebugMode'
,
True
);
devMode
:=
iniFile
.
ReadBool
(
'Settings'
,
'devMode'
,
True
);
Logger
.
Log
(
1
,
'debugMode: '
+
BoolToStr
(
debugMode
,
True
)
);
Logger
.
Log
(
1
,
'devMode: '
+
BoolToStr
(
devMode
,
True
)
);
Logger
.
Log
(
1
,
'LogLevels are displayed here. They were set in kgOrdersServer.dpr, it executes first'
);
Logger
.
Log
(
1
,
'--- Settings ---'
);
iniStr
:=
iniFile
.
ReadString
(
'Settings'
,
'MemoLogLevel'
,
''
);
if
iniStr
.
IsEmpty
then
Logger
.
Log
(
1
,
'--Settings->MemoLogLevel: Entry not found - default: 3'
)
else
Logger
.
Log
(
1
,
'--Settings->MemoLogLevel: '
+
iniStr
);
iniStr
:=
iniFile
.
ReadString
(
'Settings'
,
'FileLogLevel'
,
''
);
if
iniStr
.
IsEmpty
then
Logger
.
Log
(
1
,
'--Settings->FileLogLevel: Entry not found - default: 4'
)
else
Logger
.
Log
(
1
,
'--Settings->FileLogLevel: '
+
iniStr
);
Logger
.
Log
(
1
,
''
);
iniStr
:=
iniFile
.
ReadString
(
'Settings'
,
'LogFileNum'
,
''
);
if
iniStr
.
IsEmpty
then
Logger
.
Log
(
1
,
'--Settings->LogFileNum: Entry not found'
)
else
Logger
.
Log
(
1
,
'--Settings->LogFileNum: '
+
IntToStr
(
StrToInt
(
iniStr
)
-
1
)
);
iniStr
:=
iniFile
.
ReadString
(
'Settings'
,
'webClientVersion'
,
''
);
iniStr
:=
iniFile
.
ReadString
(
'Settings'
,
'webClientVersion'
,
''
);
if
iniStr
.
IsEmpty
then
if
iniStr
.
IsEmpty
then
...
@@ -172,25 +142,25 @@ begin
...
@@ -172,25 +142,25 @@ begin
bContinue
:=
False
;
bContinue
:=
False
;
end
end
else
else
Logger
.
Log
(
1
,
'----Database->Server: '
+
iniStr
);
Logger
.
Log
(
1
,
'----Database->Server:
ini entry:
'
+
iniStr
);
iniStr
:=
iniFile
.
ReadString
(
'Database'
,
'Database'
,
''
);
iniStr
:=
iniFile
.
ReadString
(
'Database'
,
'Database'
,
''
);
if
iniStr
.
IsEmpty
then
if
iniStr
.
IsEmpty
then
Logger
.
Log
(
1
,
'----Database->Database: ini entry not found - default:
kg_order_entry'
)
Logger
.
Log
(
1
,
'----Database->Database: ini entry not found - default:
'
+
iniEntries
.
dbDatabase
)
else
else
Logger
.
Log
(
1
,
'----Database->Database: ini entry: '
+
iniStr
);
Logger
.
Log
(
1
,
'----Database->Database: ini entry: '
+
iniStr
);
iniStr
:=
iniFile
.
ReadString
(
'Database'
,
'Username'
,
''
);
iniStr
:=
iniFile
.
ReadString
(
'Database'
,
'Username'
,
''
);
if
iniStr
.
IsEmpty
then
if
iniStr
.
IsEmpty
then
Logger
.
Log
(
1
,
'----Database->Username: Entry not found - default:
root'
)
Logger
.
Log
(
1
,
'----Database->Username: Entry not found - default:
'
+
iniEntries
.
dbUsername
)
else
else
Logger
.
Log
(
1
,
'----Database->Username: '
+
iniStr
);
Logger
.
Log
(
1
,
'----Database->Username:
ini entry:
'
+
iniStr
);
iniStr
:=
iniFile
.
ReadString
(
'Database'
,
'Password'
,
''
);
iniStr
:=
iniFile
.
ReadString
(
'Database'
,
'Password'
,
''
);
if
iniStr
.
IsEmpty
then
if
iniStr
.
IsEmpty
then
Logger
.
Log
(
1
,
'----Database->Password: Entry not found - default: xxxxxx'
)
Logger
.
Log
(
1
,
'----Database->Password: Entry not found - default: xxxxxx
xx
'
)
else
else
Logger
.
Log
(
1
,
'----Database->Password: xxxxxxxx'
);
Logger
.
Log
(
1
,
'----Database->Password:
ini entry:
xxxxxxxx'
);
Logger
.
Log
(
1
,
'---Quickbooks---'
);
Logger
.
Log
(
1
,
'---Quickbooks---'
);
...
@@ -198,7 +168,7 @@ begin
...
@@ -198,7 +168,7 @@ begin
if
iniStr
.
IsEmpty
then
if
iniStr
.
IsEmpty
then
Logger
.
Log
(
1
,
'--Quickbooks->CompanyID: Entry not found'
)
Logger
.
Log
(
1
,
'--Quickbooks->CompanyID: Entry not found'
)
else
else
Logger
.
Log
(
1
,
'--Quickbooks->CompanyID:
Entry
found'
);
Logger
.
Log
(
1
,
'--Quickbooks->CompanyID:
ini Entry:
found'
);
iniStr
:=
IniFile
.
ReadString
(
'Quickbooks'
,
'ClientID'
,
''
);
iniStr
:=
IniFile
.
ReadString
(
'Quickbooks'
,
'ClientID'
,
''
);
if
iniStr
.
IsEmpty
then
if
iniStr
.
IsEmpty
then
...
@@ -251,9 +221,10 @@ begin
...
@@ -251,9 +221,10 @@ begin
else
else
begin
begin
Logger
.
Log
(
1
,
'ini configuration error: Existing program!'
);
Logger
.
Log
(
1
,
'ini configuration error: Existing program!'
);
if
debugMode
then
if
devMode
then
MessageDlg
(
'ini configuration error: Existing program!'
,
mtConfirmation
,
[
mbOk
],
0
);
MessageDlg
(
'ini configuration error!'
,
mtConfirmation
,
[
mbOk
],
0
)
Close
();
else
Close
();
end
;
end
;
end
;
end
;
...
...
kgOrdersServer/Source/rOrderCorrugated.pas
View file @
5aaae14f
...
@@ -138,7 +138,7 @@ uses
...
@@ -138,7 +138,7 @@ uses
procedure
TrptOrderCorrugated
.
DataModuleCreate
(
Sender
:
TObject
);
procedure
TrptOrderCorrugated
.
DataModuleCreate
(
Sender
:
TObject
);
begin
begin
Logger
.
Log
(
5
,
'TrptOrderCorrugated.DataModuleCreate'
);
Logger
.
Log
(
5
,
'TrptOrderCorrugated.DataModuleCreate'
);
LoadDatabaseSettings
(
ucKG
,
'kgOrdersServer.ini'
);
LoadDatabaseSettings
(
ucKG
);
try
try
ucKG
.
Connect
;
ucKG
.
Connect
;
except
except
...
...
kgOrdersServer/Source/rOrderCutting.pas
View file @
5aaae14f
...
@@ -69,7 +69,7 @@ uses
...
@@ -69,7 +69,7 @@ uses
procedure
TrptOrderCutting
.
DataModuleCreate
(
Sender
:
TObject
);
procedure
TrptOrderCutting
.
DataModuleCreate
(
Sender
:
TObject
);
begin
begin
Logger
.
Log
(
5
,
'TrptOrderCutting.DataModuleCreate'
);
Logger
.
Log
(
5
,
'TrptOrderCutting.DataModuleCreate'
);
LoadDatabaseSettings
(
ucKG
,
'kgOrdersServer.ini'
);
LoadDatabaseSettings
(
ucKG
);
try
try
ucKG
.
Connect
;
ucKG
.
Connect
;
except
except
...
...
kgOrdersServer/Source/rOrderList.pas
View file @
5aaae14f
...
@@ -68,7 +68,7 @@ uses
...
@@ -68,7 +68,7 @@ uses
procedure
TrptOrderList
.
DataModuleCreate
(
Sender
:
TObject
);
procedure
TrptOrderList
.
DataModuleCreate
(
Sender
:
TObject
);
begin
begin
Logger
.
Log
(
5
,
'TrptOrderList.DataModuleCreate'
);
Logger
.
Log
(
5
,
'TrptOrderList.DataModuleCreate'
);
LoadDatabaseSettings
(
ucKG
,
'kgOrdersServer.ini'
);
LoadDatabaseSettings
(
ucKG
);
try
try
ucKG
.
Connect
;
ucKG
.
Connect
;
except
except
...
...
kgOrdersServer/Source/rOrderWeb.dfm
View file @
5aaae14f
...
@@ -7,7 +7,6 @@ object rptOrderWeb: TrptOrderWeb
...
@@ -7,7 +7,6 @@ object rptOrderWeb: TrptOrderWeb
Database = 'kg_order_entry'
Database = 'kg_order_entry'
Username = 'root'
Username = 'root'
Server = '192.168.159.10'
Server = '192.168.159.10'
Connected = True
LoginPrompt = False
LoginPrompt = False
Left = 289
Left = 289
Top = 119
Top = 119
...
...
kgOrdersServer/Source/rOrderWeb.pas
View file @
5aaae14f
...
@@ -137,7 +137,7 @@ uses
...
@@ -137,7 +137,7 @@ uses
procedure
TrptOrderWeb
.
DataModuleCreate
(
Sender
:
TObject
);
procedure
TrptOrderWeb
.
DataModuleCreate
(
Sender
:
TObject
);
begin
begin
Logger
.
Log
(
5
,
'TrptOrderWeb.DataModuleCreate'
);
Logger
.
Log
(
5
,
'TrptOrderWeb.DataModuleCreate'
);
LoadDatabaseSettings
(
ucKG
,
'kgOrdersServer.ini'
);
LoadDatabaseSettings
(
ucKG
);
try
try
ucKG
.
Connect
;
ucKG
.
Connect
;
except
except
...
...
kgOrdersServer/Source/uLibrary.pas
View file @
5aaae14f
...
@@ -3,32 +3,25 @@ unit uLibrary;
...
@@ -3,32 +3,25 @@ unit uLibrary;
interface
interface
uses
uses
System
.
Classes
,
Uni
;
Common
.
Ini
,
System
.
Classes
,
Uni
;
procedure
LoadDatabaseSettings
(
uc
:
TUniConnection
;
iniFilename
:
string
);
procedure
LoadDatabaseSettings
(
uc
:
TUniConnection
);
procedure
DoQuery
(
uq
:
TUniQuery
;
sql
:
string
);
procedure
DoQuery
(
uq
:
TUniQuery
;
sql
:
string
);
implementation
implementation
uses
uses
System
.
SysUtils
,
System
.
SysUtils
,
System
.
IniFiles
,
Vcl
.
Forms
,
Data
.
DB
;
Data
.
DB
;
procedure
LoadDatabaseSettings
(
uc
:
TUniConnection
;
iniFilename
:
string
);
procedure
LoadDatabaseSettings
(
uc
:
TUniConnection
);
var
iniFile
:
TIniFile
;
begin
begin
iniFile
:=
TIniFile
.
Create
(
ExtractFilePath
(
Application
.
ExeName
)
+
iniFilename
);
uc
.
Server
:=
iniEntries
.
dbServer
;
try
uc
.
Database
:=
iniEntries
.
dbDatabase
;
uc
.
Server
:=
iniFile
.
ReadString
(
'Database'
,
'Server'
,
''
);
uc
.
Username
:=
iniEntries
.
dbUsername
;
uc
.
Database
:=
iniFile
.
ReadString
(
'Database'
,
'Database'
,
'kg_order_entry'
);
uc
.
Password
:=
iniEntries
.
dbPassword
;
uc
.
Username
:=
iniFile
.
ReadString
(
'Database'
,
'Username'
,
'root'
);
uc
.
Password
:=
iniFile
.
ReadString
(
'Database'
,
'Password'
,
'emsys01'
);
finally
iniFile
.
Free
;
end
;
end
;
end
;
procedure
DoQuery
(
uq
:
TUniQuery
;
sql
:
string
);
procedure
DoQuery
(
uq
:
TUniQuery
;
sql
:
string
);
...
...
kgOrdersServer/kgOrdersServer.dpr
View file @
5aaae14f
...
@@ -26,10 +26,11 @@ uses
...
@@ -26,10 +26,11 @@ uses
rOrderCorrugated in 'Source\rOrderCorrugated.pas' {rptOrderCorrugated: TDataModule},
rOrderCorrugated in 'Source\rOrderCorrugated.pas' {rptOrderCorrugated: TDataModule},
rOrderWeb in 'Source\rOrderWeb.pas' {rptOrderWeb: TDataModule},
rOrderWeb in 'Source\rOrderWeb.pas' {rptOrderWeb: TDataModule},
rOrderCutting in 'Source\rOrderCutting.pas' {rptOrderCutting: TDataModule},
rOrderCutting in 'Source\rOrderCutting.pas' {rptOrderCutting: TDataModule},
qbAPI in 'Source\qbAPI.pas' {fQB};
qbAPI in 'Source\qbAPI.pas' {fQB},
Common.Ini in 'Source\Common.Ini.pas';
type
type
TMemoLogAppender = class(
TInterfacedObject, ILogAppender
)
TMemoLogAppender = class(
TInterfacedObject, ILogAppender
)
private
private
FLogLevel: Integer;
FLogLevel: Integer;
FLogMemo: TMemo;
FLogMemo: TMemo;
...
@@ -40,18 +41,19 @@ type
...
@@ -40,18 +41,19 @@ type
procedure Send(logLevel: Integer; Log: ILog);
procedure Send(logLevel: Integer; Log: ILog);
end;
end;
TFileLogAppender = class(
TInterfacedObject, ILogAppender
)
TFileLogAppender = class(
TInterfacedObject, ILogAppender
)
private
private
FLogLevel: Integer;
FLogLevel: Integer;
FLogFile: string;
FLogFile: string;
FCriticalSection: TCriticalSection;
FCriticalSection: TCriticalSection;
public
public
constructor Create(ALogLevel: Integer; AFilename: string);
constructor Create(ALogLevel: Integer; AFilename: string
; AFileNum: Integer
);
destructor Destroy; override;
destructor Destroy; override;
procedure Send(logLevel: Integer; Log: ILog);
procedure Send(logLevel: Integer; Log: ILog);
end;
end;
{ TMemoLogAppender }
{ TMemoLogAppender }
constructor TMemoLogAppender.Create(ALogLevel: Integer; ALogMemo: TMemo);
constructor TMemoLogAppender.Create(ALogLevel: Integer; ALogMemo: TMemo);
begin
begin
FLogLevel := ALogLevel;
FLogLevel := ALogLevel;
...
@@ -67,34 +69,33 @@ end;
...
@@ -67,34 +69,33 @@ end;
procedure TMemoLogAppender.Send(logLevel: Integer; Log: ILog);
procedure TMemoLogAppender.Send(logLevel: Integer; Log: ILog);
var
var
FormattedMessage: string;
logMsg: string;
LogTime: TDateTime;
logTime: TDateTime;
LogMsg: string;
formattedMessage: string;
begin
begin
FCriticalSection.Acquire;
FCriticalSection.Acquire;
try
try
L
ogTime := Now;
l
ogTime := Now;
FormattedMessage := FormatDateTime('[yyyy-mm-dd HH:nn:ss.zzz]', L
ogTime);
formattedMessage := FormatDateTime('[yyyy-mm-dd HH:nn:ss.zzz]', l
ogTime);
L
ogMsg := Log.GetMessage;
l
ogMsg := Log.GetMessage;
if
L
ogMsg.IsEmpty then
if
l
ogMsg.IsEmpty then
F
ormattedMessage := ''
f
ormattedMessage := ''
else
else
FormattedMessage := FormattedMessage + '[' + IntToStr(logLevel) +'] ' + L
ogMsg;
formattedMessage := formattedMessage + '[' + IntToStr(logLevel) + '] ' + l
ogMsg;
if logLevel <= FLogLevel then
if logLevel <= FLogLevel then
FLogMemo.Lines.Add(
FormattedMessage
);
FLogMemo.Lines.Add(
formattedMessage
);
finally
finally
FCriticalSection.Release;
FCriticalSection.Release;
end;
end;
end;
end;
{ TFileLogAppender }
{ TFileLogAppender }
constructor TFileLogAppender.Create(ALogLevel: integer; AFilename: string);
constructor TFileLogAppender.Create(ALogLevel: integer; AFilename: string; AFileNum: integer);
var
var
iniFile: TIniFile;
iniFile: TIniFile;
fileNum: integer;
logsDir: string;
logsDir: string;
begin
begin
FLogLevel := ALogLevel;
FLogLevel := ALogLevel;
...
@@ -103,14 +104,7 @@ begin
...
@@ -103,14 +104,7 @@ begin
if not DirectoryExists(logsDir) then
if not DirectoryExists(logsDir) then
CreateDir(logsDir);
CreateDir(logsDir);
iniFile := TIniFile.Create( ExtractFilePath(Application.ExeName) + 'kgOrdersServer.ini' );
FLogFile := logsDir + AFilename + Format( '%.4d', [AFileNum] ) + '.log';
try
fileNum := iniFile.ReadInteger( 'Settings', 'LogFileNum', 0 );
FLogFile := logsDir + AFilename + Format( '%.4d', [fileNum] ) + '.log';
iniFile.WriteInteger( 'Settings', 'LogFileNum', fileNum + 1 );
finally
iniFile.Free;
end;
end;
end;
destructor TFileLogAppender.Destroy;
destructor TFileLogAppender.Destroy;
...
@@ -119,14 +113,16 @@ begin
...
@@ -119,14 +113,16 @@ begin
inherited;
inherited;
end;
end;
procedure TFileLogAppender.Send(logLevel:
i
nteger; Log: ILog);
procedure TFileLogAppender.Send(logLevel:
I
nteger; Log: ILog);
var
var
formattedMessage: string;
logFile: TextFile;
logTime: TDateTime;
logMsg: string;
logMsg: string;
txtFile: TextFil
e;
logTime: TDateTim
e;
formattedMessage: string;
begin
begin
if logLevel > FLogLevel then
Exit;
FCriticalSection.Acquire;
FCriticalSection.Acquire;
try
try
logTime := Now;
logTime := Now;
...
@@ -136,18 +132,18 @@ begin
...
@@ -136,18 +132,18 @@ begin
if logMsg.IsEmpty then
if logMsg.IsEmpty then
formattedMessage := ''
formattedMessage := ''
else
else
formattedMessage := formattedMessage + '[' + IntToStr(logLevel) +'] ' + logMsg;
formattedMessage := formattedMessage + '[' + IntToStr(logLevel) + '] ' + logMsg;
AssignFile( logFile, FLogFile );
if FileExists(FLogFile) then
Append(logFile)
else
Rewrite(logFile);
try
try
AssignFile( txtFile, FLogFile );
Writeln(logFile, formattedMessage);
if FileExists(FLogFile) then
Append( txtFile )
else
ReWrite( txtFile );
if logLevel <= FLogLevel then
WriteLn( txtFile, formattedMessage );
finally
finally
CloseFile(
txt
File);
CloseFile(
log
File);
end;
end;
finally
finally
FCriticalSection.Release;
FCriticalSection.Release;
...
@@ -157,23 +153,55 @@ end;
...
@@ -157,23 +153,55 @@ end;
{$R *.res}
{$R *.res}
var
var
iniFilename: string;
iniFile: TIniFile;
iniFile: TIniFile;
MemoLogLevel: Integer;
iniStr: string;
FileLogLevel: Integer;
begin
begin
ReportMemoryLeaksOnShutdown := True;
ReportMemoryLeaksOnShutdown := True;
Application.Initialize;
Application.Initialize;
Application.MainFormOnTaskbar := True;
Application.MainFormOnTaskbar := True;
Application.CreateForm(TFMain, FMain);
Application.CreateForm(TFMain, FMain);
iniFile := TIniFile.Create( ExtractFilePath(Application.ExeName) + 'kgOrdersServer.ini' );
iniFilename := ChangeFileExt( Application.ExeName, '.ini' );
iniFile := TIniFile.Create( iniFilename );
try
try
MemoLogLevel := iniFile.ReadInteger( 'Settings', 'MemoLogLevel', 3 );
Logger.AddAppender( TMemoLogAppender.Create(iniEntries.memoLogLevel, FMain.memoinfo) );
FileLogLevel := iniFile.ReadInteger( 'Settings', 'FileLogLevel', 4 );
Logger.AddAppender( TFileLogAppender.Create(iniEntries.fileLogLevel, 'emT3XDataServer', iniEntries.logFileNum) );
Logger.Log( 1, '*******************************************************' );
Logger.Log( 1, '* kgOrdersServer *' );
Logger.Log( 1, Format(' Version: %s ', [FMain.ExeInfo1.FileVersion]));
Logger.Log( 1, '* Developed by EM Systems, Inc. *' );
Logger.Log( 1, '*******************************************************' );
Logger.Log( 1, '' );
//iniEntries is automatically instantiated when the file Common.Ini is used
//we added LoadIniEntries call to put an entry in the Log file
LoadIniEntries;
Logger.Log( 1, 'iniFile: ' + iniFilename );
iniStr := iniFile.ReadString( 'Settings', 'MemoLogLevel', '' );
if iniStr.IsEmpty then
Logger.Log( 1, '--Settings->MemoLogLevel: ini entry not found - default: ' + IntToStr(iniEntries.memoLogLevel) )
else
Logger.Log( 1, '--Settings->MemoLogLevel: ini entry: ' + iniStr );
iniStr := iniFile.ReadString( 'Settings', 'FileLogLevel', '' );
if iniStr.IsEmpty then
Logger.Log( 1, '--Settings->FileLogLevel: ini entry not found - default: ' + IntToStr(iniEntries.fileLogLevel) )
else
Logger.Log( 1, '--Settings->FileLogLevel: ini entry: ' + iniStr );
Logger.Log( 1, '' );
iniStr := iniFile.ReadString( 'Settings', 'LogFileNum', '' );
if iniStr = '1' then
Logger.Log( 1, '--Settings->LogFileNum: ini entry not found - LogFileNum 1 added to iniFile' )
else
Logger.Log( 1, '--Settings->LogFileNum: ini entry: ' + iniStr );
finally
finally
iniFile.Free;
iniFile.Free;
end;
end;
Logger.AddAppender(TMemoLogAppender.Create( MemoLogLevel, FMain.memoinfo ));
Logger.AddAppender(TFileLogAppender.Create( FileLogLevel, 'kgOrdersServer' ));
Application.Run;
Application.Run;
end.
end.
kgOrdersServer/kgOrdersServer.dproj
View file @
5aaae14f
...
@@ -209,6 +209,7 @@
...
@@ -209,6 +209,7 @@
<Form>fQB</Form>
<Form>fQB</Form>
<FormType>dfm</FormType>
<FormType>dfm</FormType>
</DCCReference>
</DCCReference>
<DCCReference Include="Source\Common.Ini.pas"/>
<BuildConfiguration Include="Base">
<BuildConfiguration Include="Base">
<Key>Base</Key>
<Key>Base</Key>
</BuildConfiguration>
</BuildConfiguration>
...
...
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