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