Commit baa3b955 by Elias Sarraf

Merge remote-tracking branch 'origin/cam'

parents 245de583 bb45ab03
...@@ -109,6 +109,7 @@ procedure TAuthService.Login(AUser, APassword: string; ASuccess: TOnLoginSuccess ...@@ -109,6 +109,7 @@ procedure TAuthService.Login(AUser, APassword: string; ASuccess: TOnLoginSuccess
end; end;
begin begin
console.log('login');
if (AUser = '') or (APassword = '') then if (AUser = '') or (APassword = '') then
begin begin
AError('Please enter a username and a password'); AError('Please enter a username and a password');
......
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.Connection, XData.Web.Client;
type type
TDMConnection = class(TWebDataModule) TDMConnection = class(TWebDataModule)
...@@ -19,7 +19,7 @@ type ...@@ -19,7 +19,7 @@ type
FUnauthorizedAccessProc: TUnauthorizedAccessProc; FUnauthorizedAccessProc: TUnauthorizedAccessProc;
public public
const clientVersion = '0.9.15.1'; const clientVersion = '0.9.15.5';
procedure InitApp(SuccessProc: TSuccessProc; procedure InitApp(SuccessProc: TSuccessProc;
UnauthorizedAccessProc: TUnauthorizedAccessProc); UnauthorizedAccessProc: TUnauthorizedAccessProc);
procedure SetClientConfig(Callback: TVersionCheckCallback); procedure SetClientConfig(Callback: TVersionCheckCallback);
...@@ -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;
...@@ -87,13 +107,12 @@ begin ...@@ -87,13 +107,12 @@ begin
LoadConfig(@ConfigLoaded); LoadConfig(@ConfigLoaded);
end; end;
procedure TDMConnection.SetClientConfig(Callback: TVersionCheckCallback); procedure TDMConnection.SetClientConfig(Callback: TVersionCheckCallback);
begin begin
XDataWebClient1.Connection := AuthConnection; XDataWebClient1.Connection := AuthConnection;
console.log('ClientConfig');
XDataWebClient1.RawInvoke('IAuthService.VerifyVersion', [clientVersion], XDataWebClient1.RawInvoke('IAuthService.VerifyVersion', [clientVersion],
procedure(Response: TXDataClientResponse) procedure(Response: TXDataClientResponse) //this is the success callback
var var
jsonResult: TJSObject; jsonResult: TJSObject;
error: string; error: string;
...@@ -101,14 +120,17 @@ begin ...@@ -101,14 +120,17 @@ begin
jsonResult := TJSObject(Response.Result); jsonResult := TJSObject(Response.Result);
if jsonResult.HasOwnProperty('error') then if jsonResult.HasOwnProperty('error') then
error := string(jsonResult['error']) begin
else error := string(jsonResult['error']);
error := ''; Callback(False, error);
end
if error <> '' then
Callback(False, error)
else else
Callback(True, ''); Callback(True, '');
end,
procedure(Error: TXDataClientError) //this is the error callback
begin
Callback(False, Error.ErrorMessage);
end); end);
end; end;
......
...@@ -92,6 +92,12 @@ end; ...@@ -92,6 +92,12 @@ end;
procedure ShowErrorModal(msg: string); procedure ShowErrorModal(msg: string);
begin begin
HideSpinner('spinner'); HideSpinner('spinner');
if msg = '' then
begin
msg := 'Error connecting to EM Sytems Server.' + slinebreak +
'Please contact EM Systems Support.'
end;
asm asm
var modal = document.getElementById('main_errormodal'); var modal = document.getElementById('main_errormodal');
var label = document.getElementById('main_lblmodal_body'); var label = document.getElementById('main_lblmodal_body');
......
...@@ -23,7 +23,7 @@ object FViewAddCustomer: TFViewAddCustomer ...@@ -23,7 +23,7 @@ object FViewAddCustomer: TFViewAddCustomer
WidthPercent = 100.000000000000000000 WidthPercent = 100.000000000000000000
OnChange = edtShortNameChange OnChange = edtShortNameChange
DataField = 'SHORT_NAME' DataField = 'SHORT_NAME'
DataSource = WebDataSource1 DataSource = wdsCustomer
end end
object edtName: TWebDBEdit object edtName: TWebDBEdit
Left = 19 Left = 19
...@@ -36,7 +36,7 @@ object FViewAddCustomer: TFViewAddCustomer ...@@ -36,7 +36,7 @@ object FViewAddCustomer: TFViewAddCustomer
HeightPercent = 100.000000000000000000 HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000 WidthPercent = 100.000000000000000000
DataField = 'NAME' DataField = 'NAME'
DataSource = WebDataSource1 DataSource = wdsCustomer
end end
object edtBillAddress: TWebDBEdit object edtBillAddress: TWebDBEdit
Left = 19 Left = 19
...@@ -49,7 +49,7 @@ object FViewAddCustomer: TFViewAddCustomer ...@@ -49,7 +49,7 @@ object FViewAddCustomer: TFViewAddCustomer
HeightPercent = 100.000000000000000000 HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000 WidthPercent = 100.000000000000000000
DataField = 'BILL_ADDRESS' DataField = 'BILL_ADDRESS'
DataSource = WebDataSource1 DataSource = wdsCustomer
end end
object edtBillCity: TWebDBEdit object edtBillCity: TWebDBEdit
Left = 19 Left = 19
...@@ -62,7 +62,7 @@ object FViewAddCustomer: TFViewAddCustomer ...@@ -62,7 +62,7 @@ object FViewAddCustomer: TFViewAddCustomer
HeightPercent = 100.000000000000000000 HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000 WidthPercent = 100.000000000000000000
DataField = 'BILL_CITY' DataField = 'BILL_CITY'
DataSource = WebDataSource1 DataSource = wdsCustomer
end end
object edtBillState: TWebDBEdit object edtBillState: TWebDBEdit
Left = 19 Left = 19
...@@ -75,7 +75,7 @@ object FViewAddCustomer: TFViewAddCustomer ...@@ -75,7 +75,7 @@ object FViewAddCustomer: TFViewAddCustomer
HeightPercent = 100.000000000000000000 HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000 WidthPercent = 100.000000000000000000
DataField = 'BILL_STATE' DataField = 'BILL_STATE'
DataSource = WebDataSource1 DataSource = wdsCustomer
end end
object edtBillZip: TWebDBEdit object edtBillZip: TWebDBEdit
Left = 19 Left = 19
...@@ -88,7 +88,7 @@ object FViewAddCustomer: TFViewAddCustomer ...@@ -88,7 +88,7 @@ object FViewAddCustomer: TFViewAddCustomer
HeightPercent = 100.000000000000000000 HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000 WidthPercent = 100.000000000000000000
DataField = 'BILL_ZIP' DataField = 'BILL_ZIP'
DataSource = WebDataSource1 DataSource = wdsCustomer
end end
object edtBillContact: TWebDBEdit object edtBillContact: TWebDBEdit
Left = 19 Left = 19
...@@ -101,7 +101,7 @@ object FViewAddCustomer: TFViewAddCustomer ...@@ -101,7 +101,7 @@ object FViewAddCustomer: TFViewAddCustomer
HeightPercent = 100.000000000000000000 HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000 WidthPercent = 100.000000000000000000
DataField = 'BILL_CONTACT' DataField = 'BILL_CONTACT'
DataSource = WebDataSource1 DataSource = wdsCustomer
end end
object btnSave: TWebButton object btnSave: TWebButton
Left = 19 Left = 19
...@@ -165,8 +165,9 @@ object FViewAddCustomer: TFViewAddCustomer ...@@ -165,8 +165,9 @@ object FViewAddCustomer: TFViewAddCustomer
Enabled = False Enabled = False
HeightPercent = 100.000000000000000000 HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000 WidthPercent = 100.000000000000000000
OnChange = edtCustomerIDChange
DataField = 'CUSTOMER_ID' DataField = 'CUSTOMER_ID'
DataSource = WebDataSource1 DataSource = wdsCustomer
end end
object edtQBID: TWebDBEdit object edtQBID: TWebDBEdit
Left = 151 Left = 151
...@@ -179,126 +180,7 @@ object FViewAddCustomer: TFViewAddCustomer ...@@ -179,126 +180,7 @@ object FViewAddCustomer: TFViewAddCustomer
HeightPercent = 100.000000000000000000 HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000 WidthPercent = 100.000000000000000000
DataField = 'QB_LIST_ID' DataField = 'QB_LIST_ID'
DataSource = WebDataSource1 DataSource = wdsCustomer
end
object wdbtcAddresses: TWebDBTableControl
Left = 190
Top = 196
Width = 631
Height = 200
ElementClassName = 'table'
ElementId = 'tblPhoneGrid'
BorderColor = clSilver
ChildOrder = 11
ElementFont = efCSS
ElementHeaderClassName = 'thead-light sticky-top bg-light border-light'
ElementPosition = epRelative
ElementTableClassName = 'table table-striped table-hover table-bordered text-sm'
Footer.ButtonActiveElementClassName = 'btn btn-primary'
Footer.ButtonElementClassName = 'btn btn-light'
Footer.DropDownElementClassName = 'form-control'
Footer.InputElementClassName = 'form-control'
Footer.LinkActiveElementClassName = 'link-primary'
Footer.LinkElementClassName = 'link-secondary'
Footer.ListElementClassName = 'pagination'
Footer.ListItemElementClassName = 'page-item'
Footer.ListLinkElementClassName = 'page-link'
Header.ButtonActiveElementClassName = 'btn btn-primary'
Header.ButtonElementClassName = 'btn btn-light'
Header.DropDownElementClassName = 'form-control'
Header.InputElementClassName = 'form-control'
Header.LinkActiveElementClassName = 'link-primary'
Header.LinkElementClassName = 'link-secondary'
Header.ListElementClassName = 'pagination'
Header.ListItemElementClassName = 'page-item'
Header.ListLinkElementClassName = 'page-link'
WordWrap = True
OnClickCell = wdbtcAddressesDblClickCell
OnDblClickCell = wdbtcAddressesDblClickCell
Columns = <
item
DataField = 'ship_id'
Title = 'ID'
end
item
DataField = 'ship_block'
Title = 'Address'
end>
DataSource = wdsShipTo
end
object edtShippingAddress: TWebEdit
Left = 190
Top = 460
Width = 121
Height = 22
ChildOrder = 22
ElementID = 'edtshippingaddress'
Enabled = False
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
OnChange = edtShippingAddressChange
end
object edtShippingState: TWebEdit
Left = 190
Top = 516
Width = 121
Height = 22
ChildOrder = 22
ElementID = 'edtshippingstate'
Enabled = False
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
OnChange = edtShippingAddressChange
end
object edtShippingContact: TWebEdit
Left = 190
Top = 578
Width = 121
Height = 22
ChildOrder = 22
ElementID = 'edtshippingcontact'
Enabled = False
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
OnChange = edtShippingAddressChange
end
object edtShippingZip: TWebEdit
Left = 190
Top = 550
Width = 121
Height = 22
ChildOrder = 22
EditType = weNumeric
ElementID = 'edtshippingzip'
Enabled = False
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
OnChange = edtShippingAddressChange
end
object edtShippingCity: TWebEdit
Left = 190
Top = 488
Width = 121
Height = 22
ChildOrder = 22
ElementID = 'edtshippingcity'
Enabled = False
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
OnChange = edtShippingAddressChange
end
object memoShipBlock: TWebMemo
Left = 508
Top = 460
Width = 185
Height = 89
ElementID = 'memoshipblock'
Enabled = False
HeightPercent = 100.000000000000000000
SelLength = 0
SelStart = 0
WidthPercent = 100.000000000000000000
OnChange = edtShippingAddressChange
end end
object memoAddressBlock: TWebMemo object memoAddressBlock: TWebMemo
Left = 162 Left = 162
...@@ -388,17 +270,6 @@ object FViewAddCustomer: TFViewAddCustomer ...@@ -388,17 +270,6 @@ object FViewAddCustomer: TFViewAddCustomer
WidthPercent = 100.000000000000000000 WidthPercent = 100.000000000000000000
OnClick = btnShipAddClick OnClick = btnShipAddClick
end end
object edtFirstLine: TWebEdit
Left = 190
Top = 430
Width = 121
Height = 22
ChildOrder = 35
ElementID = 'edtfirstline'
Enabled = False
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
end
object btnLink: TWebButton object btnLink: TWebButton
Left = 19 Left = 19
Top = 566 Top = 566
...@@ -439,63 +310,211 @@ object FViewAddCustomer: TFViewAddCustomer ...@@ -439,63 +310,211 @@ object FViewAddCustomer: TFViewAddCustomer
HeightPercent = 100.000000000000000000 HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000 WidthPercent = 100.000000000000000000
DataField = 'QB_TYPE' DataField = 'QB_TYPE'
DataSource = WebDataSource1 DataSource = wdsCustomer
end
object wdbtcAddresses: TWebDBTableControl
Left = 310
Top = 196
Width = 524
Height = 200
ElementId = 'tblShippingAddress'
BorderColor = clSilver
ChildOrder = 31
ElementFont = efCSS
ElementHeaderClassName = 'thead-light'
ElementTableClassName = 'table table-striped table-bordered table-hover'
Footer.ButtonActiveElementClassName = 'btn btn-primary'
Footer.ButtonElementClassName = 'btn btn-light'
Footer.DropDownElementClassName = 'form-control'
Footer.InputElementClassName = 'form-control'
Footer.LinkActiveElementClassName = 'link-primary'
Footer.LinkElementClassName = 'link-secondary'
Footer.ListElementClassName = 'pagination'
Footer.ListItemElementClassName = 'page-item'
Footer.ListLinkElementClassName = 'page-link'
Header.ButtonActiveElementClassName = 'btn btn-primary'
Header.ButtonElementClassName = 'btn btn-light'
Header.DropDownElementClassName = 'form-control'
Header.InputElementClassName = 'form-control'
Header.LinkActiveElementClassName = 'link-primary'
Header.LinkElementClassName = 'link-secondary'
Header.ListElementClassName = 'pagination'
Header.ListItemElementClassName = 'page-item'
Header.ListLinkElementClassName = 'page-link'
OnClickCell = wdbtcAddressesClickCell
Columns = <
item
DataField = 'ship_id'
Title = 'ID'
end
item
DataField = 'ship_block'
Title = 'Address'
end>
DataSource = wdsShipTo
end
object edtFirstLine: TWebDBEdit
Left = 190
Top = 432
Width = 121
Height = 22
ChildOrder = 34
ElementClassName = 'form-control'
ElementID = 'edtfirstline'
ElementFont = efCSS
HeightStyle = ssAuto
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
DataField = 'first_line'
DataSource = wdsShipTo
end
object edtShippingState: TWebDBEdit
Left = 190
Top = 516
Width = 121
Height = 22
ChildOrder = 34
ElementClassName = 'form-control'
ElementID = 'edtshippingstate'
ElementFont = efCSS
HeightStyle = ssAuto
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
DataField = 'state'
DataSource = wdsShipTo
end
object edtShippingAddress: TWebDBEdit
Left = 190
Top = 460
Width = 121
Height = 22
ChildOrder = 34
ElementClassName = 'form-control'
ElementID = 'edtshippingaddress'
ElementFont = efCSS
HeightStyle = ssAuto
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
DataField = 'shipping_address'
DataSource = wdsShipTo
end
object edtShippingCity: TWebDBEdit
Left = 190
Top = 488
Width = 121
Height = 22
ChildOrder = 34
ElementClassName = 'form-control'
ElementID = 'edtshippingcity'
ElementFont = efCSS
HeightStyle = ssAuto
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
DataField = 'city'
DataSource = wdsShipTo
end
object edtShippingZip: TWebDBEdit
Left = 188
Top = 544
Width = 121
Height = 22
ChildOrder = 34
ElementClassName = 'form-control'
ElementID = 'edtshippingzip'
ElementFont = efCSS
HeightStyle = ssAuto
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
DataField = 'zip'
DataSource = wdsShipTo
end
object edtShippingContact: TWebDBEdit
Left = 190
Top = 572
Width = 121
Height = 22
ChildOrder = 34
ElementClassName = 'form-control'
ElementID = 'edtshippingcontact'
ElementFont = efCSS
HeightStyle = ssAuto
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
DataField = 'contact'
DataSource = wdsShipTo
end
object memoShipBlock: TWebDBMemo
Left = 460
Top = 402
Width = 185
Height = 89
ElementClassName = 'form-control'
ElementID = 'memoshipblock'
ElementFont = efCSS
HeightPercent = 100.000000000000000000
Lines.Strings = (
'')
ReadOnly = True
SelLength = 0
SelStart = 2
WidthPercent = 100.000000000000000000
DataField = 'ship_block'
DataSource = wdsShipTo
end end
object XDataWebClient1: TXDataWebClient object XDataWebClient1: TXDataWebClient
Connection = DMConnection.ApiConnection Connection = DMConnection.ApiConnection
Left = 454 Left = 454
Top = 72 Top = 72
end end
object WebDataSource1: TWebDataSource object wdsCustomer: TWebDataSource
AutoEdit = False DataSet = xdwdsCustomer
DataSet = XDataWebDataSet1
Left = 532 Left = 532
Top = 126 Top = 126
end end
object XDataWebDataSet1: TXDataWebDataSet object xdwdsCustomer: TXDataWebDataSet
Connection = DMConnection.ApiConnection Connection = DMConnection.ApiConnection
Left = 426 Left = 426
Top = 132 Top = 132
object XDataWebDataSet1SHORT_NAME: TStringField object xdwdsCustomerSHORT_NAME: TStringField
FieldName = 'SHORT_NAME' FieldName = 'SHORT_NAME'
end end
object XDataWebDataSet1NAME: TStringField object xdwdsCustomerNAME: TStringField
FieldName = 'NAME' FieldName = 'NAME'
end end
object XDataWebDataSet1BILL_ADDRESS: TStringField object xdwdsCustomerBILL_ADDRESS: TStringField
FieldName = 'BILL_ADDRESS' FieldName = 'BILL_ADDRESS'
end end
object XDataWebDataSet1BILL_CITY: TStringField object xdwdsCustomerBILL_CITY: TStringField
FieldName = 'BILL_CITY' FieldName = 'BILL_CITY'
end end
object XDataWebDataSet1BILL_STATE: TStringField object xdwdsCustomerBILL_STATE: TStringField
FieldName = 'BILL_STATE' FieldName = 'BILL_STATE'
end end
object XDataWebDataSet1BILL_CONTACT: TStringField object xdwdsCustomerBILL_CONTACT: TStringField
FieldName = 'BILL_CONTACT' FieldName = 'BILL_CONTACT'
end end
object XDataWebDataSet1BILL_ZIP: TStringField object xdwdsCustomerBILL_ZIP: TStringField
FieldName = 'BILL_ZIP' FieldName = 'BILL_ZIP'
end end
object XDataWebDataSet1START_DATE: TStringField object xdwdsCustomerSTART_DATE: TStringField
FieldName = 'START_DATE' FieldName = 'START_DATE'
end end
object XDataWebDataSet1QB_LIST_ID: TStringField object xdwdsCustomerQB_LIST_ID: TStringField
FieldName = 'QB_LIST_ID' FieldName = 'QB_LIST_ID'
end end
object XDataWebDataSet1END_DATE: TStringField object xdwdsCustomerEND_DATE: TStringField
FieldName = 'END_DATE' FieldName = 'END_DATE'
end end
object XDataWebDataSet1FAX: TStringField object xdwdsCustomerFAX: TStringField
FieldName = 'FAX' FieldName = 'FAX'
end end
object XDataWebDataSet1PHONE: TStringField object xdwdsCustomerPHONE: TStringField
FieldName = 'PHONE' FieldName = 'PHONE'
end end
object XDataWebDataSet1CUSTOMER_ID: TIntegerField object xdwdsCustomerCUSTOMER_ID: TIntegerField
FieldName = 'CUSTOMER_ID' FieldName = 'CUSTOMER_ID'
end end
object XDataWebDataSet1QB_TYPE: TStringField object xdwdsCustomerQB_TYPE: TStringField
FieldName = 'QB_TYPE' FieldName = 'QB_TYPE'
end end
end end
...@@ -526,8 +545,13 @@ object FViewAddCustomer: TFViewAddCustomer ...@@ -526,8 +545,13 @@ object FViewAddCustomer: TFViewAddCustomer
object xdwdsShipTocontact: TStringField object xdwdsShipTocontact: TStringField
FieldName = 'contact' FieldName = 'contact'
end end
object xdwdsShipToship_block: TStringField object xdwdsShipTofirst_line: TStringField
FieldName = 'first_line'
Size = 200
end
object xdwdsShipToship_block: TMemoField
FieldName = 'ship_block' FieldName = 'ship_block'
BlobType = ftMemo
end end
end end
object tmrReturn: TWebTimer object tmrReturn: TWebTimer
......
...@@ -57,7 +57,7 @@ ...@@ -57,7 +57,7 @@
<label for="wdbe_first_name" style="font-weight: 700; font-size: 15px;" class="form-label mt-2">Customer ID:</label> <label for="wdbe_first_name" style="font-weight: 700; font-size: 15px;" class="form-label mt-2">Customer ID:</label>
<input id="edtcompanyaccountname"type="text" class="form-control" style="width: 150px" required/> <input id="edtcompanyaccountname"type="text" class="form-control" style="width: 150px" required/>
<div class="invalid-feedback" id="shortnamefeedback" style="font-size: 15px;"> <div class="invalid-feedback" id="shortnamefeedback" style="font-size: 15px;">
Please Provide a Company ID. Please Provide a Customer ID.
</div> </div>
</div> </div>
<div class="col-auto"> <div class="col-auto">
...@@ -121,7 +121,7 @@ ...@@ -121,7 +121,7 @@
<div class="row"> <div class="row">
<div class="overflow-auto mt-2" <div class="overflow-auto mt-2"
style="max-height: calc(100vh - 250px); padding-bottom: 0; width: 100%;"> style="max-height: calc(100vh - 250px); padding-bottom: 0; width: 100%;">
<table id="tblPhoneGrid" class="table table-striped table-bordered" style="width: 100%;"> <table id="tblShippingAddress" class="table table-striped table-bordered" style="width: 100%;">
<thead class="sticky-top thead-light"> <thead class="sticky-top thead-light">
<tr style="font-size: 0.875rem;"> <tr style="font-size: 0.875rem;">
<!-- headers --> <!-- headers -->
......
...@@ -25,38 +25,31 @@ type ...@@ -25,38 +25,31 @@ type
btnDelete: TWebButton; btnDelete: TWebButton;
btnClose: TWebButton; btnClose: TWebButton;
XDataWebClient1: TXDataWebClient; XDataWebClient1: TXDataWebClient;
WebDataSource1: TWebDataSource; wdsCustomer: TWebDataSource;
XDataWebDataSet1: TXDataWebDataSet; xdwdsCustomer: TXDataWebDataSet;
XDataWebDataSet1SHORT_NAME: TStringField; xdwdsCustomerSHORT_NAME: TStringField;
XDataWebDataSet1NAME: TStringField; xdwdsCustomerNAME: TStringField;
XDataWebDataSet1BILL_ADDRESS: TStringField; xdwdsCustomerBILL_ADDRESS: TStringField;
XDataWebDataSet1BILL_CITY: TStringField; xdwdsCustomerBILL_CITY: TStringField;
edtCustomerID: TWebDBEdit; edtCustomerID: TWebDBEdit;
edtQBID: TWebDBEdit; edtQBID: TWebDBEdit;
wdbtcAddresses: TWebDBTableControl;
wdsShipTo: TWebDataSource; wdsShipTo: TWebDataSource;
xdwdsShipTo: TXDataWebDataSet; xdwdsShipTo: TXDataWebDataSet;
XDataWebDataSet1BILL_STATE: TStringField; xdwdsCustomerBILL_STATE: TStringField;
XDataWebDataSet1BILL_CONTACT: TStringField; xdwdsCustomerBILL_CONTACT: TStringField;
XDataWebDataSet1BILL_ZIP: TStringField; xdwdsCustomerBILL_ZIP: TStringField;
XDataWebDataSet1START_DATE: TStringField; xdwdsCustomerSTART_DATE: TStringField;
XDataWebDataSet1END_DATE: TStringField; xdwdsCustomerEND_DATE: TStringField;
XDataWebDataSet1QB_LIST_ID: TStringField; xdwdsCustomerQB_LIST_ID: TStringField;
XDataWebDataSet1FAX: TStringField; xdwdsCustomerFAX: TStringField;
XDataWebDataSet1PHONE: TStringField; xdwdsCustomerPHONE: TStringField;
XDataWebDataSet1CUSTOMER_ID: TIntegerField; xdwdsCustomerCUSTOMER_ID: TIntegerField;
edtShippingAddress: TWebEdit;
edtShippingState: TWebEdit;
edtShippingContact: TWebEdit;
edtShippingZip: TWebEdit;
edtShippingCity: TWebEdit;
xdwdsShipToship_id: TStringField; xdwdsShipToship_id: TStringField;
xdwdsShipToshipping_address: TStringField; xdwdsShipToshipping_address: TStringField;
xdwdsShipTocity: TStringField; xdwdsShipTocity: TStringField;
xdwdsShipTostate: TStringField; xdwdsShipTostate: TStringField;
xdwdsShipTozip: TStringField; xdwdsShipTozip: TStringField;
xdwdsShipTocontact: TStringField; xdwdsShipTocontact: TStringField;
memoShipBlock: TWebMemo;
memoAddressBlock: TWebMemo; memoAddressBlock: TWebMemo;
btnAdd: TWebButton; btnAdd: TWebButton;
btnShipSave: TWebButton; btnShipSave: TWebButton;
...@@ -65,7 +58,6 @@ type ...@@ -65,7 +58,6 @@ type
btnShipEdit: TWebButton; btnShipEdit: TWebButton;
btnShipAdd: TWebButton; btnShipAdd: TWebButton;
tmrReturn: TWebTimer; tmrReturn: TWebTimer;
edtFirstLine: TWebEdit;
wdsUsers: TWebDataSource; wdsUsers: TWebDataSource;
xdwdsUsers: TXDataWebDataSet; xdwdsUsers: TXDataWebDataSet;
lblFormState: TWebLabel; lblFormState: TWebLabel;
...@@ -74,12 +66,20 @@ type ...@@ -74,12 +66,20 @@ type
btnUpdate: TWebButton; btnUpdate: TWebButton;
edtRepUser: TWebDBEdit; edtRepUser: TWebDBEdit;
xdwdsUsersQBID: TStringField; xdwdsUsersQBID: TStringField;
xdwdsShipToship_block: TStringField; xdwdsCustomerQB_TYPE: TStringField;
XDataWebDataSet1QB_TYPE: TStringField; procedure btnSaveClick(Sender: TObject); wdbtcAddresses: TWebDBTableControl;
edtFirstLine: TWebDBEdit;
xdwdsShipTofirst_line: TStringField;
edtShippingState: TWebDBEdit;
xdwdsShipToship_block: TMemoField;
edtShippingAddress: TWebDBEdit;
edtShippingCity: TWebDBEdit;
edtShippingZip: TWebDBEdit;
edtShippingContact: TWebDBEdit;
memoShipBlock: TWebDBMemo; procedure btnSaveClick(Sender: TObject);
procedure btnCancelClick(Sender: TObject); procedure btnCancelClick(Sender: TObject);
procedure btnCloseClick(Sender: TObject); procedure btnCloseClick(Sender: TObject);
procedure btnEditClick(Sender: TObject); procedure btnEditClick(Sender: TObject);
procedure wdbtcAddressesDblClickCell(Sender: TObject; ACol, ARow: Integer);
procedure btnClearClick(Sender: TObject); procedure btnClearClick(Sender: TObject);
procedure AddressEditMode(); procedure AddressEditMode();
procedure edtShippingAddressChange(Sender: TObject); procedure edtShippingAddressChange(Sender: TObject);
...@@ -95,6 +95,8 @@ type ...@@ -95,6 +95,8 @@ type
procedure btnUpdateClick(Sender: TObject); procedure btnUpdateClick(Sender: TObject);
procedure wdblcbRepChange(Sender: TObject); procedure wdblcbRepChange(Sender: TObject);
procedure edtShortNameChange(Sender: TObject); procedure edtShortNameChange(Sender: TObject);
procedure wdbtcAddressesClickCell(Sender: TObject; ACol, ARow: Integer);
procedure edtCustomerIDChange(Sender: TObject);
private private
{ Private declarations } { Private declarations }
procedure ViewMode(); procedure ViewMode();
...@@ -163,24 +165,25 @@ begin ...@@ -163,24 +165,25 @@ begin
try try
xdcResponse := await(XDataWebClient1.RawInvokeAsync('ILookupService.GetQBCustomer', [QB_ID])); xdcResponse := await(XDataWebClient1.RawInvokeAsync('ILookupService.GetQBCustomer', [QB_ID]));
qbCustJSON := string(TJSJSON.stringify(xdcResponse.Result)); qbCustJSON := string(TJSJSON.stringify(xdcResponse.Result));
console.log(qbCustJSON);
JSONObj := TJSONObject.ParseJSONValue(qbCustJSON) as TJSONObject; JSONObj := TJSONObject.ParseJSONValue(qbCustJSON) as TJSONObject;
//JSONObj := TJSONObject.ParseJSONValue(qbCustJSON) as TJSONObject; //JSONObj := TJSONObject.ParseJSONValue(qbCustJSON) as TJSONObject;
XDataWebDataSet1.Open; xdwdsCustomer.Open;
XDataWebDataSet1.Append; xdwdsCustomer.Append;
xdwdsCustomer.FieldByName('NAME').AsString := JSONObj.GetValue('NAME').Value;
xdwdsCustomer.FieldByName('QB_LIST_ID').AsString := JSONObj.GetValue('QB_LIST_ID').Value;
xdwdsCustomer.FieldByName('BILL_ADDRESS').AsString := JSONObj.GetValue('BILL_ADDRESS').Value;
xdwdsCustomer.FieldByName('BILL_CITY').AsString := JSONObj.GetValue('BILL_CITY').Value;
xdwdsCustomer.FieldByName('BILL_STATE').AsString := JSONObj.GetValue('BILL_STATE').Value;
xdwdsCustomer.FieldByName('BILL_ZIP').AsString := JSONObj.GetValue('BILL_ZIP').Value;
xdwdsCustomer.FieldByName('BILL_CONTACT').AsString := JSONObj.GetValue('BILL_CONTACT').Value;
xdwdsCustomerQB_TYPE.AsString := JSONObj.GetValue('RepUser').Value;
memoAddressBlock.Text := JSONObj.GetValue('BILL_ADDRESS_BLOCK').Value;
XDataWebDataSet1.FieldByName('NAME').AsString := JSONObj.GetValue('NAME').Value;
XDataWebDataSet1.FieldByName('QB_LIST_ID').AsString := JSONObj.GetValue('QB_LIST_ID').Value;
XDataWebDataSet1.FieldByName('BILL_ADDRESS').AsString := JSONObj.GetValue('BILL_ADDRESS').Value;
XDataWebDataSet1.FieldByName('BILL_CITY').AsString := JSONObj.GetValue('BILL_CITY').Value;
XDataWebDataSet1.FieldByName('BILL_STATE').AsString := JSONObj.GetValue('BILL_STATE').Value;
XDataWebDataSet1.FieldByName('BILL_ZIP').AsString := JSONObj.GetValue('BILL_ZIP').Value;
XDataWebDataSet1.FieldByName('BILL_CONTACT').AsString := JSONObj.GetValue('BILL_CONTACT').Value;
XDataWebDataSet1QB_TYPE.AsString := JSONObj.GetValue('RepUser').Value;
//XDataWebDataSet1.FieldByName('BILL_ADDRESS_BLOCK').AsString := JSONObj.GetValue('BILL_ADDRESS_BLOCK').Value; //xdwdsCustomer.FieldByName('BILL_ADDRESS_BLOCK').AsString := JSONObj.GetValue('BILL_ADDRESS_BLOCK').Value;
XDataWebDataSet1.Post; xdwdsCustomer.Post;
xdwdsShipTo.Open; xdwdsShipTo.Open;
xdwdsShipTo.Append; xdwdsShipTo.Append;
...@@ -202,7 +205,7 @@ begin ...@@ -202,7 +205,7 @@ begin
CustomerID := ''; CustomerID := '';
input := TJSHTMLInputElement(document.getElementById('edtrepuser')); input := TJSHTMLInputElement(document.getElementById('edtrepuser'));
if not xdwdsUsers.Locate('QBID', XDataWebDataSet1QB_TYPE.AsString, []) then if not xdwdsUsers.Locate('QBID', xdwdsCustomerQB_TYPE.AsString, []) then
begin begin
input.classList.add('changed-field'); input.classList.add('changed-field');
input.classList.add('is-invalid'); input.classList.add('is-invalid');
...@@ -257,7 +260,8 @@ begin ...@@ -257,7 +260,8 @@ begin
newform.ShowModal( newform.ShowModal(
procedure(AValue: TModalResult) procedure(AValue: TModalResult)
begin begin
if newform.confirm then
FViewMain.ViewAddCustomer('', newform.QB_ID);
end end
); );
end; end;
...@@ -278,14 +282,17 @@ begin ...@@ -278,14 +282,17 @@ 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.
var var
AddressJSON: TJSONObject; AddressJSON, JSONObj, test: TJSONObject;
Response: TXDataClientResponse; Response: TXDataClientResponse;
notification: TJSObject; notification, RowData, customer: TJSObject;
address_list: TJSArray;
ship_block: string; ship_block: string;
i: integer;
begin begin
AddressJSON := TJSONObject.Create; AddressJSON := TJSONObject.Create;
...@@ -295,33 +302,76 @@ begin ...@@ -295,33 +302,76 @@ begin
AddressJSON.AddPair('zip', edtShippingzip.Text); AddressJSON.AddPair('zip', edtShippingzip.Text);
AddressJSON.AddPair('contact', edtShippingContact.Text); AddressJSON.AddPair('contact', edtShippingContact.Text);
AddressJSON.AddPair('customer_id', customerID); AddressJSON.AddPair('customer_id', customerID);
AddressJSON.AddPair('first_line', xdwdsShipTofirst_line.AsString);
ship_block := edtFirstLine.Text + slinebreak + ship_block := edtFirstLine.Text + slinebreak +
edtName.Text + slinebreak + edtName.Text + slinebreak +
edtShippingContact.Text + slinebreak + edtShippingContact.Text + slinebreak +
edtShippingAddress.Text + slinebreak + edtShippingAddress.Text + slinebreak +
edtShippingCity.Text + ', ' + edtShippingState.Text + ' ' + edtShippingZip.Text; edtShippingCity.Text + ', ' + edtShippingState.Text + ' ' + edtShippingZip.Text;
AddressJSON.AddPair('ship_block', ship_block); AddressJSON.AddPair('ship_block', ship_block);
if shipmode = 'EDIT' then if shipmode = 'EDIT' then
AddressJSON.AddPair('customer_ship_id', xdwdsShipTo.FieldByName('ship_id').AsString); AddressJSON.AddPair('customer_ship_id', xdwdsShipTo.FieldByName('ship_id').AsString);
AddressJSON.AddPair('mode', shipmode); AddressJSON.AddPair('mode', shipmode);
xdwdsCustomer.Close;
xdwdsShipTo.Close;
Response := await(XDataWebClient1.RawInvokeAsync('ILookupService.AddShippingAddress', Response := await(XDataWebClient1.RawInvokeAsync('ILookupService.AddShippingAddress',
[AddressJSON.ToString])); [AddressJSON.ToString]));
notification := TJSObject(Response.Result); notification := TJSObject(Response.Result);
ShowToast(string(notification['status'])); ShowToast(string(notification['status']));
customer := TJSObject(notification['customer']);
xdwdsCustomer.Close;
xdwdsCustomer.SetJsonData(customer);
xdwdsCustomer.Open;
edtCustomerID.Text := CustomerID;
address_list := TJSArray(customer['SHIPPING_ADDRESS_LIST']);
xdwdsShipTo.Close; xdwdsShipTo.Close;
xdwdsShipTo.SetJSONData(notification['ADDRESS']);
xdwdsShipTo.Open; xdwdsShipTo.Open;
xdwdsShipTo.First;
while not xdwdsShipTo.Eof do xdwdsShipTo.Delete;
for i := 0 to address_list.length - 1 do
begin
RowData := TJSObject(address_list[i]);
xdwdsShipTo.Append;
xdwdsShipTo.FieldByName('state').AsString := String(RowData['state']);
xdwdsShipTo.FieldByName('city').AsString := String(RowData['city']);
xdwdsShipTo.FieldByName('ship_id').AsString := String(RowData['ship_id']);
xdwdsShipTo.FieldByName('shipping_address').AsString := String(RowData['shipping_address']);
xdwdsShipTo.FieldByName('zip').AsString := String(RowData['zip']);
xdwdsShipTo.FieldByName('ship_block').AsString := String(RowData['ship_block']);
xdwdsShipTo.FieldByName('contact').AsString := String(RowData['contact']);
xdwdsShipTo.FieldByName('first_line').AsString := String(RowData['first_line']);
xdwdsShipTo.Post;
end;
xdwdsShipTo.First;
memoAddressBlock.Text := string(customer['staff_fields_invoice_to']);
end; end;
procedure TFViewAddCustomer.btnAddClick(Sender: TObject); procedure TFViewAddCustomer.btnAddClick(Sender: TObject);
// Takes the user to the Add Customer Page. // Takes the user to the Add Customer Page.
var
AccessType: String;
begin begin
ShowSelectCustomerForm(); AccessType := JS.toString(AuthService.TokenPayload.Properties['user_access_type']);
if( ( AccessType = 'ADMIN' ) or ( AccessType = 'QBUSR' ) ) then
ShowSelectCustomerForm()
else
ShowToast('Failure:User not authorized to add customer from QuickBooks', 'failure');
end; end;
...@@ -350,13 +400,13 @@ begin ...@@ -350,13 +400,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
...@@ -381,31 +431,46 @@ end; ...@@ -381,31 +431,46 @@ end;
procedure TFViewAddCustomer.btnLinkClic(Sender: TObject); procedure TFViewAddCustomer.btnLinkClic(Sender: TObject);
var var
newform: TFSelectCustomer; newform: TFSelectCustomer;
AccessType: string;
begin begin
newform := TFSelectCustomer.CreateNew; AccessType := JS.toString(AuthService.TokenPayload.Properties['user_access_type']);
if( ( AccessType = 'ADMIN' ) or ( AccessType = 'QBUSR' ) ) then
begin
newform := TFSelectCustomer.CreateNew;
newform.Caption := 'Select Customer to Link'; newform.Caption := 'Select Customer to Link';
newForm.Popup := True; newForm.Popup := True;
newForm.Border := fbDialog; newForm.Border := fbDialog;
newForm.Position := poScreenCenter; newForm.Position := poScreenCenter;
// 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
EditMode(); if newform.confirm then
XDataWebDataSet1.Edit; begin
XDataWebDataSet1QB_LIST_ID.AsString := newform.QB_ID; EditMode();
XDataWebDataSet1.Post; xdwdsCustomer.Edit;
UpdateCustomer(); xdwdsCustomerQB_LIST_ID.AsString := newform.QB_ID;
end; xdwdsCustomer.Post;
end UpdateCustomer();
); end;
end
);
end
else
ShowToast('Failure:User not authorized to link customer to QuickBooks', 'failure');
end; end;
procedure TFViewAddCustomer.edtCustomerIDChange(Sender: TObject);
begin
EditMode();
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
...@@ -419,24 +484,25 @@ begin ...@@ -419,24 +484,25 @@ 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.wdbtcAddressesDblClickCell(Sender: TObject; ACol,
procedure TFViewAddCustomer.wdbtcAddressesClickCell(Sender: TObject; ACol,
ARow: Integer); ARow: Integer);
// Retrieves the shipping address allowing it to be edited.
begin begin
xdwdsShipTo.Locate('ship_id', wdbtcAddresses.Cells[0, ARow], []); xdwdsShipTo.Locate('ship_id', wdbtcAddresses.Cells[0, ARow], []);
edtShippingAddress.Text := xdwdsShipTo.FieldByName('shipping_address').AsString; // edtShippingAddress.Text := xdwdsShipTo.FieldByName('shipping_address').AsString;
edtShippingCity.Text := xdwdsShipTo.FieldByName('city').AsString; // edtShippingCity.Text := xdwdsShipTo.FieldByName('city').AsString;
edtShippingState.Text := xdwdsShipTo.FieldByName('state').AsString; // edtShippingState.Text := xdwdsShipTo.FieldByName('state').AsString;
edtShippingZip.Text := xdwdsShipTo.FieldByName('zip').AsString; // edtShippingZip.Text := xdwdsShipTo.FieldByName('zip').AsString;
edtShippingContact.Text := xdwdsShipTo.FieldByName('contact').AsString; // edtShippingContact.Text := xdwdsShipTo.FieldByName('contact').AsString;
memoShipBlock.Text := xdwdsShipTo.FieldByName('ship_block').AsString; // //memoShipBlock.Text := xdwdsShipTo.FieldByName('ship_block').AsString;
if memoShipBlock.Lines.Count > 0 then if memoShipBlock.Lines.Count > 0 then
edtFirstLine.Text := memoShipBlock.Lines[0] edtFirstLine.Text := memoShipBlock.Lines[0]
...@@ -444,30 +510,43 @@ begin ...@@ -444,30 +510,43 @@ begin
edtFirstLine.Text := ''; edtFirstLine.Text := '';
end; end;
procedure TFViewAddCustomer.btnUpdateClick(Sender: TObject); procedure TFViewAddCustomer.btnUpdateClick(Sender: TObject);
var
AccessType: string;
begin begin
if XDataWebDataSet1QB_LIST_ID.AsString = '' then if xdwdsCustomerQB_LIST_ID.AsString = '' then
ShowToast('Failure:Company must be linked to quickbooks to update!') ShowToast('Failure:Company must be linked to quickbooks to update!')
else else
UpdateCustomer(); begin
AccessType := JS.toString(AuthService.TokenPayload.Properties['user_access_type']);
if( ( AccessType = 'ADMIN' ) or ( AccessType = 'QBUSR' ) ) then
begin
UpdateCustomer();
end
else
ShowToast('Failure:User not authorized to update customer from QuickBooks', 'failure');
end;
end; end;
procedure TFViewAddCustomer.UpdateCustomer; procedure TFViewAddCustomer.UpdateCustomer;
var var
customer: TJSObject; customer: TJSObject;
xdcResponse: TXDataClientResponse; xdcResponse: TXDataClientResponse;
msg, temp: string; msg, short_name: string;
change: boolean; change: boolean;
input: TJSHTMLInputElement; input: TJSHTMLInputElement;
begin begin
try try
Utils.ShowSpinner('spinner'); Utils.ShowSpinner('spinner');
xdcResponse := await(XDataWebClient1.RawInvokeAsync('ILookupService.UpdateCustomer', [XDataWebDataSet1QB_LIST_ID.AsString])); xdcResponse := await(XDataWebClient1.RawInvokeAsync('ILookupService.UpdateCustomer', [xdwdsCustomerQB_LIST_ID.AsString]));
customer := TJSObject(xdcResponse.Result); customer := TJSObject(xdcResponse.Result);
change := false; change := false;
short_name := edtShortName.Text;
input := TJSHTMLInputElement(document.getElementById('edtcompanyname')); input := TJSHTMLInputElement(document.getElementById('edtcompanyname'));
if string(customer['NAME']) <> XDataWebDataSet1NAME.AsString then if string(customer['NAME']) <> xdwdsCustomerNAME.AsString then
begin begin
input.classList.add('changed-field'); input.classList.add('changed-field');
change := true; change := true;
...@@ -476,7 +555,7 @@ begin ...@@ -476,7 +555,7 @@ begin
input.classList.remove('changed-field'); input.classList.remove('changed-field');
input := TJSHTMLInputElement(document.getElementById('edtbillingaddress')); input := TJSHTMLInputElement(document.getElementById('edtbillingaddress'));
if string(customer['BILL_ADDRESS']) <> XDataWebDataSet1BILL_ADDRESS.AsString then if string(customer['BILL_ADDRESS']) <> xdwdsCustomerBILL_ADDRESS.AsString then
begin begin
input.classList.add('changed-field'); input.classList.add('changed-field');
change := true; change := true;
...@@ -485,7 +564,7 @@ begin ...@@ -485,7 +564,7 @@ begin
input.classList.remove('changed-field'); input.classList.remove('changed-field');
input := TJSHTMLInputElement(document.getElementById('edtbillingcity')); input := TJSHTMLInputElement(document.getElementById('edtbillingcity'));
if string(customer['BILL_CITY']) <> XDataWebDataSet1BILL_CITY.AsString then if string(customer['BILL_CITY']) <> xdwdsCustomerBILL_CITY.AsString then
begin begin
input.classList.add('changed-field'); input.classList.add('changed-field');
change := true; change := true;
...@@ -494,7 +573,7 @@ begin ...@@ -494,7 +573,7 @@ begin
input.classList.remove('changed-field'); input.classList.remove('changed-field');
input := TJSHTMLInputElement(document.getElementById('edtbillingstate')); input := TJSHTMLInputElement(document.getElementById('edtbillingstate'));
if string(customer['BILL_STATE']) <> XDataWebDataSet1BILL_STATE.AsString then if string(customer['BILL_STATE']) <> xdwdsCustomerBILL_STATE.AsString then
begin begin
input.classList.add('changed-field'); input.classList.add('changed-field');
change := true; change := true;
...@@ -503,7 +582,7 @@ begin ...@@ -503,7 +582,7 @@ begin
input.classList.remove('changed-field'); input.classList.remove('changed-field');
input := TJSHTMLInputElement(document.getElementById('edtbillingzip')); input := TJSHTMLInputElement(document.getElementById('edtbillingzip'));
if string(customer['BILL_ZIP']) <> XDataWebDataSet1BILL_ZIP.AsString then if string(customer['BILL_ZIP']) <> xdwdsCustomerBILL_ZIP.AsString then
begin begin
input.classList.add('changed-field'); input.classList.add('changed-field');
change := true; change := true;
...@@ -511,19 +590,40 @@ begin ...@@ -511,19 +590,40 @@ begin
else else
input.classList.remove('changed-field'); input.classList.remove('changed-field');
XDataWebDataSet1.Close; input := TJSHTMLInputElement(document.getElementById('edtrepuser'));
XDataWebDataSet1.SetJsonData(customer); if string(customer['QB_TYPE']) <> xdwdsCustomerQB_TYPE.AsString then
XDataWebDataSet1.Open; begin
input.classList.add('changed-field');
change := true;
end
else
input.classList.remove('changed-field');
if not xdwdsUsers.Locate('QBID', string(customer['QB_TYPE']), []) then
begin
input.classList.add('is-invalid');
end
else
input.classList.remove('is-invalid');
xdwdsCustomer.Close;
xdwdsCustomer.SetJsonData(customer);
xdwdsCustomer.Open;
xdwdsCustomer.Edit;
xdwdsCustomerCUSTOMER_ID.AsString := CustomerID;
xdwdsCustomerSHORT_NAME.AsString := short_name;
;
memoAddressBlock.Text := string(customer['staff_fields_invoice_to']); memoAddressBlock.Text := string(customer['staff_fields_invoice_to']);
Utils.HideSpinner('spinner'); Utils.HideSpinner('spinner');
if change then if change then
begin begin
EditMode; EditMode;
ShowToast('Update successful. Changes have been highlighted'); ShowToast('Changes have been highlighted');
end end
else else
ShowToast('Update successful. No Changes needed'); ShowToast('No Changes needed');
except except
on E: EXDataClientRequestException do on E: EXDataClientRequestException do
begin begin
...@@ -533,6 +633,7 @@ begin ...@@ -533,6 +633,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
...@@ -545,81 +646,88 @@ var ...@@ -545,81 +646,88 @@ var
msg: string; msg: string;
BILL_ADDRESS_BLOCK: string; BILL_ADDRESS_BLOCK: string;
begin begin
if mode = 'EDIT' then try
begin if mode = 'EDIT' then
customerJSON := TJSONObject.Create;
XDataWebDataSet1.First;
while not XDataWebDataSet1.Eof do
begin begin
for Field in XDataWebDataSet1.Fields do customerJSON := TJSONObject.Create;
xdwdsCustomer.First;
while not xdwdsCustomer.Eof do
begin begin
if Field is TStringField then for Field in xdwdsCustomer.Fields do
begin
if Field.AsString = '' then
customerJSON.AddPair(Field.FieldName, '')
else
customerJSON.AddPair(Field.FieldName, Field.AsString); // Add all other fields
end
else if Field is TIntegerField then
begin begin
customerJSON.AddPair(Field.FieldName, Field.AsString); if Field is TStringField then
begin
if Field.AsString = '' then
customerJSON.AddPair(Field.FieldName, '')
else
customerJSON.AddPair(Field.FieldName, Field.AsString); // Add all other fields
end
else if Field is TIntegerField then
begin
customerJSON.AddPair(Field.FieldName, Field.AsString);
end;
end; end;
xdwdsCustomer.Next;
end; end;
XDataWebDataSet1.Next;
end;
BILL_ADDRESS_BLOCK := edtName.Text + slinebreak +
edtBillContact.Text + slinebreak +
edtBillAddress.Text + slinebreak +
edtBillCity.Text + ', ' + edtBillState.Text + ' ' + edtBillZip.Text;
CustomerJSON.AddPair('BILL_ADDRESS_BLOCK', BILL_ADDRESS_BLOCK); BILL_ADDRESS_BLOCK := memoAddressBlock.Text;
customerJSON.AddPair('mode', mode); CustomerJSON.AddPair('BILL_ADDRESS_BLOCK', BILL_ADDRESS_BLOCK);
if mode = 'EDIT' then
customerJSON.AddPair('CUSTOMER_ID', customerID);
Response := await(XDataWebClient1.RawInvokeAsync('ILookupService.AddCustomer', customerJSON.AddPair('mode', mode);
[customerJSON.ToJSON])); if mode = 'EDIT' then
notification := TJSObject(Response.Result); customerJSON.AddPair('CUSTOMER_ID', customerID);
end
else
begin
JSONObj := TJSONObject.ParseJSONValue(qbCustJSON) as TJSONObject;
JSONObj.AddPair('SHORT_NAME', XDataWebDataSet1SHORT_NAME.AsString);
Response := await(XDataWebClient1.RawInvokeAsync('ILookupService.ImportQBCustomer',
[JSONObj.ToString]));
XDataWebDataSet1.Edit;
notification := TJSObject(Response.Result);
XDataWebDataSet1Customer_ID.AsInteger := integer(notification['CustomerID']);
XDataWebDataSet1.Post;
end;
msg := string(notification['status']);
if CustomerID = '' then
CustomerID := string(notification['CustomerID']);
edtCustomerID.Text := CustomerID; Response := await(XDataWebClient1.RawInvokeAsync('ILookupService.AddCustomer',
[customerJSON.ToJSON]));
notification := TJSObject(Response.Result);
end
else
begin
JSONObj := TJSONObject.ParseJSONValue(qbCustJSON) as TJSONObject;
JSONObj.AddPair('SHORT_NAME', xdwdsCustomerSHORT_NAME.AsString);
Response := await(XDataWebClient1.RawInvokeAsync('ILookupService.ImportQBCustomer',
[JSONObj.ToString]));
notification := TJSObject(Response.Result);
end;
msg := string(notification['status']);
ShowToast(msg); ShowToast(msg);
if msg.Contains('Failure') then if msg.Contains('Failure') then
begin begin
input := TJSHTMLInputElement(document.getElementById('edtcompanyaccountname')); input := TJSHTMLInputElement(document.getElementById('edtcompanyaccountname'));
input.classList.add('is-invalid'); input.classList.add('is-invalid');
input := TJSHTMLInputElement(document.getElementById('shortnamefeedback')); input := TJSHTMLInputElement(document.getElementById('shortnamefeedback'));
input.innerHTML := 'Company Account Name must be Unique.' ; input.innerHTML := 'Customer ID must be unique.' ;
end end
else else
begin begin
TJSHTMLInputElement(document.getElementById('edtcompanyname')).classList.remove('changed-field'); if CustomerID = '' then
TJSHTMLInputElement(document.getElementById('edtbillingaddress')).classList.remove('changed-field'); CustomerID := string(notification['CustomerID']);
TJSHTMLInputElement(document.getElementById('edtbillingcity')).classList.remove('changed-field'); xdwdsCustomer.Edit;
TJSHTMLInputElement(document.getElementById('edtbillingstate')).classList.remove('changed-field'); edtCustomerID.Text := CustomerID;
TJSHTMLInputElement(document.getElementById('edtbillingzip')).classList.remove('changed-field'); xdwdsCustomerCustomer_ID.AsInteger := integer(notification['CustomerID']);
mode := 'EDIT'; xdwdsCustomer.Post;
end; TJSHTMLInputElement(document.getElementById('edtcompanyname')).classList.remove('changed-field');
TJSHTMLInputElement(document.getElementById('edtbillingaddress')).classList.remove('changed-field');
TJSHTMLInputElement(document.getElementById('edtbillingcity')).classList.remove('changed-field');
TJSHTMLInputElement(document.getElementById('edtbillingstate')).classList.remove('changed-field');
TJSHTMLInputElement(document.getElementById('edtbillingzip')).classList.remove('changed-field');
mode := 'EDIT';
await(GetCustomer());
input := TJSHTMLInputElement(document.getElementById('edtrepuser'));
input.classList.remove('changed-field');
input.classList.remove('is-invalid');
ViewMode();
end;
except
on E: EXDataClientRequestException do
Utils.ShowErrorModal(E.ErrorResult.ErrorMessage);
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
...@@ -629,18 +737,15 @@ begin ...@@ -629,18 +737,15 @@ begin
end; end;
end; end;
procedure TFViewAddCustomer.Save; procedure TFViewAddCustomer.Save;
var var
input: TJSHTMLInputElement; input: TJSHTMLInputElement;
begin begin
await(sendCustomerToServer()); await(sendCustomerToServer());
await(GetCustomer());
input := TJSHTMLInputElement(document.getElementById('edtrepuser'));
input.classList.remove('changed-field');
input.classList.remove('is-invalid');
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
...@@ -670,7 +775,7 @@ end; ...@@ -670,7 +775,7 @@ end;
procedure TFViewAddCustomer.btnShipDeleteClick(Sender: TObject); procedure TFViewAddCustomer.btnShipDeleteClick(Sender: TObject);
begin begin
ShowToast('Deleting Shipping Addresses is not yet implemented.', 'info'); ShowToast('Deleting shipping addresses is not yet implemented.', 'info');
{ShowConfirmationModal( {ShowConfirmationModal(
'Are you sure you want to delete this address?', 'Are you sure you want to delete this address?',
'Delete', 'Delete',
...@@ -706,8 +811,8 @@ begin ...@@ -706,8 +811,8 @@ begin
if VerifyAddress() then if VerifyAddress() then
begin begin
await(SendAddressToServer); await(SendAddressToServer);
Clear(); //Clear();
await(GetCustomer); // Ensures xdwdsShipTo is refreshed with server data //await(GetCustomer); // Ensures xdwdsShipTo is refreshed with server data
ViewMode(); ViewMode();
end; end;
end; end;
...@@ -722,9 +827,9 @@ begin ...@@ -722,9 +827,9 @@ begin
xdcResponse := await(XDataWebClient1.RawInvokeAsync('ILookupService.GetCustomer', [customerID])); xdcResponse := await(XDataWebClient1.RawInvokeAsync('ILookupService.GetCustomer', [customerID]));
customer := TJSObject(xdcResponse.Result); customer := TJSObject(xdcResponse.Result);
XDataWebDataSet1.Close; xdwdsCustomer.Close;
XDataWebDataSet1.SetJsonData(customer); xdwdsCustomer.SetJsonData(customer);
XDataWebDataSet1.Open; xdwdsCustomer.Open;
edtCustomerID.Text := CustomerID; edtCustomerID.Text := CustomerID;
...@@ -734,13 +839,13 @@ begin ...@@ -734,13 +839,13 @@ begin
xdwdsShipTo.Open; xdwdsShipTo.Open;
memoAddressBlock.Text := string(customer['staff_fields_invoice_to']); memoAddressBlock.Text := string(customer['staff_fields_invoice_to']);
console.log(customer['SHIPPING_ADDRESS_LIST']);
edtShippingAddress.Text := xdwdsShipTo.FieldByName('shipping_address').AsString; edtShippingAddress.Text := xdwdsShipTo.FieldByName('shipping_address').AsString;
edtShippingCity.Text := xdwdsShipTo.FieldByName('city').AsString; edtShippingCity.Text := xdwdsShipTo.FieldByName('city').AsString;
edtShippingState.Text := xdwdsShipTo.FieldByName('state').AsString; edtShippingState.Text := xdwdsShipTo.FieldByName('state').AsString;
edtShippingZip.Text := xdwdsShipTo.FieldByName('zip').AsString; edtShippingZip.Text := xdwdsShipTo.FieldByName('zip').AsString;
edtShippingContact.Text := xdwdsShipTo.FieldByName('contact').AsString; edtShippingContact.Text := xdwdsShipTo.FieldByName('contact').AsString;
memoShipBlock.Text := xdwdsShipTo.FieldByName('ship_block').AsString; memoShipBlock.Text := xdwdsShipTo.FieldByName('ship_block').AsString;
if memoShipBlock.Lines.Count > 0 then if memoShipBlock.Lines.Count > 0 then
edtFirstLine.Text := memoShipBlock.Lines[0] edtFirstLine.Text := memoShipBlock.Lines[0]
else else
...@@ -754,6 +859,7 @@ begin ...@@ -754,6 +859,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.
...@@ -779,17 +885,17 @@ begin ...@@ -779,17 +885,17 @@ 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
input.classList.add('is-invalid'); input.classList.add('is-invalid');
result := false; result := false;
input := TJSHTMLInputElement(document.getElementById('shortnamefeedback'));
input.innerHTML := 'Please Provide a Customer ID.' ;
end end
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
...@@ -827,16 +933,9 @@ begin ...@@ -827,16 +933,9 @@ begin
else else
input.classList.remove('is-invalid'); input.classList.remove('is-invalid');
// input := TJSHTMLInputElement(document.getElementById('edtbillingcontact'));
// if edtBillContact.Text = '' then
// begin
// input.classList.add('is-invalid');
// result := false;
// end
// else
// 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
...@@ -899,10 +998,11 @@ begin ...@@ -899,10 +998,11 @@ 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
XDataWebDataSet1.Edit; xdwdsCustomer.Edit;
FViewMain.change := true; FViewMain.change := true;
btnAdd.Enabled := false; btnAdd.Enabled := false;
btnDelete.Enabled := false; btnDelete.Enabled := false;
...@@ -931,6 +1031,7 @@ begin ...@@ -931,6 +1031,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
...@@ -996,4 +1097,5 @@ begin ...@@ -996,4 +1097,5 @@ begin
lblFormState.ElementHandle.classList.add('text-danger'); lblFormState.ElementHandle.classList.add('text-danger');
end; end;
end. end.
\ No newline at end of file
...@@ -206,7 +206,6 @@ object FSelectCustomer: TFSelectCustomer ...@@ -206,7 +206,6 @@ object FSelectCustomer: TFSelectCustomer
ScrollMode = scmItemScrolling ScrollMode = scmItemScrolling
DesignTimeSampleData = True DesignTimeSampleData = True
OnCellClick = TMSFNCGrid1CellClick OnCellClick = TMSFNCGrid1CellClick
ExplicitLeft = 4
end end
object btnCancel: TWebButton object btnCancel: TWebButton
Left = 556 Left = 556
......
...@@ -86,13 +86,12 @@ begin ...@@ -86,13 +86,12 @@ begin
ShowToast('Please Select a Customer', 'danger') ShowToast('Please Select a Customer', 'danger')
else else
begin begin
if ( string(self.Caption).ToLower.Contains('add') and xdwdsCustomers.FieldByName('InKGOrders').AsBoolean) then if ( xdwdsCustomers.FieldByName('InKGOrders').AsBoolean ) then
ShowToast('failure:Customer Already in Database') ShowToast('failure:Customer Already in Database')
else else
begin begin
confirm := true; confirm := true;
QB_ID := xdwdsCustomers.FieldByName('Id').AsString; QB_ID := xdwdsCustomers.FieldByName('Id').AsString;
FViewMain.ViewAddCustomer('', QB_ID);
Close(); Close();
end; end;
end; end;
......
...@@ -112,6 +112,7 @@ object FViewCustomers: TFViewCustomers ...@@ -112,6 +112,7 @@ object FViewCustomers: TFViewCustomers
Header.ListItemElementClassName = 'page-item' Header.ListItemElementClassName = 'page-item'
Header.ListLinkElementClassName = 'page-link' Header.ListLinkElementClassName = 'page-link'
WordWrap = True WordWrap = True
OnClickCell = wdbtcCustomersClickCell
OnDblClickCell = wdbtcCustomersDblClickCell OnDblClickCell = wdbtcCustomersDblClickCell
Columns = < Columns = <
item item
......
...@@ -38,6 +38,7 @@ type ...@@ -38,6 +38,7 @@ type
procedure wdbtcCustomersDblClickCell(Sender: TObject; ACol, ARow: Integer); procedure wdbtcCustomersDblClickCell(Sender: TObject; ACol, ARow: Integer);
procedure edtFilterChange(Sender: TObject); procedure edtFilterChange(Sender: TObject);
procedure wcbPageSizeChange(Sender: TObject); procedure wcbPageSizeChange(Sender: TObject);
procedure wdbtcCustomersClickCell(Sender: TObject; ACol, ARow: Integer);
private private
{ Private declarations } { Private declarations }
procedure GeneratePagination(TotalPages: Integer); procedure GeneratePagination(TotalPages: Integer);
...@@ -82,7 +83,8 @@ begin ...@@ -82,7 +83,8 @@ begin
newform.ShowModal( newform.ShowModal(
procedure(AValue: TModalResult) procedure(AValue: TModalResult)
begin begin
if newform.confirm then
FViewMain.ViewAddCustomer('', newform.QB_ID);
end end
); );
end; end;
...@@ -169,6 +171,12 @@ begin ...@@ -169,6 +171,12 @@ begin
getCustomers(GenerateSearchOptions()); getCustomers(GenerateSearchOptions());
end; end;
procedure TFViewCustomers.wdbtcCustomersClickCell(Sender: TObject; ACol,
ARow: Integer);
begin
console.log(xdwdsCustomersSHORT_NAME.AsString);
end;
procedure TFViewCustomers.wdbtcCustomersDblClickCell(Sender: TObject; ACol, procedure TFViewCustomers.wdbtcCustomersDblClickCell(Sender: TObject; ACol,
ARow: Integer); ARow: Integer);
begin begin
......
...@@ -22,18 +22,11 @@ object FViewHome: TFViewHome ...@@ -22,18 +22,11 @@ object FViewHome: TFViewHome
HeightPercent = 100.000000000000000000 HeightPercent = 100.000000000000000000
Lines.Strings = ( Lines.Strings = (
'Change Log:' 'Change Log:'
'1) Setting a status now autofills due dates.' '1) Updated access type'
'2) Fixed order dates displaying on 3 lines rather than 2.' '2) Removed user profile')
'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 ReadOnly = True
SelLength = 0 SelLength = 0
SelStart = 323 SelStart = 62
WidthPercent = 100.000000000000000000 WidthPercent = 100.000000000000000000
end end
end end
...@@ -91,10 +91,8 @@ begin ...@@ -91,10 +91,8 @@ begin
QB_ID := xdwdsCustomers.FieldByName('qb_items_qb_id').AsString; QB_ID := xdwdsCustomers.FieldByName('qb_items_qb_id').AsString;
name := xdwdsCustomers.FieldByName('qb_item_name').AsString; name := xdwdsCustomers.FieldByName('qb_item_name').AsString;
description := xdwdsCustomers.FieldByName('item_desc').AsString; description := xdwdsCustomers.FieldByName('item_desc').AsString;
if xdwdsCustomers.FieldByName('status').AsBoolean then status := xdwdsCustomers.FieldByName('status').AsString;
status := 'ACTIVE'
else
status := 'INACTIVE';
confirm := true; confirm := true;
Close; Close;
end; end;
......
...@@ -439,37 +439,46 @@ end; ...@@ -439,37 +439,46 @@ end;
procedure TFViewItems.btnAddClick(Sender: TObject); procedure TFViewItems.btnAddClick(Sender: TObject);
var var
itemOptions: string; itemOptions, AccessType: string;
newform: TFViewAddItem; newform: TFViewAddItem;
begin begin
newform := TFViewAddItem.CreateNew; AccessType := JS.toString(AuthService.TokenPayload.Properties['user_access_type']);
if( ( AccessType = 'ADMIN' ) or ( AccessType = 'QBUSR' ) ) 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.FieldByName('QB_ID').AsString := newform.QB_ID; xdwdsItems.Append;
xdwdsItems.FieldByName('name').AsString := newform.name;
xdwdsItems.FieldByName('description').AsString := newform.description; xdwdsItems.FieldByName('QB_ID').AsString := newform.QB_ID;
xdwdsItems.FieldByName('status').AsString := newform.status; xdwdsItems.FieldByName('name').AsString := newform.name;
xdwdsItems.FieldByName('description').AsString := newform.description;
xdwdsItems.FieldByName('status').AsString := newform.status;
console.log(xdwdsItems.FieldByName('status').AsString);
console.log(newform.status);
xdwdsItems.Post;
EditMode();
lblFormState.Caption := 'Add Mode';
end;
end
);
end
else
ShowToast('Failure:User not authorized to add item from QuickBooks', 'failure');
xdwdsItems.Post;
EditMode();
lblFormState.Caption := 'Add Mode';
end;
end
);
end; end;
procedure TFViewItems.btnCancelClick(Sender: TObject); procedure TFViewItems.btnCancelClick(Sender: TObject);
...@@ -498,15 +507,22 @@ end; ...@@ -498,15 +507,22 @@ end;
procedure TFViewItems.btnDeleteClick(Sender: TObject); procedure TFViewItems.btnDeleteClick(Sender: TObject);
begin begin
ShowNotificationModal('Deleting items is not yet implemented.'); ShowToast('Deleting items is not yet implemented.', 'info');
end; end;
procedure TFViewItems.btnUpdateClick(Sender: TObject); procedure TFViewItems.btnUpdateClick(Sender: TObject);
var var
itemOptions: string; itemOptions, AccessType: string;
newform: TFViewAddItem; newform: TFViewAddItem;
begin begin
UpdateItem(); AccessType := JS.toString(AuthService.TokenPayload.Properties['user_access_type']);
if( ( AccessType = 'ADMIN' ) or ( AccessType = 'QBUSR' ) ) then
begin
UpdateItem();
end
else
ShowToast('Failure:User not authorized to update item from QuickBooks', 'failure');
end; end;
procedure TFViewItems.UpdateItem(); procedure TFViewItems.UpdateItem();
...@@ -560,10 +576,10 @@ begin ...@@ -560,10 +576,10 @@ begin
if change then if change then
begin begin
EditMode; EditMode;
ShowToast('Update successful. Changes have been highlighted'); ShowToast('Changes have been highlighted');
end end
else else
ShowToast('Update successful. No Changes needed'); ShowToast('No Changes needed');
except except
on E: EXDataClientRequestException do on E: EXDataClientRequestException do
Utils.ShowErrorModal(E.ErrorResult.ErrorMessage); Utils.ShowErrorModal(E.ErrorResult.ErrorMessage);
......
...@@ -54,7 +54,7 @@ procedure TFViewLogin.btnLoginClick(Sender: TObject); ...@@ -54,7 +54,7 @@ procedure TFViewLogin.btnLoginClick(Sender: TObject);
procedure LoginError(AMsg: string); procedure LoginError(AMsg: string);
begin begin
ShowNotification('Login Error: ' + AMsg); ShowNotification(AMsg);
end; end;
var var
hashPW: string; hashPW: string;
......
...@@ -22,17 +22,6 @@ object FViewMain: TFViewMain ...@@ -22,17 +22,6 @@ object FViewMain: TFViewMain
Transparent = False Transparent = False
WidthPercent = 100.000000000000000000 WidthPercent = 100.000000000000000000
end end
object wllblUserProfile: TWebLinkLabel
Left = 529
Top = 21
Width = 59
Height = 14
ElementID = 'dropdown.menu.userprofile'
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
OnClick = wllblUserProfileClick
Caption = ' User Profile'
end
object wllblLogout: TWebLinkLabel object wllblLogout: TWebLinkLabel
Left = 554 Left = 554
Top = 148 Top = 148
...@@ -74,6 +63,7 @@ object FViewMain: TFViewMain ...@@ -74,6 +63,7 @@ object FViewMain: TFViewMain
Height = 14 Height = 14
ElementID = 'dropdown.menu.itemlist' ElementID = 'dropdown.menu.itemlist'
ElementFont = efCSS ElementFont = efCSS
Enabled = False
HeightPercent = 100.000000000000000000 HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000 WidthPercent = 100.000000000000000000
OnClick = lblItemsListClick OnClick = lblItemsListClick
...@@ -86,6 +76,7 @@ object FViewMain: TFViewMain ...@@ -86,6 +76,7 @@ object FViewMain: TFViewMain
Height = 14 Height = 14
ElementID = 'dropdown.menu.users' ElementID = 'dropdown.menu.users'
ElementFont = efCSS ElementFont = efCSS
Enabled = False
HeightPercent = 100.000000000000000000 HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000 WidthPercent = 100.000000000000000000
OnClick = lblUsersClick OnClick = lblUsersClick
...@@ -114,6 +105,7 @@ object FViewMain: TFViewMain ...@@ -114,6 +105,7 @@ object FViewMain: TFViewMain
ElementID = 'lblcustomers' ElementID = 'lblcustomers'
ElementFont = efCSS ElementFont = efCSS
ElementPosition = epRelative ElementPosition = epRelative
Enabled = False
HeightStyle = ssAuto HeightStyle = ssAuto
HeightPercent = 100.000000000000000000 HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000 WidthPercent = 100.000000000000000000
...@@ -140,6 +132,7 @@ object FViewMain: TFViewMain ...@@ -140,6 +132,7 @@ object FViewMain: TFViewMain
Caption = 'QB Info' Caption = 'QB Info'
ElementID = 'dropdown.menu.linktoqb' ElementID = 'dropdown.menu.linktoqb'
ElementFont = efCSS ElementFont = efCSS
Enabled = False
HeightStyle = ssAuto HeightStyle = ssAuto
HeightPercent = 100.000000000000000000 HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000 WidthPercent = 100.000000000000000000
...@@ -153,8 +146,14 @@ object FViewMain: TFViewMain ...@@ -153,8 +146,14 @@ object FViewMain: TFViewMain
Caption = 'TEST MODE' Caption = 'TEST MODE'
ElementID = 'view.main.test' ElementID = 'view.main.test'
ElementFont = efCSS ElementFont = efCSS
Font.Charset = ANSI_CHARSET
Font.Color = clBlack
Font.Height = -11
Font.Name = 'Arial'
Font.Style = []
HeightStyle = ssAuto HeightStyle = ssAuto
HeightPercent = 100.000000000000000000 HeightPercent = 100.000000000000000000
ParentFont = False
WidthPercent = 100.000000000000000000 WidthPercent = 100.000000000000000000
end end
object WebPanel1: TWebPanel object WebPanel1: TWebPanel
......
...@@ -4,7 +4,7 @@ ...@@ -4,7 +4,7 @@
<div class="d-flex align-items-center"> <div class="d-flex align-items-center">
<a id="view.main.apptitle" class="navbar-brand" href="index.html">Koehler-Gibson Orders</a> <a id="view.main.apptitle" class="navbar-brand" href="index.html">Koehler-Gibson Orders</a>
<span id="view.main.version" class="small text-muted ms-2 me-5"></span> <span id="view.main.version" class="small text-muted ms-2 me-5"></span>
<span id="view.main.test" class="test-warning fw-bold mb-1" style="display: none;">TEST MODE</span> <span id="view.main.test" class="test-warning fw-bold mb-1 text-nowrap" style="display: none; font-size: 0.85rem;">TEST MODE</span>
</div> </div>
<ul class="navbar-nav ml-auto"> <ul class="navbar-nav ml-auto">
<li class="nav-item"> <li class="nav-item">
...@@ -28,9 +28,6 @@ ...@@ -28,9 +28,6 @@
<a class="dropdown-item" id="dropdown.menu.home" href="#"><i class="fa fa-home fa-fw"></i><span> Home</span></a> <a class="dropdown-item" id="dropdown.menu.home" href="#"><i class="fa fa-home fa-fw"></i><span> Home</span></a>
</li> </li>
<li> <li>
<a class="dropdown-item" id="dropdown.menu.userprofile" href="#"><i class="fa fa-user fa-fw"></i><span> User Profile</span></a>
</li>
<li>
<a class="dropdown-item" id="dropdown.menu.users" href="#"><i class="fas fa-address-book fa-fw"></i><span> Users</span></a> <a class="dropdown-item" id="dropdown.menu.users" href="#"><i class="fas fa-address-book fa-fw"></i><span> Users</span></a>
</li> </li>
<li> <li>
......
...@@ -12,7 +12,6 @@ uses ...@@ -12,7 +12,6 @@ uses
type type
TFViewMain = class(TWebForm) TFViewMain = class(TWebForm)
lblUsername: TWebLabel; lblUsername: TWebLabel;
wllblUserProfile: TWebLinkLabel;
wllblLogout: TWebLinkLabel; wllblLogout: TWebLinkLabel;
WebPanel1: TWebPanel; WebPanel1: TWebPanel;
lblHome: TWebLinkLabel; lblHome: TWebLinkLabel;
...@@ -29,7 +28,6 @@ type ...@@ -29,7 +28,6 @@ type
WebLabel1: TWebLabel; WebLabel1: TWebLabel;
procedure WebFormCreate(Sender: TObject); procedure WebFormCreate(Sender: TObject);
procedure mnuLogoutClick(Sender: TObject); procedure mnuLogoutClick(Sender: TObject);
procedure wllblUserProfileClick(Sender: TObject);
procedure wllblLogoutClick(Sender: TObject); procedure wllblLogoutClick(Sender: TObject);
procedure lblHomeClick(Sender: TObject); procedure lblHomeClick(Sender: TObject);
procedure lblItemsListClick(Sender: TObject); procedure lblItemsListClick(Sender: TObject);
...@@ -75,7 +73,6 @@ implementation ...@@ -75,7 +73,6 @@ implementation
uses uses
Auth.Service, Auth.Service,
View.Login, View.Login,
View.UserProfile,
View.Home, View.Home,
View.Items, View.Items,
View.Users, View.Users,
...@@ -92,7 +89,7 @@ uses ...@@ -92,7 +89,7 @@ uses
procedure TFViewMain.WebFormCreate(Sender: TObject); procedure TFViewMain.WebFormCreate(Sender: TObject);
var var
userName: string; userName, AccessType: string;
test: boolean; test: boolean;
begin begin
FUserInfo := GetUserInfo; FUserInfo := GetUserInfo;
...@@ -100,13 +97,20 @@ begin ...@@ -100,13 +97,20 @@ begin
lblUsername.Caption := ' ' + userName.ToLower + ' '; lblUsername.Caption := ' ' + userName.ToLower + ' ';
FChildForm := nil; FChildForm := nil;
change := false; change := false;
AccessType := JS.toString(AuthService.TokenPayload.Properties['user_access_type']);
if (not (JS.toString(AuthService.TokenPayload.Properties['user_access_type']) = 'ADMIN')) then if ( AccessType = 'ADMIN' ) then
begin begin
lblUsers.enabled := false; lblUsers.enabled := true;
lblQBInfo.Enabled := false;
lblCustomers.Enabled := false;
end; end;
if( ( AccessType = 'ADMIN' ) or ( AccessType = 'QBUSR' ) ) then
begin
lblQBInfo.Enabled := true;
lblCustomers.Enabled := true;
lblItemsList.Enabled := true;
end;
lblAppTitle.Caption := 'Koehler-Gibson Orders'; lblAppTitle.Caption := 'Koehler-Gibson Orders';
lblVersion.Caption := 'v' + DMConnection.clientVersion; lblVersion.Caption := 'v' + DMConnection.clientVersion;
ShowForm(TFViewOrders); ShowForm(TFViewOrders);
...@@ -266,14 +270,6 @@ begin ...@@ -266,14 +270,6 @@ begin
end; end;
procedure TFViewMain.wllblUserProfileClick(Sender: TObject);
begin
ShowCrudForm(TFViewUserProfile);
lblAppTitle.Caption := 'Koehler-Gibson User Profile';
setActive('User Profile');
end;
function TFViewMain.GetUserInfo: string; function TFViewMain.GetUserInfo: string;
var var
userStr: string; userStr: string;
......
...@@ -390,8 +390,10 @@ procedure TFOrderEntryCorrugated.btnQBClick(Sender: TObject); ...@@ -390,8 +390,10 @@ procedure TFOrderEntryCorrugated.btnQBClick(Sender: TObject);
var var
orderJSON: TJSONObject; orderJSON: TJSONObject;
qbEnabled: boolean; qbEnabled: boolean;
AccessType: string;
begin begin
if JS.toString(AuthService.TokenPayload.Properties['user_qb_id']) <> '' then AccessType := JS.toString(AuthService.TokenPayload.Properties['user_access_type']);
if( ( AccessType = 'ADMIN' ) or ( AccessType = 'QBUSR' ) ) then
begin begin
if ( VerifyQBOrder() )then if ( VerifyQBOrder() )then
begin begin
...@@ -513,6 +515,10 @@ begin ...@@ -513,6 +515,10 @@ begin
xdwdsOrder.Close; xdwdsOrder.Close;
xdwdsOrder.SetJsonData(jsObj); xdwdsOrder.SetJsonData(jsObj);
xdwdsOrder.Open; xdwdsOrder.Open;
cbLoose.Checked := ( xdwdsOrder.FieldByName('mounting_loose').AsString <> '' );
cbStripMount.Checked := ( xdwdsOrder.FieldByName('mounting_strip_mount').AsString <> '' );
OrderID := xdwdsOrderORDER_ID.AsString;
mode := 'EDIT'; mode := 'EDIT';
ShowToast(string(jsObj.Properties['status'])); ShowToast(string(jsObj.Properties['status']));
...@@ -630,7 +636,7 @@ begin ...@@ -630,7 +636,7 @@ begin
notification := TJSObject(Response.Result); notification := TJSObject(Response.Result);
ShowToast(string(notification['status'])); ShowToast(string(notification['status']));
xdwdsShipTo.Close; xdwdsShipTo.Close;
xdwdsShipTo.SetJSONData(notification['ADDRESS']); xdwdsShipTo.SetJSONData(TJSObject(notification['customer'])['SHIPPING_ADDRESS_LIST']);
xdwdsShipTo.Open; xdwdsShipTo.Open;
end; end;
...@@ -666,7 +672,7 @@ begin ...@@ -666,7 +672,7 @@ begin
AddressJSON.AddPair('state', newform.edtState.Text); AddressJSON.AddPair('state', newform.edtState.Text);
AddressJSON.AddPair('zip', newform.edtZip.Text); AddressJSON.AddPair('zip', newform.edtZip.Text);
AddressJSON.AddPair('contact', newform.edtContact.Text); AddressJSON.AddPair('contact', newform.edtContact.Text);
AddressJSON.AddPair('customer_id', customerID); AddressJSON.AddPair('customer_id', xdwdsOrder.FieldByName('COMPANY_ID').AsString);
ship_block := newform.edtFirstLine.Text + slinebreak + ship_block := newform.edtFirstLine.Text + slinebreak +
edtCompanyName.Text + slinebreak + edtCompanyName.Text + slinebreak +
...@@ -676,6 +682,7 @@ begin ...@@ -676,6 +682,7 @@ begin
AddressJSON.AddPair('ship_block', ship_block); AddressJSON.AddPair('ship_block', ship_block);
AddressJSON.AddPair('mode', 'ADD'); AddressJSON.AddPair('mode', 'ADD');
console.log(AddressJSON);
sendAddressToServer(AddressJSON); sendAddressToServer(AddressJSON);
end; end;
end end
...@@ -787,7 +794,7 @@ begin ...@@ -787,7 +794,7 @@ begin
container := TJSHTMLElement(document.getElementById('additionalFields')); container := TJSHTMLElement(document.getElementById('additionalFields'));
if Assigned(container) then if Assigned(container) then
container.innerHTML := ''; // Wipe previous content container.innerHTML := ''; // Wipe previous colors
if xdwdsOrdercolors_colors.Value <> '' then if xdwdsOrdercolors_colors.Value <> '' then
begin begin
...@@ -800,6 +807,7 @@ begin ...@@ -800,6 +807,7 @@ begin
end; end;
end; end;
if xdwdsOrder.FieldByName('mounting_loose').AsString <> '' then if xdwdsOrder.FieldByName('mounting_loose').AsString <> '' then
cbLoose.Checked := true; cbLoose.Checked := true;
......
...@@ -194,8 +194,10 @@ procedure TFOrderEntryCuttingDie.btnQBClick(Sender: TObject); ...@@ -194,8 +194,10 @@ procedure TFOrderEntryCuttingDie.btnQBClick(Sender: TObject);
var var
orderJSON: TJSONObject; orderJSON: TJSONObject;
qbEnabled: boolean; qbEnabled: boolean;
AccessType: string;
begin begin
if JS.toString(AuthService.TokenPayload.Properties['user_qb_id']) <> '' then AccessType := JS.toString(AuthService.TokenPayload.Properties['user_access_type']);
if( ( AccessType = 'ADMIN' ) or ( AccessType = 'QBUSR' ) ) then
begin begin
if ( VerifyQBOrder() )then if ( VerifyQBOrder() )then
begin begin
...@@ -231,7 +233,7 @@ begin ...@@ -231,7 +233,7 @@ begin
notification := TJSObject(Response.Result); notification := TJSObject(Response.Result);
ShowToast(string(notification['status'])); ShowToast(string(notification['status']));
xdwdsShipTo.Close; xdwdsShipTo.Close;
xdwdsShipTo.SetJSONData(notification['ADDRESS']); xdwdsShipTo.SetJSONData(TJSObject(notification['customer'])['SHIPPING_ADDRESS_LIST']);
xdwdsShipTo.Open; xdwdsShipTo.Open;
end; end;
...@@ -428,6 +430,7 @@ begin ...@@ -428,6 +430,7 @@ begin
xdwdsOrder.Close; xdwdsOrder.Close;
xdwdsOrder.SetJsonData(jsObj); xdwdsOrder.SetJsonData(jsObj);
xdwdsOrder.Open; xdwdsOrder.Open;
OrderID := xdwdsOrderORDER_ID.AsString;
mode := 'EDIT'; mode := 'EDIT';
ShowToast(String(jsObj.Properties['status'])); ShowToast(String(jsObj.Properties['status']));
...@@ -488,8 +491,8 @@ begin ...@@ -488,8 +491,8 @@ begin
if confirmed then if confirmed then
begin begin
FViewMain.change := false; FViewMain.change := false;
if xdwdsOrder.FieldByName('ORDER_ID').AsString <> '' then if orderID <> '' then
FViewMain.ViewOrderEntryCuttingDie(xdwdsOrder.FieldByName('ORDER_ID').AsString, '', 'EDIT', 'Failure: Changes Discarded') FViewMain.ViewOrderEntryCuttingDie(orderID, '', 'EDIT', 'Failure: Changes Discarded')
else else
FViewMain.ViewOrders(''); FViewMain.ViewOrders('');
end; end;
......
...@@ -323,7 +323,7 @@ begin ...@@ -323,7 +323,7 @@ begin
notification := TJSObject(Response.Result); notification := TJSObject(Response.Result);
ShowToast(string(notification['status'])); ShowToast(string(notification['status']));
xdwdsShipTo.Close; xdwdsShipTo.Close;
xdwdsShipTo.SetJSONData(notification['ADDRESS']); xdwdsShipTo.SetJSONData(TJSObject(notification['customer'])['SHIPPING_ADDRESS_LIST']);
xdwdsShipTo.Open; xdwdsShipTo.Open;
end; end;
...@@ -358,7 +358,7 @@ begin ...@@ -358,7 +358,7 @@ begin
AddressJSON.AddPair('state', newform.edtState.Text); AddressJSON.AddPair('state', newform.edtState.Text);
AddressJSON.AddPair('zip', newform.edtZip.Text); AddressJSON.AddPair('zip', newform.edtZip.Text);
AddressJSON.AddPair('contact', newform.edtContact.Text); AddressJSON.AddPair('contact', newform.edtContact.Text);
AddressJSON.AddPair('customer_id', customerID); AddressJSON.AddPair('customer_id', xdwdsOrderCOMPANY_ID.AsString);
ship_block := newform.edtFirstLine.Text + slinebreak + ship_block := newform.edtFirstLine.Text + slinebreak +
edtCompanyName.Text + slinebreak + edtCompanyName.Text + slinebreak +
...@@ -454,8 +454,10 @@ procedure TFOrderEntryWeb.btnQBClick(Sender: TObject); ...@@ -454,8 +454,10 @@ procedure TFOrderEntryWeb.btnQBClick(Sender: TObject);
var var
orderJSON: TJSONObject; orderJSON: TJSONObject;
qbEnabled: boolean; qbEnabled: boolean;
AccessType: string;
begin begin
if JS.toString(AuthService.TokenPayload.Properties['user_qb_id']) <> '' then AccessType := JS.toString(AuthService.TokenPayload.Properties['user_access_type']);
if( ( AccessType = 'ADMIN' ) or ( AccessType = 'QBUSR' ) ) then
begin begin
if ( VerifyQBOrder() )then if ( VerifyQBOrder() )then
begin begin
...@@ -597,6 +599,7 @@ begin ...@@ -597,6 +599,7 @@ begin
xdwdsOrder.Open; xdwdsOrder.Open;
mode := 'EDIT'; mode := 'EDIT';
OrderID := xdwdsOrderORDER_ID.AsString;
ShowToast(String(jsObj.Properties['status'])); ShowToast(String(jsObj.Properties['status']));
except except
on E: EXDataClientRequestException do on E: EXDataClientRequestException do
...@@ -768,6 +771,7 @@ var ...@@ -768,6 +771,7 @@ var
colorList: TJSArray; colorList: TJSArray;
color: TJSObject; color: TJSObject;
items: TJSObject; items: TJSObject;
container: TJSHTMLElement;
begin begin
Utils.ShowSpinner('spinner'); Utils.ShowSpinner('spinner');
try try
...@@ -779,6 +783,10 @@ begin ...@@ -779,6 +783,10 @@ begin
xdwdsOrder.SetJsonData(order); xdwdsOrder.SetJsonData(order);
xdwdsOrder.Open; xdwdsOrder.Open;
container := TJSHTMLElement(document.getElementById('additionalFields'));
if Assigned(container) then
container.innerHTML := ''; // Wipe previous colors
if xdwdsOrderquantity_and_colors_qty_colors.Value <> '' then if xdwdsOrderquantity_and_colors_qty_colors.Value <> '' then
begin begin
colorObject := TJSObject(TJSJSON.parse(xdwdsOrderquantity_and_colors_qty_colors.Value)); colorObject := TJSObject(TJSJSON.parse(xdwdsOrderquantity_and_colors_qty_colors.Value));
...@@ -875,6 +883,7 @@ begin ...@@ -875,6 +883,7 @@ begin
btnCancel.Enabled := True; btnCancel.Enabled := True;
btnEdit.Enabled := false; btnEdit.Enabled := false;
btnAdd.Enabled := false; btnAdd.Enabled := false;
btnQB.Enabled := false;
cbPdf.Enabled := True; cbPdf.Enabled := True;
cbInkJet.Enabled := True; cbInkJet.Enabled := True;
...@@ -912,6 +921,7 @@ begin ...@@ -912,6 +921,7 @@ begin
btnCancel.Enabled := false; btnCancel.Enabled := false;
btnEdit.Enabled := true; btnEdit.Enabled := true;
btnAdd.Enabled := true; btnAdd.Enabled := true;
btnQB.Enabled := true;
FViewMain.change := false; FViewMain.change := false;
cbPdf.Enabled := False; cbPdf.Enabled := False;
......
...@@ -14,7 +14,7 @@ uses ...@@ -14,7 +14,7 @@ uses
WEBLib.JSON, Auth.Service, XData.Web.Client, WebLib.Storage, WEBLib.JSON, Auth.Service, XData.Web.Client, WebLib.Storage,
ConnectionModule, App.Types, Vcl.StdCtrls, Vcl.Controls, WEBLib.DBCtrls, ConnectionModule, App.Types, Vcl.StdCtrls, Vcl.Controls, WEBLib.DBCtrls,
XData.Web.JsonDataset, WEBLib.DB, Data.DB, XData.Web.Dataset, XData.Web.DatasetCommon, XData.Web.JsonDataset, WEBLib.DB, Data.DB, XData.Web.Dataset, XData.Web.DatasetCommon,
WEBLib.Grids, VCL.Forms; WEBLib.Grids, VCL.Forms, Math;
type type
TFViewOrders = class(TWebForm) TFViewOrders = class(TWebForm)
...@@ -552,8 +552,15 @@ end; ...@@ -552,8 +552,15 @@ end;
procedure TFViewOrders.wcbPageSizeChange(Sender: TObject); procedure TFViewOrders.wcbPageSizeChange(Sender: TObject);
var
ratio: double;
begin begin
ratio := PageSize/StrToInt(wcbPageSize.Text);
PageSize := StrToInt(wcbPageSize.Text); PageSize := StrToInt(wcbPageSize.Text);
if ratio < 1 then
PageNumber := Ceil(PageNumber * ratio)
else
PageNumber := Ceil(PageNumber * ratio) - Trunc(ratio) + 1;
getOrders(generateSearchOptions()); getOrders(generateSearchOptions());
end; end;
......
...@@ -36,11 +36,17 @@ implementation ...@@ -36,11 +36,17 @@ implementation
{$R *.dfm} {$R *.dfm}
uses View.Main, Utils; uses View.Main, Utils, Auth.Service;
procedure TFQBInfo.btnLinkToQBClick(Sender: TObject); procedure TFQBInfo.btnLinkToQBClick(Sender: TObject);
var
AccessType: String;
begin begin
GetQBLink(); AccessType := JS.toString(AuthService.TokenPayload.Properties['user_access_type']);
if( ( AccessType = 'ADMIN' ) or ( AccessType = 'QBUSR' ) ) then
GetQBLink()
else
ShowToast('Failure:User not authorized to add to QuickBooks', 'failure');
end; end;
procedure TFQBInfo.WebFormCreate(Sender: TObject); procedure TFQBInfo.WebFormCreate(Sender: TObject);
......
...@@ -220,7 +220,7 @@ begin ...@@ -220,7 +220,7 @@ begin
else if wlcbStatus.DisplayText = 'Plate Done' then else if wlcbStatus.DisplayText = 'Plate Done' then
begin begin
dtpPlateDue.Date := plateDue; dtpPlateDue.Date := plateDue;
dtpShipDue.Date := plateDue; dtpShipDue.Date := dtpDate.Date;
end end
else if wlcbStatus.DisplayText = 'Ship Done' then else if wlcbStatus.DisplayText = 'Ship Done' then
begin begin
...@@ -235,10 +235,6 @@ begin ...@@ -235,10 +235,6 @@ begin
begin begin
dtpShipDue.Date := shipDue; dtpShipDue.Date := shipDue;
end end
else if wlcbStatus.DisplayText = 'Art Done' then
begin
dtpShipDue.Date := dtpDate.Date;
end
else if wlcbStatus.DisplayText = 'Ship Done' then else if wlcbStatus.DisplayText = 'Ship Done' then
begin begin
dtpShipDue.Date := shipDue; dtpShipDue.Date := shipDue;
......
...@@ -195,23 +195,9 @@ object FViewEditUser: TFViewEditUser ...@@ -195,23 +195,9 @@ object FViewEditUser: TFViewEditUser
ChildOrder = 19 ChildOrder = 19
ElementID = 'edtrights' ElementID = 'edtrights'
HeightPercent = 100.000000000000000000 HeightPercent = 100.000000000000000000
MaxLength = 11
WidthPercent = 100.000000000000000000 WidthPercent = 100.000000000000000000
end end
object cbAccess: TWebComboBox
Left = 346
Top = 90
Width = 145
Height = 23
ElementID = 'cbaccess'
HeightPercent = 100.000000000000000000
TabStop = False
WidthPercent = 100.000000000000000000
ItemIndex = -1
Items.Strings = (
'SALES'
'USER'
'ADMIN')
end
object edtQB: TWebEdit object edtQB: TWebEdit
Left = 346 Left = 346
Top = 62 Top = 62
...@@ -223,6 +209,33 @@ object FViewEditUser: TFViewEditUser ...@@ -223,6 +209,33 @@ object FViewEditUser: TFViewEditUser
HeightPercent = 100.000000000000000000 HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000 WidthPercent = 100.000000000000000000
end end
object cbAccess: TWebLookupComboBox
Left = 346
Top = 93
Width = 145
Height = 22
ElementID = 'cbaccess'
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
ItemIndex = -1
LookupValues = <
item
Value = 'ADMIN'
DisplayText = 'Admin'
end
item
Value = 'USER'
DisplayText = 'User'
end
item
Value = 'SALES'
DisplayText = 'Sales User'
end
item
Value = 'QBUSR'
DisplayText = 'QB User'
end>
end
object XDataWebClient1: TXDataWebClient object XDataWebClient1: TXDataWebClient
Connection = DMConnection.ApiConnection Connection = DMConnection.ApiConnection
Left = 514 Left = 514
......
...@@ -29,9 +29,9 @@ type ...@@ -29,9 +29,9 @@ type
lblRights: TWebLabel; lblRights: TWebLabel;
edtRights: TWebEdit; edtRights: TWebEdit;
lblAccess: TWebLabel; lblAccess: TWebLabel;
cbAccess: TWebComboBox;
lblQB: TWebLabel; lblQB: TWebLabel;
edtQB: TWebEdit; edtQB: TWebEdit;
cbAccess: TWebLookupComboBox;
procedure WebFormCreate(Sender: TObject); procedure WebFormCreate(Sender: TObject);
procedure btnConfirmClick(Sender: TObject); procedure btnConfirmClick(Sender: TObject);
procedure btnCancelClick(Sender: TObject); procedure btnCancelClick(Sender: TObject);
...@@ -90,7 +90,7 @@ begin ...@@ -90,7 +90,7 @@ begin
'&password=' + edtPassword.Text + '&password=' + edtPassword.Text +
'&status=' + BoolToStr(cbStatus.Checked) + '&status=' + BoolToStr(cbStatus.Checked) +
'&email=' + edtEmail.Text + '&email=' + edtEmail.Text +
'&access=' + cbAccess.Text + '&access=' + cbAccess.Value +
'&newuser=' + edtUsername.Text + '&newuser=' + edtUsername.Text +
'&rights=' + edtRights.Text + '&rights=' + edtRights.Text +
'&QB=' + edtQB.Text; '&QB=' + edtQB.Text;
...@@ -123,7 +123,7 @@ begin ...@@ -123,7 +123,7 @@ begin
'&password=' + edtPassword.Text + '&password=' + edtPassword.Text +
'&status=' + BoolToStr(cbStatus.Checked) + '&status=' + BoolToStr(cbStatus.Checked) +
'&email=' + edtEmail.Text + '&email=' + edtEmail.Text +
'&access=' + cbAccess.Text + '&access=' + cbAccess.Value +
'&newuser=' + edtUsername.Text + '&newuser=' + edtUsername.Text +
'&rights=' + edtRights.Text + '&rights=' + edtRights.Text +
'&QB=' + edtQB.Text; '&QB=' + edtQB.Text;
...@@ -176,7 +176,10 @@ begin ...@@ -176,7 +176,10 @@ begin
edtPassword.Text := 'hidden'; edtPassword.Text := 'hidden';
end; end;
edtEmail.Text := Email; edtEmail.Text := Email;
cbAccess.Text := Access; if Access = '' then
cbAccess.Value := 'USER'
else
cbAccess.Value := Access;
edtRights.Text := Rights; edtRights.Text := Rights;
edtQB.Text := QB; edtQB.Text := QB;
if Status = 'ACTIVE' then if Status = 'ACTIVE' then
......
object FViewUserProfile: TFViewUserProfile
Width = 604
Height = 434
CSSLibrary = cssBootstrap
ElementFont = efCSS
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
ParentFont = False
OnShow = WebFormShow
object WebLabel1: TWebLabel
Left = 24
Top = 24
Width = 55
Height = 13
Caption = 'User Profile'
ElementID = 'view.userprofile.title'
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
HeightPercent = 100.000000000000000000
ParentFont = False
Visible = False
WidthPercent = 100.000000000000000000
end
object WebLabel3: TWebLabel
Left = 41
Top = 60
Width = 38
Height = 14
Caption = 'User ID:'
ElementID = 'view.userprofile.form.lblUserID'
ElementPosition = epRelative
Font.Charset = ANSI_CHARSET
Font.Color = clBlack
Font.Height = -11
Font.Name = 'Arial'
Font.Style = []
HeightPercent = 100.000000000000000000
ParentFont = False
WidthPercent = 100.000000000000000000
end
object WebLabel2: TWebLabel
Left = 8
Top = 143
Width = 71
Height = 14
Caption = 'Email Address:'
ElementID = 'view.userprofile.form.lblEmail'
ElementPosition = epRelative
Font.Charset = ANSI_CHARSET
Font.Color = clBlack
Font.Height = -11
Font.Name = 'Arial'
Font.Style = []
HeightPercent = 100.000000000000000000
ParentFont = False
WidthPercent = 100.000000000000000000
end
object WebLabel4: TWebLabel
Left = 27
Top = 84
Width = 52
Height = 14
Caption = 'Username:'
ElementID = 'view.userprofile.form.lblUserName'
ElementPosition = epRelative
Font.Charset = ANSI_CHARSET
Font.Color = clBlack
Font.Height = -11
Font.Name = 'Arial'
Font.Style = []
HeightPercent = 100.000000000000000000
ParentFont = False
WidthPercent = 100.000000000000000000
end
object WebLabel5: TWebLabel
Left = 30
Top = 117
Width = 49
Height = 14
Caption = 'Full Name:'
ElementID = 'view.userprofile.form.lblFullName'
ElementPosition = epRelative
Font.Charset = ANSI_CHARSET
Font.Color = clBlack
Font.Height = -11
Font.Name = 'Arial'
Font.Style = []
HeightPercent = 100.000000000000000000
ParentFont = False
WidthPercent = 100.000000000000000000
end
object WebLabel6: TWebLabel
Left = 15
Top = 171
Width = 64
Height = 13
Caption = 'Access Type:'
ElementID = 'view.userprofile.form.lblAccessType'
ElementFont = efCSS
HeightStyle = ssAuto
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
end
object WebLabel7: TWebLabel
Left = 47
Top = 196
Width = 32
Height = 13
Caption = 'QB ID:'
ElementID = 'view.userprofile.form.lblQBID'
ElementFont = efCSS
HeightStyle = ssAuto
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
end
object WebDBEdit1: TWebDBEdit
Left = 90
Top = 168
Width = 121
Height = 22
ChildOrder = 13
ElementClassName = 'form-control'
ElementID = 'view.userprofile.form.edtAccessType'
ElementFont = efCSS
HeightStyle = ssAuto
HeightPercent = 100.000000000000000000
Text = 'WebDBEdit1'
WidthPercent = 100.000000000000000000
DataField = 'AType'
DataSource = wdsUser
end
object WebDBEdit2: TWebDBEdit
Left = 90
Top = 140
Width = 121
Height = 22
ChildOrder = 13
ElementClassName = 'form-control'
ElementID = 'view.userprofile.form.edtEmail'
ElementFont = efCSS
HeightStyle = ssAuto
HeightPercent = 100.000000000000000000
Text = 'WebDBEdit1'
WidthPercent = 100.000000000000000000
DataField = 'email_address'
DataSource = wdsUser
end
object WebDBEdit3: TWebDBEdit
Left = 90
Top = 114
Width = 121
Height = 22
ChildOrder = 13
ElementClassName = 'form-control'
ElementID = 'view.userprofile.form.edtFullName'
ElementFont = efCSS
HeightStyle = ssAuto
HeightPercent = 100.000000000000000000
Text = 'WebDBEdit1'
WidthPercent = 100.000000000000000000
DataField = 'full_name'
DataSource = wdsUser
end
object WebDBEdit4: TWebDBEdit
Left = 85
Top = 81
Width = 121
Height = 22
ChildOrder = 13
ElementClassName = 'form-control'
ElementID = 'view.userprofile.form.edtUsername'
ElementFont = efCSS
HeightStyle = ssAuto
HeightPercent = 100.000000000000000000
Text = 'WebDBEdit1'
WidthPercent = 100.000000000000000000
DataField = 'username'
DataSource = wdsUser
end
object WebDBEdit5: TWebDBEdit
Left = 85
Top = 57
Width = 121
Height = 22
ChildOrder = 13
ElementClassName = 'form-control'
ElementID = 'view.userprofile.form.edtUserID'
ElementFont = efCSS
HeightStyle = ssAuto
HeightPercent = 100.000000000000000000
Text = 'WebDBEdit1'
WidthPercent = 100.000000000000000000
DataField = 'userID'
DataSource = wdsUser
end
object WebDBEdit6: TWebDBEdit
Left = 90
Top = 196
Width = 121
Height = 22
ChildOrder = 13
ElementClassName = 'form-control'
ElementID = 'view.userprofile.form.edtQBID'
ElementFont = efCSS
HeightStyle = ssAuto
HeightPercent = 100.000000000000000000
Text = 'WebDBEdit1'
WidthPercent = 100.000000000000000000
DataField = 'QBID'
DataSource = wdsUser
end
object XDataWebClient1: TXDataWebClient
Connection = DMConnection.ApiConnection
Left = 359
Top = 52
end
object xdwdsUser: TXDataWebDataSet
Left = 314
Top = 216
object xdwdsUseruserID: TStringField
FieldName = 'userID'
end
object xdwdsUserusername: TStringField
FieldName = 'username'
end
object xdwdsUseremail_address: TStringField
FieldName = 'email_address'
end
object xdwdsUserQBID: TStringField
FieldName = 'QBID'
end
object xdwdsUserAType: TStringField
FieldName = 'Atype'
end
object xdwdsUserfull_name: TStringField
FieldName = 'full_name'
end
end
object wdsUser: TWebDataSource
AutoEdit = False
DataSet = xdwdsUser
Left = 422
Top = 262
end
end
<div class="container">
<!-- Profile form -->
<div class="row">
<div class="col-lg-8 col-xl-6 mx-auto">
<form id="userprofileform" class="needs-validation" role="form" autocomplete="off" novalidate>
<div class="mb-3">
<label id="view.userprofile.form.lblUserID"
for="view.userprofile.form.edtUserID"
class="form-label">User&nbsp;ID</label>
<input id="view.userprofile.form.edtUserID"
class="form-control"
readonly>
</div>
<div class="mb-3">
<label id="view.userprofile.form.lblUserName"
for="view.userprofile.form.edtUsername"
class="form-label">Username</label>
<input id="view.userprofile.form.edtUsername"
class="form-control">
</div>
<div class="mb-3">
<label id="view.userprofile.form.lblFullName"
for="view.userprofile.form.edtFullName"
class="form-label">Full&nbsp;Name</label>
<input id="view.userprofile.form.edtFullName"
class="form-control">
</div>
<div class="mb-3">
<label id="view.userprofile.form.lblEmail"
for="view.userprofile.form.edtEmail"
class="form-label">Email&nbsp;Address</label>
<input id="view.userprofile.form.edtEmail"
type="email"
class="form-control">
</div>
<div class="mb-3">
<label id="view.userprofile.form.lblAccessType"
for="view.userprofile.form.edtAccessType"
class="form-label">Email&nbsp;Address</label>
<input id="view.userprofile.form.edtAccessType"
type="email"
class="form-control">
</div>
<div class="mb-3">
<label id="view.userprofile.form.lblQBID"
for="view.userprofile.form.edtQBID"
class="form-label">Email&nbsp;Address</label>
<input id="view.userprofile.form.edtQBID"
type="email"
class="form-control">
</div>
</form>
</div>
</div>
</div>
unit View.UserProfile;
interface
uses
System.SysUtils, System.Classes, JS, Web, WEBLib.Graphics, WEBLib.Controls,
WEBLib.Forms, WEBLib.Dialogs, Vcl.Controls, Vcl.StdCtrls, WEBLib.StdCtrls,
XData.Web.Client, WEBLib.ExtCtrls, DB, XData.Web.JsonDataset,
XData.Web.Dataset, XData.Web.Connection, Vcl.Forms, ConnectionModule,
WEBLib.Toast, WEBLib.DBCtrls;
type
TFViewUserProfile = class(TWebForm)
WebLabel1: TWebLabel;
WebLabel3: TWebLabel;
WebLabel2: TWebLabel;
WebLabel4: TWebLabel;
WebLabel5: TWebLabel;
XDataWebClient1: TXDataWebClient;
WebDBEdit1: TWebDBEdit;
WebDBEdit2: TWebDBEdit;
WebDBEdit3: TWebDBEdit;
WebDBEdit4: TWebDBEdit;
WebDBEdit5: TWebDBEdit;
WebDBEdit6: TWebDBEdit;
WebLabel6: TWebLabel;
WebLabel7: TWebLabel;
xdwdsUser: TXDataWebDataSet;
wdsUser: TWebDataSource;
xdwdsUseruserID: TStringField;
xdwdsUserusername: TStringField;
xdwdsUseremail_address: TStringField;
xdwdsUserQBID: TStringField;
xdwdsUserAType: TStringField;
xdwdsUserfull_name: TStringField;
procedure WebFormShow(Sender: TObject);
[async] procedure GetUser();
end;
var
FViewUserProfile: TFViewUserProfile;
implementation
uses
Auth.Service,
XData.Model.Classes,
Utils,
View.Main;
{$R *.dfm}
procedure TFViewUserProfile.WebFormShow(Sender: TObject);
begin
GetUser();
end;
procedure TFViewUserProfile.GetUser;
var
xdcResponse: TXDataClientResponse;
userList: TJSObject;
data: TJSArray;
user: TJSObject;
begin
try
xdcResponse := await(XDataWebClient1.RawInvokeAsync('ILookupService.GetUsers',
[JS.toString(AuthService.TokenPayload.Properties['user_name'])]));
userList := TJSObject(xdcResponse.Result);
data := TJSArray(userList['data']);
user := TJSObject(data[0]);
xdwdsUser.SetJsonData(user);
xdwdsUser.Open;
except
on E: EXDataClientRequestException do
Utils.ShowErrorModal(E.ErrorResult.ErrorMessage);
end;
end;
end.
[Paths]
HtmlPath=C:\Projects\kgOrders\kgOrders\kgOrdersClient\TMSWeb\Debug
HtmlFile=index.html
DefaultURL=http://127.0.0.1:8000/webKGOrders
SingleInstance=0
Debug=0
DebugManager=C:\RADTools\TMS\Products\tms.webcore\Bin\Win32\TMSDBGManager.exe
URL=http://127.0.0.1:8000/$(ProjectName)
URLParams=
Browser=1
BrowserBin=
BrowserParams=
Electron=0
ElectronBuild=0
JSDebugger=0
...@@ -21,6 +21,11 @@ ...@@ -21,6 +21,11 @@
text-align: center; text-align: center;
} }
#tblPhoneGrid thead th:nth-child(20) {
font-size: 0.9rem !important;
font-weight: bold; /* Optional: keep it bold if shrinking makes it too thin */
}
input[type="text"] { input[type="text"] {
min-width: 50px; min-width: 50px;
max-width: 100%; max-width: 100%;
...@@ -42,11 +47,11 @@ input[type=number] { ...@@ -42,11 +47,11 @@ input[type=number] {
.changed-field { .changed-field {
border: 1px solid #ffc107 !important; border: 1px solid #FFFF00 !important;
} }
.changed-field-label { .changed-field-label {
background-color: #fff3cd; background-color: #FFFF00;
border-radius: 4px; border-radius: 4px;
padding: 2px 6px; padding: 2px 6px;
} }
......
...@@ -8,7 +8,6 @@ uses ...@@ -8,7 +8,6 @@ uses
App.Types in 'App.Types.pas', App.Types in 'App.Types.pas',
ConnectionModule in 'ConnectionModule.pas' {DMConnection: TWebDataModule}, ConnectionModule in 'ConnectionModule.pas' {DMConnection: TWebDataModule},
View.Login in 'View.Login.pas' {FViewLogin: TWebForm} {*.html}, View.Login in 'View.Login.pas' {FViewLogin: TWebForm} {*.html},
View.UserProfile in 'View.UserProfile.pas' {FViewUserProfile: TWebForm} {*.html},
View.ErrorPage in 'View.ErrorPage.pas' {FViewErrorPage: TWebForm} {*.html}, View.ErrorPage in 'View.ErrorPage.pas' {FViewErrorPage: TWebForm} {*.html},
App.Config in 'App.Config.pas', App.Config in 'App.Config.pas',
Paginator.Plugins in 'Paginator.Plugins.pas', Paginator.Plugins in 'Paginator.Plugins.pas',
...@@ -65,7 +64,10 @@ end; ...@@ -65,7 +64,10 @@ end;
procedure UnauthorizedAccessProc(AMessage: string); procedure UnauthorizedAccessProc(AMessage: string);
begin begin
DisplayLoginView(AMessage); if Pos('JWT', AMessage) > 0 then
DisplayLoginView('Login token expired! Please login again')
else
DisplayLoginView(AMessage);
end; end;
...@@ -89,27 +91,31 @@ begin ...@@ -89,27 +91,31 @@ begin
end end
else else
begin begin
asm // asm
var dlg = document.createElement("dialog"); // var dlg = document.createElement("dialog");
dlg.classList.add("shadow", "rounded", "border", "p-4"); // dlg.classList.add("shadow", "rounded", "border", "p-4");
dlg.style.maxWidth = "500px"; // dlg.style.maxWidth = "500px";
dlg.style.width = "90%"; // dlg.style.width = "90%";
dlg.style.fontFamily = "system-ui, sans-serif"; // dlg.style.fontFamily = "system-ui, sans-serif";
//
dlg.innerHTML = // dlg.innerHTML =
"<h5 class='fw-bold mb-3 text-danger'>kgOrders web app</h5>" + // "<h5 class='fw-bold mb-3 text-danger'>kgOrders web app</h5>" +
"<p class='mb-3' style='white-space: pre-wrap;'>" + ErrorMessage + "</p>" + // "<p class='mb-3' style='white-space: pre-wrap;'>" + ErrorMessage + "</p>" +
"<div class='text-end'>" + // "<div class='text-end'>" +
"<button id='refreshBtn' class='btn btn-primary'>Reload</button></div>"; // "<button id='refreshBtn' class='btn btn-primary'>Reload</button></div>";
//
document.body.appendChild(dlg); // document.body.appendChild(dlg);
dlg.showModal(); // dlg.showModal();
//
document.getElementById("refreshBtn").addEventListener("click", function () { // document.getElementById("refreshBtn").addEventListener("click", function () {
var base = location.origin + location.pathname; // var base = location.origin + location.pathname;
location.replace(base + "?ver=" + ClientVer + "&r=" + Date.now() + location.hash); // location.replace(base + "?ver=" + ClientVer + "&r=" + Date.now() + location.hash);
}); // });
end; // end;
if Pos('version', ErrorMessage) > 0 then
ShowMessage( ErrorMessage )
else
ShowMessage( 'Error connecting to kgOrdersServer' + sLineBreak + 'Please contact EM Systems support' );
end; end;
end); end);
end, end,
......
...@@ -99,9 +99,9 @@ ...@@ -99,9 +99,9 @@
<VerInfo_MajorVer>0</VerInfo_MajorVer> <VerInfo_MajorVer>0</VerInfo_MajorVer>
<VerInfo_MinorVer>9</VerInfo_MinorVer> <VerInfo_MinorVer>9</VerInfo_MinorVer>
<VerInfo_Release>8</VerInfo_Release> <VerInfo_Release>8</VerInfo_Release>
<TMSWebBrowser>1</TMSWebBrowser>
<TMSUseJSDebugger>2</TMSUseJSDebugger> <TMSUseJSDebugger>2</TMSUseJSDebugger>
<TMSWebSingleInstance>1</TMSWebSingleInstance> <TMSWebSingleInstance>1</TMSWebSingleInstance>
<TMSWebBrowser>5</TMSWebBrowser>
<TMSWebOutputPath>..\kgOrdersServer\bin\static</TMSWebOutputPath> <TMSWebOutputPath>..\kgOrdersServer\bin\static</TMSWebOutputPath>
</PropertyGroup> </PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2)'!=''"> <PropertyGroup Condition="'$(Cfg_2)'!=''">
...@@ -133,10 +133,6 @@ ...@@ -133,10 +133,6 @@
<Form>FViewLogin</Form> <Form>FViewLogin</Form>
<DesignClass>TWebForm</DesignClass> <DesignClass>TWebForm</DesignClass>
</DCCReference> </DCCReference>
<DCCReference Include="View.UserProfile.pas">
<Form>FViewUserProfile</Form>
<DesignClass>TWebForm</DesignClass>
</DCCReference>
<DCCReference Include="View.ErrorPage.pas"> <DCCReference Include="View.ErrorPage.pas">
<Form>FViewErrorPage</Form> <Form>FViewErrorPage</Form>
<DesignClass>TWebForm</DesignClass> <DesignClass>TWebForm</DesignClass>
......
// 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
......
// Auth Database to verify logins
unit Auth.Database; unit Auth.Database;
interface interface
...@@ -50,24 +48,21 @@ uses ...@@ -50,24 +48,21 @@ 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' );
try try
LoadDatabaseSettings( ucKG );
ucKG.Connect; ucKG.Connect;
except except
on E: Exception do on E: Exception do
begin begin
Logger.Log( 1, '--TAuthDatabase.DataModuleCreate -Error connecting to database: ' + E.Message ); Logger.Log( 1, '--TAuthDatabase.DataModuleCreate -Error connecting to database: ' + E.Message );
raise EXDataHttpException.Create(500, 'Error Connecting to database! Please try again later or contact a system admin!');
end; end;
end; end;
end; end;
procedure TAuthDatabase.DataModuleDestroy(Sender: TObject); procedure TAuthDatabase.DataModuleDestroy(Sender: TObject);
begin begin
ucKG.Connected := false; ucKG.Connected := false;
Logger.Log( 5, 'TAuthDatabase.DataModuleDestroy' ); Logger.Log( 5, 'TAuthDatabase.DataModuleDestroy' );
end; end;
end. end.
...@@ -49,22 +49,33 @@ procedure TAuthService.AfterConstruction; ...@@ -49,22 +49,33 @@ procedure TAuthService.AfterConstruction;
begin begin
inherited; inherited;
try try
Logger.Log(4, 'TAuthService.AfterConstruction');
authDB := TAuthDatabase.Create(nil); authDB := TAuthDatabase.Create(nil);
if not authDB.ucKG.Connected then
begin
Logger.Log(1, 'Unable to connect to the database: A KGOrders Server Error has occured!');
raise EXDataHttpException.Create(500, 'Unable to connect to the database: A KGOrders Server Error has occured!');
end;
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;
...@@ -85,7 +96,7 @@ begin ...@@ -85,7 +96,7 @@ begin
Result.AddPair('error', Result.AddPair('error',
'webApp version mismatch' + sLineBreak + ' Client version: ' + clientVersion + 'webApp version mismatch' + sLineBreak + ' Client version: ' + clientVersion +
sLineBreak + ' Server version: ' + webClientVersion + sLineBreak + ' Server version: ' + webClientVersion +
sLineBreak + 'Please click button to clear cache and reload.'); sLineBreak + 'Please clear cache and reload.');
end; end;
finally finally
iniFile.Free; iniFile.Free;
...@@ -146,6 +157,7 @@ begin ...@@ -146,6 +157,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 +187,7 @@ begin ...@@ -175,6 +187,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 +200,7 @@ begin ...@@ -187,6 +200,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 +294,8 @@ begin ...@@ -280,6 +294,8 @@ begin
end; end;
end; end;
initialization initialization
RegisterServiceType(TAuthService); RegisterServiceType(TAuthService);
end. end.
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.
...@@ -38,6 +38,7 @@ type ...@@ -38,6 +38,7 @@ type
state: string; state: string;
zip: string; zip: string;
contact: string; contact: string;
first_line: string;
end; end;
TQBCustomerItem = class TQBCustomerItem = class
...@@ -153,13 +154,14 @@ type ...@@ -153,13 +154,14 @@ type
TAddressItem = class TAddressItem = class
Public Public
ship_block: string; ship_id: string;
first_line: string;
shipping_address: string; shipping_address: string;
city: string; city: string;
state: string; state: string;
contact: string;
zip: string; zip: string;
ship_id: string; contact: string;
ship_block: string;
end; end;
TCustomerItem = class TCustomerItem = class
...@@ -182,6 +184,12 @@ type ...@@ -182,6 +184,12 @@ type
SHIPPING_ADDRESS_LIST: TList<TAddressItem>; SHIPPING_ADDRESS_LIST: TList<TAddressItem>;
end; end;
TCustomerResponse = class
Public
customer: TCustomerItem;
status: string;
end;
TCustomerList = class TCustomerList = class
Public Public
count: integer; count: integer;
...@@ -536,7 +544,7 @@ type ...@@ -536,7 +544,7 @@ type
function AddUser(userInfo: string): string; function AddUser(userInfo: string): string;
function AddItem(itemInfo: string): TJSONObject; function AddItem(itemInfo: string): TJSONObject;
function AddShippingAddress(Addressinfo: string): TJSONObject; function AddShippingAddress(Addressinfo: string): TCustomerResponse;
function DelShippingAddress(AddressID, CustomerID: string): TJSONObject; function DelShippingAddress(AddressID, CustomerID: string): TJSONObject;
function DelUser(username: string): string; function DelUser(username: string): string;
function DelOrder(orderID, orderType, UserID: string): TJSONObject; function DelOrder(orderID, orderType, UserID: string): TJSONObject;
......
...@@ -61,7 +61,7 @@ type ...@@ -61,7 +61,7 @@ type
function AddCorrugatedOrder(orderInfo: string): TJSONObject; function AddCorrugatedOrder(orderInfo: string): TJSONObject;
function AddWebOrder(orderInfo: string): TJSONObject; function AddWebOrder(orderInfo: string): TJSONObject;
function AddCuttingDieOrder(orderInfo: string): TJSONObject; function AddCuttingDieOrder(orderInfo: string): TJSONObject;
function AddShippingAddress(AddressInfo: string): TJSONObject; function AddShippingAddress(AddressInfo: string): TCustomerResponse;
function delOrder(OrderID, OrderType, UserID: string): TJSONObject; function delOrder(OrderID, OrderType, UserID: string): TJSONObject;
function DelShippingAddress(AddressID, CustomerID: string): TJSONObject; function DelShippingAddress(AddressID, CustomerID: string): TJSONObject;
...@@ -134,11 +134,20 @@ begin ...@@ -134,11 +134,20 @@ begin
RefreshAccessToken(); RefreshAccessToken();
Client := iniFile.ReadString('Quickbooks', 'ClientID', ''); Client := iniFile.ReadString('Quickbooks', 'ClientID', '');
logger.Log(5, 'Quickbooks.ClientID: ' + Client);
Secret := iniFile.ReadString('Quickbooks', 'ClientSecret', ''); Secret := iniFile.ReadString('Quickbooks', 'ClientSecret', '');
logger.Log(5, 'Quickbooks.ClientSecret: ' + Secret);
CompanyID := iniFile.ReadString('Quickbooks', 'CompanyID', ''); CompanyID := iniFile.ReadString('Quickbooks', 'CompanyID', '');
logger.Log(5, 'Quickbooks.CompanyID: ' + CompanyID);
RefreshToken := iniFile.ReadString('Quickbooks', 'RefreshToken', ''); RefreshToken := iniFile.ReadString('Quickbooks', 'RefreshToken', '');
logger.Log(5, 'Quickbooks.RefreshToken: ' + RefreshToken);
AccessToken := iniFile.ReadString('Quickbooks', 'AccessToken', ''); AccessToken := iniFile.ReadString('Quickbooks', 'AccessToken', '');
BaseUrl := iniFile.ReadString('Quickbooks', 'BaseUrl', ''); BaseUrl := iniFile.ReadString('Quickbooks', 'BaseUrl', '');
logger.Log(5, 'Quickbooks.BaseUrl: ' + BaseUrl);
restClient.BaseURL := BaseUrl; restClient.BaseURL := BaseUrl;
...@@ -153,7 +162,7 @@ begin ...@@ -153,7 +162,7 @@ begin
param.Value := 'Bearer ' + AccessToken; param.Value := 'Bearer ' + AccessToken;
restRequest.Execute; restRequest.Execute;
logger.Log(5, 'TLookupService.GetQBInfo - Raw Response: ' + restResponse.Content);
jsValue := restResponse.JSONValue; jsValue := restResponse.JSONValue;
jsObj := TJSONObject(jsValue); jsObj := TJSONObject(jsValue);
CompanyInfoList := TJSONArray(TJSONObject(jsObj.GetValue('QueryResponse')).GetValue('CompanyInfo')); CompanyInfoList := TJSONArray(TJSONObject(jsObj.GetValue('QueryResponse')).GetValue('CompanyInfo'));
...@@ -505,7 +514,8 @@ begin ...@@ -505,7 +514,8 @@ begin
while not ordersDB.UniQuery1.Eof do while not ordersDB.UniQuery1.Eof do
begin begin
ADDRESS := TJSONObject.Create; ADDRESS := TJSONObject.Create;
ADDRESS.AddPair('ADDRESS', ordersDB.UniQuery1.FieldByName('ship_block').AsString); ADDRESS.AddPair('ship_block', ordersDB.UniQuery1.FieldByName('ship_block').AsString);
ADDRESS.AddPair('first_line', ordersDB.UniQuery1.FieldByName('first_line').AsString);
ADDRESS.AddPair('shipping_address', ordersDB.UniQuery1.FieldByName('address').AsString); ADDRESS.AddPair('shipping_address', ordersDB.UniQuery1.FieldByName('address').AsString);
ADDRESS.AddPair('city', ordersDB.UniQuery1.FieldByName('city').AsString); ADDRESS.AddPair('city', ordersDB.UniQuery1.FieldByName('city').AsString);
ADDRESS.AddPair('state', ordersDB.UniQuery1.FieldByName('state').AsString); ADDRESS.AddPair('state', ordersDB.UniQuery1.FieldByName('state').AsString);
...@@ -613,11 +623,11 @@ begin ...@@ -613,11 +623,11 @@ begin
if ID = '' then if ID = '' then
SQL := 'select * FROM customers c LEFT JOIN customers_ship s ON c.CUSTOMER_ID = s.customer_id WHERE c.CUSTOMER_ID = -1' SQL := 'select * FROM customers c LEFT JOIN customers_ship s ON c.CUSTOMER_ID = s.customer_id WHERE c.CUSTOMER_ID = -1'
else else
SQL := 'select * FROM customers c LEFT JOIN customers_ship s ON c.CUSTOMER_ID = s.customer_id WHERE c.CUSTOMER_ID = ' + ID; SQL := 'select * FROM customers c WHERE c.CUSTOMER_ID = ' + ID;
logger.Log(5, 'Getting customer with SQL: ' + SQL); logger.Log(5, 'Getting customer with SQL: ' + SQL);
doQuery(ordersDB.UniQuery1, SQL); doQuery(ordersDB.UniQuery1, SQL);
result := TCustomerItem.Create; result := TCustomerItem.Create;
TXDataOperationContext.Current.Handler.ManagedObjects.Add(result);
result.NAME := ordersDB.UniQuery1.FieldByName('NAME').AsString; result.NAME := ordersDB.UniQuery1.FieldByName('NAME').AsString;
result.CUSTOMER_ID := ordersDB.UniQuery1.FieldByName('CUSTOMER_ID').AsInteger; result.CUSTOMER_ID := ordersDB.UniQuery1.FieldByName('CUSTOMER_ID').AsInteger;
...@@ -638,19 +648,23 @@ begin ...@@ -638,19 +648,23 @@ begin
result.SHIPPING_ADDRESS_LIST := TList<TAddressItem>.Create; result.SHIPPING_ADDRESS_LIST := TList<TAddressItem>.Create;
TXDataOperationContext.Current.Handler.ManagedObjects.Add( Result.SHIPPING_ADDRESS_LIST ); TXDataOperationContext.Current.Handler.ManagedObjects.Add( Result.SHIPPING_ADDRESS_LIST );
while not ordersDB.UniQuery1.Eof do SQL := 'SELECT * from customers_ship cs where cs.CUSTOMER_ID = ' + ID;
logger.Log(5, 'Getting customer shipping addresses with SQL: ' + SQL);
doQuery(ordersDB.UniQuery2, SQL);
while not ordersDB.UniQuery2.Eof do
begin begin
ADDRESS := TAddressItem.Create; ADDRESS := TAddressItem.Create;
TXDataOperationContext.Current.Handler.ManagedObjects.Add( ADDRESS ); TXDataOperationContext.Current.Handler.ManagedObjects.Add( ADDRESS );
ADDRESS.ship_block := ordersDB.UniQuery1.FieldByName('ship_block').AsString; ADDRESS.ship_block := ordersDB.UniQuery2.FieldByName('ship_block').AsString;
ADDRESS.shipping_address := ordersDB.UniQuery1.FieldByName('address').AsString; ADDRESS.shipping_address := ordersDB.UniQuery2.FieldByName('address').AsString;
ADDRESS.city := ordersDB.UniQuery1.FieldByName('city').AsString; ADDRESS.city := ordersDB.UniQuery2.FieldByName('city').AsString;
ADDRESS.state := ordersDB.UniQuery1.FieldByName('state').AsString; ADDRESS.state := ordersDB.UniQuery2.FieldByName('state').AsString;
ADDRESS.zip := ordersDB.UniQuery1.FieldByName('zip').AsString; ADDRESS.zip := ordersDB.UniQuery2.FieldByName('zip').AsString;
ADDRESS.contact := ordersDB.UniQuery1.FieldByName('contact').AsString; ADDRESS.contact := ordersDB.UniQuery2.FieldByName('contact').AsString;
ADDRESS.ship_id := ordersDB.UniQuery1.FieldByName('customer_ship_id').AsString; ADDRESS.ship_id := ordersDB.UniQuery2.FieldByName('customer_ship_id').AsString;
ADDRESS.first_line := ordersDB.UniQuery2.FieldByName('first_line').AsString;
result.SHIPPING_ADDRESS_LIST.Add(ADDRESS); result.SHIPPING_ADDRESS_LIST.Add(ADDRESS);
ordersDB.UniQuery1.Next; ordersDB.UniQuery2.Next;
end; end;
logger.Log(3, 'TLookupService.GetCustomer - end'); logger.Log(3, 'TLookupService.GetCustomer - end');
...@@ -740,7 +754,7 @@ begin ...@@ -740,7 +754,7 @@ begin
end; end;
end; end;
function TLookupService.AddShippingAddress(AddressInfo: string): TJSONObject; function TLookupService.AddShippingAddress(AddressInfo: string): TCustomerResponse;
var var
JSONData: TJSONObject; JSONData: TJSONObject;
SQL: string; SQL: string;
...@@ -754,7 +768,8 @@ var ...@@ -754,7 +768,8 @@ var
CustomerID: string; CustomerID: string;
begin begin
logger.Log(3, 'TLookupSerivce.AddShippingAddress - start'); logger.Log(3, 'TLookupSerivce.AddShippingAddress - start');
result := TJSONObject.Create; result := TCustomerResponse.Create;
TXDataOperationContext.Current.Handler.ManagedObjects.Add(Result);
JSONData := TJSONObject.ParseJSONValue(AddressInfo) as TJSONObject; JSONData := TJSONObject.ParseJSONValue(AddressInfo) as TJSONObject;
if JSONData = nil then if JSONData = nil then
...@@ -769,7 +784,7 @@ begin ...@@ -769,7 +784,7 @@ begin
ShipID := JSONData.GetValue<integer>('customer_ship_id'); ShipID := JSONData.GetValue<integer>('customer_ship_id');
SQL := 'select * from customers_ship where customer_ship_id = ' + IntToStr(ShipID); SQL := 'select * from customers_ship where customer_ship_id = ' + IntToStr(ShipID);
end; end;
logger.Log(5, 'Retrieving Address with SQL ' + SQL); logger.Log(5, 'Retrieving Address with SQL: ' + SQL);
doQuery(ordersDB.UniQuery1, SQL); doQuery(ordersDB.UniQuery1, SQL);
try try
...@@ -803,34 +818,16 @@ begin ...@@ -803,34 +818,16 @@ begin
else else
msg := 'Success: Shipping Address Successfully Edited'; msg := 'Success: Shipping Address Successfully Edited';
logger.Log(3, msg); logger.Log(3, msg);
// Sends the updated Address List Back.
SQL := 'select * FROM customers c LEFT JOIN customers_ship s ON c.CUSTOMER_ID = s.customer_id WHERE c.CUSTOMER_ID = ' + CustomerID; // Sends the updated Address List Back.
logger.Log(5, 'Retrieving updated customer address list with SQL: ' + SQL); result.customer := GetCustomer(CustomerID);
doQuery(ordersDB.UniQuery1, SQL); result.status := msg;
ADDRESS_LIST := TJSONArray.Create;
while not ordersDB.UniQuery1.Eof do
begin
ADDRESS := TJSONObject.Create;
ADDRESS.AddPair('ADDRESS', ordersDB.UniQuery1.FieldByName('ship_block').AsString);
ADDRESS.AddPair('shipping_address', ordersDB.UniQuery1.FieldByName('address').AsString);
ADDRESS.AddPair('city', ordersDB.UniQuery1.FieldByName('city').AsString);
ADDRESS.AddPair('state', ordersDB.UniQuery1.FieldByName('state').AsString);
ADDRESS.AddPair('zip', ordersDB.UniQuery1.FieldByName('zip').AsString);
ADDRESS.AddPair('contact', ordersDB.UniQuery1.FieldByName('contact').AsString);
ADDRESS.AddPair('ship_id', ordersDB.UniQuery1.FieldByName('customer_ship_id').AsString);
ADDRESS_LIST.Add(ADDRESS);
ordersDB.UniQuery1.Next;
end;
Result.AddPair('status', msg);
Result.AddPair('ADDRESS', ADDRESS_LIST);
TXDataOperationContext.Current.Handler.ManagedObjects.Add(Result);
logger.Log(3, 'TLookupService.AddShippingAddress - end'); logger.Log(3, 'TLookupService.AddShippingAddress - end');
except except
on E: Exception do on E: Exception do
begin begin
Result.AddPair('error', E.Message); result.status := 'An error has occured! Please contact an admin for support.';
Logger.Log(1, 'Error in TLookupService.AddShippingAddress: ' + E.Message); Logger.Log(1, 'Error in TLookupService.AddShippingAddress: ' + E.Message);
end end
end; end;
...@@ -1076,7 +1073,10 @@ begin ...@@ -1076,7 +1073,10 @@ begin
if startDate <> '' then if startDate <> '' then
begin begin
result := result + ' AND ' + quotedStr(startDate) + ' <= STATUS_DATE'; if startDate = '1899/12/30' then
result := result + ' AND ' + quotedStr(startDate) + ' < STATUS_DATE'
else
result := result + ' AND ' + quotedStr(startDate) + ' <= STATUS_DATE';
end; end;
if ( ( endDate <> '1899/12/30' ) AND ( endDate <> '' ) ) then if ( ( endDate <> '1899/12/30' ) AND ( endDate <> '' ) ) then
...@@ -1175,7 +1175,7 @@ begin ...@@ -1175,7 +1175,7 @@ begin
begin begin
if status.startDate <> '' then if status.startDate <> '' then
begin begin
result := result + ' AND ' + quotedStr(status.startDate) + ' <= COALESCE(cpo.staff_fields_order_date, wpo.staff_fields_order_date, cdo.staff_fields_order_date)'; result := result + ' AND ' + quotedStr(status.startDate) + ' <= COALESCE(cpo.staff_fields_order_date, wpo.staff_fields_order_date, cdo.staff_fields_order_date';
end; end;
if ( ( status.endDate <> '1899/12/30' ) AND ( status.endDate <> '' ) ) then if ( ( status.endDate <> '1899/12/30' ) AND ( status.endDate <> '' ) ) then
...@@ -1376,20 +1376,40 @@ begin ...@@ -1376,20 +1376,40 @@ begin
Order.companyName := FieldByName('COMPANY_NAME').AsString; Order.companyName := FieldByName('COMPANY_NAME').AsString;
Order.jobName := FieldByName('JOB_NAME').AsString; Order.jobName := FieldByName('JOB_NAME').AsString;
Order.orderDate := FieldByName('ORDER_DATE').AsString; Order.orderDate := FieldByName('ORDER_DATE').AsString;
Order.proofDue := FieldByName('PROOF_DUE').AsString;
Order.proofDone := FieldByName('PROOF_DONE').AsString; Order.proofDone := FieldByName('PROOF_DONE').AsString;
Order.artDue := FieldByName('ART_DUE').AsString;
Order.artDone := FieldByName('ART_DONE').AsString; Order.artDone := FieldByName('ART_DONE').AsString;
Order.plateDue := FieldByName('PLATE_DUE').AsString;
Order.plateDone := FieldByName('PLATE_DONE').AsString; Order.plateDone := FieldByName('PLATE_DONE').AsString;
Order.mountDue := FieldByName('MOUNT_DUE').AsString;
Order.mountDone := FieldByName('MOUNT_DONE').AsString; Order.mountDone := FieldByName('MOUNT_DONE').AsString;
Order.shipDue := FieldByName('SHIP_DUE').AsString;
Order.shipDone := FieldByName('SHIP_DONE').AsString; Order.shipDone := FieldByName('SHIP_DONE').AsString;
Order.price := FieldByName('PRICE').AsString; Order.price := FieldByName('PRICE').AsString;
Order.qbRefNum := FieldByName('QB_ORDER_NUM').AsString; Order.qbRefNum := FieldByName('QB_ORDER_NUM').AsString;
Order.orderType := FieldByName('ORDER_TYPE').AsString.Replace('_', ' '); Order.orderType := FieldByName('ORDER_TYPE').AsString.Replace('_', ' ');
Order.cadFile := FieldByName('layout_cad_file').AsString; Order.cadFile := FieldByName('layout_cad_file').AsString;
if FieldByName('PROOF_DUE').AsDateTime = 0 then
Order.proofDue := ''
else
Order.proofDue := FieldByName('PROOF_DUE').AsString;
if FieldByName('ART_DUE').AsDateTime = 0 then
Order.artDue := ''
else
Order.artDue := FieldByName('ART_DUE').AsString;
if FieldByName('PLATE_DUE').AsDateTime = 0 then
Order.plateDue := ''
else
Order.plateDue := FieldByName('PLATE_DUE').AsString;
if FieldByName('MOUNT_DUE').AsDateTime = 0 then
Order.mountDue := ''
else
Order.mountDue := FieldByName('MOUNT_DUE').AsString;
if FieldByName('SHIP_DUE').AsDateTime = 0 then
Order.shipDue := ''
else
Order.shipDue := FieldByName('SHIP_DUE').AsString;
end; end;
if ordersDB.UniQuery1.FieldByName('ORDER_TYPE').AsString = 'web_plate' then if ordersDB.UniQuery1.FieldByName('ORDER_TYPE').AsString = 'web_plate' then
...@@ -1879,6 +1899,7 @@ var ...@@ -1879,6 +1899,7 @@ var
hashString: string; hashString: string;
hashPW: string; hashPW: string;
unique: boolean; unique: boolean;
rightsInt: integer;
begin begin
logger.log(3, 'TLookupService.EditUser'); logger.log(3, 'TLookupService.EditUser');
params := TStringList.Create; params := TStringList.Create;
...@@ -1901,7 +1922,7 @@ begin ...@@ -1901,7 +1922,7 @@ begin
logger.Log(5, 'Retrieving customer with SQL: ' + SQL); logger.Log(5, 'Retrieving customer with SQL: ' + SQL);
doQuery(OrdersDB.UniQuery1, SQL); doQuery(OrdersDB.UniQuery1, SQL);
if ( (OrdersDB.UniQuery1.IsEmpty) or (OrdersDB.UniQuery1.FieldByName('USER_NAME').AsString = user) ) then if ( (OrdersDB.UniQuery1.IsEmpty) or (OrdersDB.UniQuery1.FieldByName('USER_NAME').AsString = user) or ( QB = '' ) ) then
unique := true unique := true
else else
unique := false; unique := false;
...@@ -1936,8 +1957,9 @@ begin ...@@ -1936,8 +1957,9 @@ begin
if not access.IsEmpty then if not access.IsEmpty then
ordersDB.UniQuery1.FieldByName('ACCESS_TYPE').AsString := Access; ordersDB.UniQuery1.FieldByName('ACCESS_TYPE').AsString := Access;
if not rights.IsEmpty then if not TryStrToInt(rights, rightsInt) then
ordersDB.UniQuery1.FieldByName('SYSTEM_RIGHTS').AsInteger := StrToInt(rights); rightsInt := 0;
ordersDB.UniQuery1.FieldByName('SYSTEM_RIGHTS').AsInteger := rightsInt;
if not perspective.IsEmpty then if not perspective.IsEmpty then
ordersDB.UniQuery1.FieldByName('PERSPECTIVE_ID').AsString := perspective; ordersDB.UniQuery1.FieldByName('PERSPECTIVE_ID').AsString := perspective;
...@@ -2074,16 +2096,11 @@ begin ...@@ -2074,16 +2096,11 @@ begin
ordersDB.UniQuery1.FieldByName('ORDER_ID').AsInteger := ORDER_ID; ordersDB.UniQuery1.FieldByName('ORDER_ID').AsInteger := ORDER_ID;
ordersDB.UniQuery1.Post; ordersDB.UniQuery1.Post;
if ( JSONData.GetValue<string>('staff_fields_proof_date') <> '' ) and ( JSONData.GetValue<string>('staff_fields_proof_date') <> '12/30/1899' ) then AddStatusSchedule('PROOF', JSONData, ORDER_ID);
AddStatusSchedule('PROOF', JSONData, ORDER_ID); AddStatusSchedule('ART', JSONData, ORDER_ID);
if ( JSONData.GetValue<string>('staff_fields_ship_date') <> '' ) and ( JSONData.GetValue<string>('staff_fields_ship_date') <> '12/30/1899' ) then AddStatusSchedule('SHIP', JSONData, ORDER_ID);
AddStatusSchedule('SHIP', JSONData, ORDER_ID); AddStatusSchedule('PLATE', JSONData, ORDER_ID);
if ( JSONData.GetValue<string>('staff_fields_art_due') <> '' ) and ( JSONData.GetValue<string>('staff_fields_art_due') <> '12/30/1899' ) then AddStatusSchedule('MOUNT', JSONData, ORDER_ID);
AddStatusSchedule('ART', JSONData, ORDER_ID);
if ( JSONData.GetValue<string>('staff_fields_plate_due') <> '' ) and ( JSONData.GetValue<string>('staff_fields_plate_due') <> '12/30/1899' ) then
AddStatusSchedule('PLATE', JSONData, ORDER_ID);
if ( JSONData.GetValue<string>('staff_fields_mount_due') <> '' ) and ( JSONData.GetValue<string>('staff_fields_mount_due') <> '12/30/1899' ) then
AddStatusSchedule('MOUNT', JSONData, ORDER_ID);
AddToRevisionsTable(intToStr(ORDER_ID), 'corrugated_plate_orders_revisions', JSONData); AddToRevisionsTable(intToStr(ORDER_ID), 'corrugated_plate_orders_revisions', JSONData);
...@@ -2129,6 +2146,10 @@ begin ...@@ -2129,6 +2146,10 @@ begin
else else
date := order.GetValue<string>('staff_fields_'+ StatusType.ToLower +'_due'); date := order.GetValue<string>('staff_fields_'+ StatusType.ToLower +'_due');
if date = '' then
date := '12/30/1899';
if ordersDB.uqOrdersStatusSchedule.IsEmpty then if ordersDB.uqOrdersStatusSchedule.IsEmpty then
begin begin
ordersDB.uqOrdersStatusSchedule.Insert; ordersDB.uqOrdersStatusSchedule.Insert;
...@@ -2139,6 +2160,7 @@ begin ...@@ -2139,6 +2160,7 @@ begin
else else
begin begin
ordersDB.uqOrdersStatusSchedule.Edit; ordersDB.uqOrdersStatusSchedule.Edit;
change := ordersDB.uqOrdersStatusScheduleSTATUS_DATE.AsDateTime <> StrToDateTime(date); change := ordersDB.uqOrdersStatusScheduleSTATUS_DATE.AsDateTime <> StrToDateTime(date);
if change then if change then
begin begin
...@@ -2146,6 +2168,7 @@ begin ...@@ -2146,6 +2168,7 @@ begin
ordersDB.uqOrdersStatusScheduleUSER_ID.AsString := order.GetValue<string>('USER_ID'); ordersDB.uqOrdersStatusScheduleUSER_ID.AsString := order.GetValue<string>('USER_ID');
end; end;
end; end;
ordersDB.uqOrdersStatusScheduleSTATUS_DATE.AsDateTime := StrToDateTime(date); ordersDB.uqOrdersStatusScheduleSTATUS_DATE.AsDateTime := StrToDateTime(date);
ordersDB.uqOrdersStatusScheduleORDER_ID.AsInteger := ORDER_ID; ordersDB.uqOrdersStatusScheduleORDER_ID.AsInteger := ORDER_ID;
ordersDB.uqOrdersStatusScheduleORDER_STATUS.AsString := StatusType; ordersDB.uqOrdersStatusScheduleORDER_STATUS.AsString := StatusType;
...@@ -2308,11 +2331,13 @@ begin ...@@ -2308,11 +2331,13 @@ begin
logger.Log(5, 'Retrieving customer with SQL: ' + SQL); logger.Log(5, 'Retrieving customer with SQL: ' + SQL);
doQuery(OrdersDB.UniQuery1, SQL); doQuery(OrdersDB.UniQuery1, SQL);
if ( (OrdersDB.UniQuery1.IsEmpty) or (OrdersDB.UniQuery1.FieldByName('USER_NAME').AsString = user) ) then if ( (OrdersDB.UniQuery1.IsEmpty) or (OrdersDB.UniQuery1.FieldByName('USER_NAME').AsString = user) or ( QB = '' ) ) then
unique := true unique := true
else else
unique := false; unique := false;
if unique then if unique then
begin begin
SQL := 'SELECT * FROM users WHERE USER_NAME = ' + QuotedStr(user.ToLower); SQL := 'SELECT * FROM users WHERE USER_NAME = ' + QuotedStr(user.ToLower);
...@@ -2540,14 +2565,10 @@ begin ...@@ -2540,14 +2565,10 @@ begin
ordersDB.UniQuery1.Post; ordersDB.UniQuery1.Post;
if ( JSONData.GetValue<string>('staff_fields_proof_date') <> '' ) and ( JSONData.GetValue<string>('staff_fields_proof_date') <> '12/30/1899' ) then AddStatusSchedule('PROOF', JSONData, ORDER_ID);
AddStatusSchedule('PROOF', JSONData, ORDER_ID); AddStatusSchedule('SHIP', JSONData, ORDER_ID);
if ( JSONData.GetValue<string>('staff_fields_ship_date') <> '' ) and ( JSONData.GetValue<string>('staff_fields_ship_date') <> '12/30/1899' ) then AddStatusSchedule('ART', JSONData, ORDER_ID);
AddStatusSchedule('SHIP', JSONData, ORDER_ID); AddStatusSchedule('PLATE', JSONData, ORDER_ID);
if ( JSONData.GetValue<string>('staff_fields_art_due') <> '' ) and ( JSONData.GetValue<string>('staff_fields_art_due') <> '12/30/1899' ) then
AddStatusSchedule('ART', JSONData, ORDER_ID);
if ( JSONData.GetValue<string>('staff_fields_plate_due') <> '' ) and ( JSONData.GetValue<string>('staff_fields_plate_due') <> '12/30/1899' ) then
AddStatusSchedule('PLATE', JSONData, ORDER_ID);
AddToRevisionsTable(IntToStr(ORDER_ID), 'web_plate_orders_revisions', JSONData); AddToRevisionsTable(IntToStr(ORDER_ID), 'web_plate_orders_revisions', JSONData);
...@@ -2639,10 +2660,8 @@ begin ...@@ -2639,10 +2660,8 @@ begin
// Post the record to the database // Post the record to the database
ordersDB.UniQuery1.Post; ordersDB.UniQuery1.Post;
if ( JSONData.GetValue<string>('staff_fields_proof_date') <> '' ) and ( JSONData.GetValue<string>('staff_fields_proof_date') <> '12/30/1899' ) then AddStatusSchedule('PROOF', JSONData, ORDER_ID);
AddStatusSchedule('PROOF', JSONData, ORDER_ID); AddStatusSchedule('SHIP', JSONData, ORDER_ID);
if ( JSONData.GetValue<string>('staff_fields_ship_date') <> '' ) and ( JSONData.GetValue<string>('staff_fields_ship_date') <> '12/30/1899' ) then
AddStatusSchedule('SHIP', JSONData, ORDER_ID);
AddToRevisionsTable(IntToStr(ORDER_ID), 'cutting_die_orders_revisions', JSONData); AddToRevisionsTable(IntToStr(ORDER_ID), 'cutting_die_orders_revisions', JSONData);
...@@ -2899,10 +2918,20 @@ begin ...@@ -2899,10 +2918,20 @@ begin
RefreshAccessToken(); RefreshAccessToken();
Client := iniFile.ReadString('Quickbooks', 'ClientID', ''); Client := iniFile.ReadString('Quickbooks', 'ClientID', '');
logger.Log(5, 'Quickbooks.ClientID: ' + Client);
Secret := iniFile.ReadString('Quickbooks', 'ClientSecret', ''); Secret := iniFile.ReadString('Quickbooks', 'ClientSecret', '');
logger.Log(5, 'Quickbooks.ClientSecret: ' + Secret);
CompanyID := iniFile.ReadString('Quickbooks', 'CompanyID', '');
logger.Log(5, 'Quickbooks.CompanyID: ' + CompanyID);
RefreshToken := iniFile.ReadString('Quickbooks', 'RefreshToken', ''); RefreshToken := iniFile.ReadString('Quickbooks', 'RefreshToken', '');
logger.Log(5, 'Quickbooks.RefreshToken: ' + RefreshToken);
AccessToken := iniFile.ReadString('Quickbooks', 'AccessToken', ''); AccessToken := iniFile.ReadString('Quickbooks', 'AccessToken', '');
BaseUrl := iniFile.ReadString('Quickbooks', 'BaseUrl', ''); BaseUrl := iniFile.ReadString('Quickbooks', 'BaseUrl', '');
logger.Log(5, 'Quickbooks.BaseUrl: ' + BaseUrl);
restClient.BaseURL := BaseUrl; restClient.BaseURL := BaseUrl;
restRequest.Method := rmGET; restRequest.Method := rmGET;
...@@ -3020,7 +3049,7 @@ var ...@@ -3020,7 +3049,7 @@ var
jsObj: TJSONObject; jsObj: TJSONObject;
PhoneObj: TJSONObject; PhoneObj: TJSONObject;
CustomerList: TJSONArray; CustomerList: TJSONArray;
AccessToken, RefreshToken, CompanyID, Client, Secret, BaseUrl, Line1, Line2: string; AccessToken, RefreshToken, CompanyID, Client, Secret, BaseUrl, Line1, Line2, Line3: string;
LastRefresh: TDateTime; LastRefresh: TDateTime;
I: integer; I: integer;
SQL, CustomerTypeID: string; SQL, CustomerTypeID: string;
...@@ -3052,10 +3081,20 @@ begin ...@@ -3052,10 +3081,20 @@ begin
RefreshAccessToken(); RefreshAccessToken();
Client := iniFile.ReadString('Quickbooks', 'ClientID', ''); Client := iniFile.ReadString('Quickbooks', 'ClientID', '');
logger.Log(5, 'Quickbooks.ClientID: ' + Client);
Secret := iniFile.ReadString('Quickbooks', 'ClientSecret', ''); Secret := iniFile.ReadString('Quickbooks', 'ClientSecret', '');
logger.Log(5, 'Quickbooks.ClientSecret: ' + Secret);
CompanyID := iniFile.ReadString('Quickbooks', 'CompanyID', '');
logger.Log(5, 'Quickbooks.CompanyID: ' + CompanyID);
RefreshToken := iniFile.ReadString('Quickbooks', 'RefreshToken', ''); RefreshToken := iniFile.ReadString('Quickbooks', 'RefreshToken', '');
logger.Log(5, 'Quickbooks.RefreshToken: ' + RefreshToken);
AccessToken := iniFile.ReadString('Quickbooks', 'AccessToken', ''); AccessToken := iniFile.ReadString('Quickbooks', 'AccessToken', '');
BaseUrl := iniFile.ReadString('Quickbooks', 'BaseUrl', ''); BaseUrl := iniFile.ReadString('Quickbooks', 'BaseUrl', '');
logger.Log(5, 'Quickbooks.BaseUrl: ' + BaseUrl);
restClient.BaseURL := BaseUrl; restClient.BaseURL := BaseUrl;
restRequest.Method := rmGET; restRequest.Method := rmGET;
...@@ -3147,7 +3186,21 @@ begin ...@@ -3147,7 +3186,21 @@ begin
Line1 := ShipAddr.GetValue<string>('Line1', ''); Line1 := ShipAddr.GetValue<string>('Line1', '');
Line2 := ShipAddr.GetValue<string>('Line2', ''); Line2 := ShipAddr.GetValue<string>('Line2', '');
if Line2 <> '' then Line3 := ShipAddr.GetValue<string>('Line3', '');
if Line3 <> '' then
begin
ParsedCustomer.first_line := Line1;
ParsedCustomer.shipping_address := Line3;
ParsedCustomer.contact := Line2;
ParsedCustomer.ship_block := ShipAddr.GetValue('Line1', '') + sLineBreak +
Customer.GetValue<string>('DisplayName') + sLineBreak +
ShipAddr.GetValue('Line2', '') + sLineBreak +
ShipAddr.GetValue('Line3', '') + sLineBreak +
ShipAddr.GetValue('City', '') + ', ' +
ShipAddr.GetValue('CountrySubDivisionCode', '') + ' ' +
ShipAddr.GetValue('PostalCode', '')
end
else if Line2 <> '' then
begin begin
ParsedCustomer.shipping_address := Line2; ParsedCustomer.shipping_address := Line2;
ParsedCustomer.contact := Line1; ParsedCustomer.contact := Line1;
...@@ -3343,10 +3396,20 @@ begin ...@@ -3343,10 +3396,20 @@ begin
RefreshAccessToken(); RefreshAccessToken();
Client := iniFile.ReadString('Quickbooks', 'ClientID', ''); Client := iniFile.ReadString('Quickbooks', 'ClientID', '');
logger.Log(5, 'Quickbooks.ClientID: ' + Client);
Secret := iniFile.ReadString('Quickbooks', 'ClientSecret', ''); Secret := iniFile.ReadString('Quickbooks', 'ClientSecret', '');
logger.Log(5, 'Quickbooks.ClientSecret: ' + Secret);
CompanyID := iniFile.ReadString('Quickbooks', 'CompanyID', '');
logger.Log(5, 'Quickbooks.CompanyID: ' + CompanyID);
RefreshToken := iniFile.ReadString('Quickbooks', 'RefreshToken', ''); RefreshToken := iniFile.ReadString('Quickbooks', 'RefreshToken', '');
logger.Log(5, 'Quickbooks.RefreshToken: ' + RefreshToken);
AccessToken := iniFile.ReadString('Quickbooks', 'AccessToken', ''); AccessToken := iniFile.ReadString('Quickbooks', 'AccessToken', '');
BaseUrl := iniFile.ReadString('Quickbooks', 'BaseUrl', ''); BaseUrl := iniFile.ReadString('Quickbooks', 'BaseUrl', '');
logger.Log(5, 'Quickbooks.BaseUrl: ' + BaseUrl);
restClient.BaseURL := BaseUrl; restClient.BaseURL := BaseUrl;
...@@ -3380,7 +3443,10 @@ begin ...@@ -3380,7 +3443,10 @@ begin
ParsedItem.AddPair('item_desc', desc) ParsedItem.AddPair('item_desc', desc)
else else
ParsedItem.AddPair('item_desc', 'N/A'); ParsedItem.AddPair('item_desc', 'N/A');
ParsedItem.AddPair('status', Item.GetValue<string>('Active')); if Item.GetValue<string>('Active') = 'true' then
ParsedItem.AddPair('status', 'ACTIVE')
else
ParsedItem.AddPair('status', 'INACTIVE');
ParsedItem.AddPair('qb_items_qb_id', Item.GetValue<string>('Id')); ParsedItem.AddPair('qb_items_qb_id', Item.GetValue<string>('Id'));
Result.AddElement(ParsedItem); Result.AddElement(ParsedItem);
...@@ -3640,12 +3706,14 @@ begin ...@@ -3640,12 +3706,14 @@ begin
end; end;
end; end;
if Customer.GetValue('CustomerTypeRef') is TJSONObject then if Customer.GetValue('CustomerTypeRef') is TJSONObject then
begin begin
CustomerTypeRef := Customer.GetValue('CustomerTypeRef') as TJSONObject; CustomerTypeRef := Customer.GetValue('CustomerTypeRef') as TJSONObject;
logger.Log(5, CustomerTypeRef.ToJSON); logger.Log(5, CustomerTypeRef.ToJSON);
custItem.QB_TYPE := GetCustomerType(CustomerTypeRef.GetValue<string>('value')); custItem.QB_TYPE := GetCustomerType(CustomerTypeRef.GetValue<string>('value'));
end; end
else
custItem.QB_TYPE := '';
Result := custItem; Result := custItem;
except except
...@@ -3775,7 +3843,8 @@ var ...@@ -3775,7 +3843,8 @@ var
CustomerID: Integer; CustomerID: Integer;
mode: string; mode: string;
msg: string; msg: string;
QB_LIST_ID, BaseUrl: string; QB_LIST_ID, BaseUrl, SHORT_NAME: string;
unique: boolean;
begin begin
logger.Log(3, 'TLookupService.ImportQBCustomer'); logger.Log(3, 'TLookupService.ImportQBCustomer');
DateFormat := TFormatSettings.Create; DateFormat := TFormatSettings.Create;
...@@ -3786,63 +3855,35 @@ begin ...@@ -3786,63 +3855,35 @@ begin
if JSONData = nil then if JSONData = nil then
raise Exception.Create('Invalid JSON format'); raise Exception.Create('Invalid JSON format');
QB_LIST_ID := JSONData.GetValue<string>('QB_LIST_ID'); SHORT_NAME := JSONData.GetValue<string>('SHORT_NAME');
SQL := 'select CUSTOMER_ID from customers where SHORT_NAME = ' + quotedStr(SHORT_NAME);
// Update RevisionID logger.Log(5, 'Retrieving customer with SQL: ' + SQL);
SQL := 'UPDATE idfield SET KEYVALUE = KEYVALUE + 1 WHERE KEYNAME = ' + QuotedStr('GEN_CUSTOMER_ID');
OrdersDB.UniQuery1.SQL.Text := SQL;
OrdersDB.UniQuery1.ExecSQL;
// Retrieve updated RevisionID
SQL := 'SELECT KEYVALUE FROM idfield WHERE KEYNAME = ' + QuotedStr('GEN_CUSTOMER_ID');
doQuery(OrdersDB.UniQuery1, SQL);
CustomerID := OrdersDB.UniQuery1.FieldByName('KEYVALUE').AsInteger;
SQL := 'SELECT * FROM customers WHERE QB_LIST_ID = ' + QuotedStr(QB_LIST_ID);
doQuery(OrdersDB.UniQuery1, SQL); doQuery(OrdersDB.UniQuery1, SQL);
try if ordersDB.UniQuery1.IsEmpty then
if OrdersDB.UniQuery1.IsEmpty then unique := true
begin else
OrdersDB.UniQuery1.Insert; unique := false;
for Pair in JSONData do
begin
Field := OrdersDB.UniQuery1.FindField(Pair.JsonString.Value);
if Assigned(Field) then
begin
if Field is TDateTimeField then
begin
if (Pair.JsonValue.Value = '') or (Pair.JsonValue.Value = 'null') or (Pair.JsonValue.Value = '12/30/1899') then
Field.Clear
else
TDateTimeField(Field).AsDateTime := StrToDate(Pair.JsonValue.Value, DateFormat);
end
else if Pair.JsonValue.Value <> '' then
Field.AsString := Pair.JsonValue.Value;
end;
end;
OrdersDB.UniQuery1.FieldByName('CUSTOMER_ID').AsInteger := CustomerID;
OrdersDB.UniQuery1.FieldByName('QB_TYPE').AsString := JSONData.GetValue<string>('RepUser');
JSONData.AddPair('customer_id', TJSONNumber.Create(CustomerID));
OrdersDB.UniQuery1.Post;
msg := 'Success: Customer Successfully Added'; if unique then
begin
// Update RevisionID
QB_LIST_ID := JSONData.GetValue<string>('QB_LIST_ID');
SQL := 'UPDATE idfield SET KEYVALUE = KEYVALUE + 1 WHERE KEYNAME = ' + QuotedStr('GEN_CUSTOMER_ID');
OrdersDB.UniQuery1.SQL.Text := SQL;
OrdersDB.UniQuery1.ExecSQL;
Result := TJSONObject.Create; // Retrieve updated RevisionID
Result.AddPair('status', msg); SQL := 'SELECT KEYVALUE FROM idfield WHERE KEYNAME = ' + QuotedStr('GEN_CUSTOMER_ID');
Result.AddPair('CustomerID', CustomerID); doQuery(OrdersDB.UniQuery1, SQL);
TXDataOperationContext.Current.Handler.ManagedObjects.Add(Result); CustomerID := OrdersDB.UniQuery1.FieldByName('KEYVALUE').AsInteger;
// Add Shipping Information SQL := 'SELECT * FROM customers WHERE QB_LIST_ID = ' + QuotedStr(QB_LIST_ID);
doQuery(OrdersDB.UniQuery1, SQL);
if JSONData.GetValue<string>('ship_block') <> '' then try
if OrdersDB.UniQuery1.IsEmpty then
begin begin
SQL := 'SELECT * FROM customers_ship WHERE customer_id = 0 AND customer_id <> 0';
doQuery(OrdersDB.UniQuery1, SQL);
OrdersDB.UniQuery1.Insert; OrdersDB.UniQuery1.Insert;
for Pair in JSONData do for Pair in JSONData do
...@@ -3861,27 +3902,71 @@ begin ...@@ -3861,27 +3902,71 @@ begin
Field.AsString := Pair.JsonValue.Value; Field.AsString := Pair.JsonValue.Value;
end; end;
end; end;
OrdersDB.UniQuery1.FieldByName('address').AsString := JSONData.GetValue<string>('shipping_address');
OrdersDB.UniQuery1.FieldByName('CUSTOMER_ID').AsInteger := CustomerID;
OrdersDB.UniQuery1.FieldByName('QB_TYPE').AsString := JSONData.GetValue<string>('RepUser');
JSONData.AddPair('customer_id', TJSONNumber.Create(CustomerID));
OrdersDB.UniQuery1.Post; OrdersDB.UniQuery1.Post;
end;
end msg := 'Success: Customer Successfully Added';
else
begin Result := TJSONObject.Create;
msg := 'Failure:Customer Already in Database'; Result.AddPair('status', msg);
CustomerID := OrdersDB.UniQuery1.FieldByName('CUSTOMER_ID').AsInteger; Result.AddPair('CustomerID', CustomerID);
Result := TJSONObject.Create; TXDataOperationContext.Current.Handler.ManagedObjects.Add(Result);
Result.AddPair('status', msg);
Result.AddPair('CustomerID', CustomerID); // Add Shipping Information
end;
if JSONData.GetValue<string>('ship_block') <> '' then
begin
SQL := 'SELECT * FROM customers_ship WHERE customer_id = 0 AND customer_id <> 0';
doQuery(OrdersDB.UniQuery1, SQL);
OrdersDB.UniQuery1.Insert;
for Pair in JSONData do
begin
Field := OrdersDB.UniQuery1.FindField(Pair.JsonString.Value);
if Assigned(Field) then
begin
if Field is TDateTimeField then
begin
if (Pair.JsonValue.Value = '') or (Pair.JsonValue.Value = 'null') or (Pair.JsonValue.Value = '12/30/1899') then
Field.Clear
else
TDateTimeField(Field).AsDateTime := StrToDate(Pair.JsonValue.Value, DateFormat);
end
else if Pair.JsonValue.Value <> '' then
Field.AsString := Pair.JsonValue.Value;
end;
end;
OrdersDB.UniQuery1.FieldByName('address').AsString := JSONData.GetValue<string>('shipping_address');
OrdersDB.UniQuery1.Post;
end;
end
else
begin
msg := 'Failure:Customer Already in Database';
CustomerID := OrdersDB.UniQuery1.FieldByName('CUSTOMER_ID').AsInteger;
Result := TJSONObject.Create;
Result.AddPair('status', msg);
Result.AddPair('CustomerID', CustomerID);
end;
except except
on E: Exception do on E: Exception do
begin begin
logger.Log(1, 'Error in Import QBCustomer: ' + E.Message); logger.Log(1, 'Error in Import QBCustomer: ' + E.Message);
Result := TJSONObject.Create; raise EXDataHttpException.Create(500, 'Unable to retrieve QuickBooks Items: A QuickBooks interface error has occurred!');
Result.AddPair('error', 'Error importing QB Customer! A QuickBooks interface error has occured!');
end; end;
end; end;
end
else
begin
Result := TJSONObject.Create;
Result.AddPair('status', 'Failure:Customer ID must be unique');
end;
end; end;
......
...@@ -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;
debugMode: boolean; devMode: 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: xxxxxxxx' )
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;
......
...@@ -50,6 +50,442 @@ object rptOrderCorrugated: TrptOrderCorrugated ...@@ -50,6 +50,442 @@ object rptOrderCorrugated: TrptOrderCorrugated
DataSetOptions = [] DataSetOptions = []
Left = 444 Left = 444
Top = 206 Top = 206
FieldDefs = <
item
FieldName = 'ORDER_ID'
end
item
FieldName = 'COMPANY_ID'
end
item
FieldName = 'USER_ID'
end
item
FieldName = 'ORDER_DATE'
FieldType = fftDateTime
end
item
FieldName = 'START_DATE'
FieldType = fftDateTime
end
item
FieldName = 'END_DATE'
FieldType = fftDateTime
end
item
FieldName = 'ORDER_STATUS'
FieldType = fftString
end
item
FieldName = 'SCHED_JSON'
FieldType = fftString
Size = 4096
end
item
FieldName = 'staff_fields_order_date'
FieldType = fftDateTime
end
item
FieldName = 'staff_fields_proof_date'
FieldType = fftDateTime
end
item
FieldName = 'staff_fields_ship_date'
FieldType = fftDateTime
end
item
FieldName = 'staff_fields_ship_via'
FieldType = fftString
Size = 45
end
item
FieldName = 'staff_fields_price'
FieldType = fftString
end
item
FieldName = 'staff_fields_invoice_to'
FieldType = fftString
Size = 128
end
item
FieldName = 'staff_fields_invoice_attention'
FieldType = fftString
Size = 256
end
item
FieldName = 'staff_fields_ship_to'
FieldType = fftString
Size = 128
end
item
FieldName = 'staff_fields_ship_attention'
FieldType = fftString
Size = 256
end
item
FieldName = 'staff_fields_po_number'
FieldType = fftString
Size = 16
end
item
FieldName = 'staff_fields_job_name'
FieldType = fftString
Size = 45
end
item
FieldName = 'staff_fields_art_due'
FieldType = fftDateTime
end
item
FieldName = 'staff_fields_plate_due'
FieldType = fftDateTime
end
item
FieldName = 'staff_fields_mount_due'
FieldType = fftDateTime
end
item
FieldName = 'plates_job_number'
FieldType = fftString
Size = 16
end
item
FieldName = 'supplied_by_customer_b_w_copy'
FieldType = fftString
end
item
FieldName = 'supplied_by_customer_color_copy'
FieldType = fftString
end
item
FieldName = 'supplied_by_customer_plates'
FieldType = fftString
end
item
FieldName = 'supplied_by_customer_sample_ca'
FieldType = fftString
end
item
FieldName = 'supplied_by_customer_dimension'
FieldType = fftString
Size = 64
end
item
FieldName = 'supplied_by_customer_disk_or_cd'
FieldType = fftString
end
item
FieldName = 'supplied_by_customer_e_mail'
FieldType = fftString
Size = 256
end
item
FieldName = 'supplied_by_customer_ftp'
FieldType = fftString
Size = 256
end
item
FieldName = 'supplied_by_customer_other'
FieldType = fftString
Size = 96
end
item
FieldName = 'supplied_by_customer_existing_'
FieldType = fftString
Size = 16
end
item
FieldName = 'supplied_by_customer_ref_art_p'
FieldType = fftString
Size = 256
end
item
FieldName = 'supplied_by_customer_ref_art_a'
FieldType = fftString
Size = 256
end
item
FieldName = 'cut_die_cutdier'
FieldType = fftString
end
item
FieldName = 'cut_die_cutdieb'
FieldType = fftString
end
item
FieldName = 'cut_die_cutdief'
FieldType = fftString
end
item
FieldName = 'cut_die_cutdierkr'
FieldType = fftString
end
item
FieldName = 'cut_die_cutdiefkr'
FieldType = fftString
end
item
FieldName = 'cut_die_cad_file'
FieldType = fftString
Size = 128
end
item
FieldName = 'cut_die_attached'
FieldType = fftString
end
item
FieldName = 'cut_die_boxpol250'
FieldType = fftString
end
item
FieldName = 'cut_die_boxpol155'
FieldType = fftString
end
item
FieldName = 'cut_die_boxpol125'
FieldType = fftString
end
item
FieldName = 'cut_die_brub'
FieldType = fftString
end
item
FieldName = 'proofing_fax'
FieldType = fftString
Size = 16
end
item
FieldName = 'proofing_fax_attn'
FieldType = fftString
Size = 256
end
item
FieldName = 'proofing_e_mail'
FieldType = fftString
Size = 256
end
item
FieldName = 'proofing_e_mail_attn'
FieldType = fftString
Size = 256
end
item
FieldName = 'proofing_ship_to'
FieldType = fftString
Size = 1024
end
item
FieldName = 'proofing_full_size_panel'
FieldType = fftString
end
item
FieldName = 'proofing_print_card'
FieldType = fftString
end
item
FieldName = 'proofing_wide_format'
FieldType = fftString
end
item
FieldName = 'proofing_pdf_file'
FieldType = fftString
end
item
FieldName = 'proofing_other'
FieldType = fftString
Size = 64
end
item
FieldName = 'proofing_art_approved_as_is'
FieldType = fftString
end
item
FieldName = 'proofing_approved_date'
FieldType = fftDateTime
end
item
FieldName = 'proofing_changes_required'
FieldType = fftString
end
item
FieldName = 'proofing_changes_date'
FieldType = fftDateTime
end
item
FieldName = 'layout_rsc_l'
FieldType = fftString
end
item
FieldName = 'layout_rcs_w'
FieldType = fftString
end
item
FieldName = 'layout_rcs_d'
FieldType = fftString
end
item
FieldName = 'layout_die_cut_no'
FieldType = fftString
Size = 45
end
item
FieldName = 'layout_accross_no'
FieldType = fftString
end
item
FieldName = 'layout_around_no'
FieldType = fftString
end
item
FieldName = 'layout_cad_file'
FieldType = fftString
Size = 45
end
item
FieldName = 'layout_excalibur_die'
FieldType = fftString
end
item
FieldName = 'mounting_loose'
FieldType = fftString
end
item
FieldName = 'mounting_sticky_bak'
FieldType = fftString
end
item
FieldName = 'mounting_full_mount'
FieldType = fftString
end
item
FieldName = 'mounting_strip_mount'
FieldType = fftString
end
item
FieldName = 'colors_cylinder_size'
FieldType = fftString
Size = 45
end
item
FieldName = 'colors_machine_ident'
FieldType = fftString
Size = 45
end
item
FieldName = 'mounting_standard_setup'
FieldType = fftString
Size = 45
end
item
FieldName = 'mounting_custom_backing'
FieldType = fftString
Size = 96
end
item
FieldName = 'mounting_custom_adhesive'
FieldType = fftString
Size = 45
end
item
FieldName = 'colors_cross_hairs'
FieldType = fftString
end
item
FieldName = 'colors_clemson'
FieldType = fftString
end
item
FieldName = 'plates_thickness'
FieldType = fftString
end
item
FieldName = 'plates_plate_material'
FieldType = fftString
Size = 16
end
item
FieldName = 'general_special_instructions'
FieldType = fftString
Size = 2048
end
item
FieldName = 'colors_colors'
FieldType = fftString
Size = 4096
end
item
FieldName = 'staff_fields_quickbooks_item'
FieldType = fftString
Size = 45
end
item
FieldName = 'staff_fields_quantity'
FieldType = fftString
end
item
FieldName = 'layout_rsc_style'
FieldType = fftString
Size = 32
end
item
FieldName = 'staff_fields_art_location'
FieldType = fftString
Size = 16
end
item
FieldName = 'ORDER_ID_1'
end
item
FieldName = 'COMPANY_ID_1'
end
item
FieldName = 'ORDER_TYPE'
FieldType = fftString
Size = 45
end
item
FieldName = 'ORDER_DATE_1'
FieldType = fftDateTime
end
item
FieldName = 'PRICE'
end
item
FieldName = 'JOB_NAME'
FieldType = fftString
Size = 128
end
item
FieldName = 'USER_ID_1'
end
item
FieldName = 'LOCATION'
FieldType = fftString
Size = 16
end
item
FieldName = 'IN_QB'
FieldType = fftString
end
item
FieldName = 'QB_ORDER_NUM'
FieldType = fftString
Size = 30
end
item
FieldName = 'QB_ESTIMATE_ID'
FieldType = fftString
Size = 30
end
item
FieldName = 'QB_ORDER_USER'
FieldType = fftString
Size = 60
end
item
FieldName = 'QB_CREATE_DATE'
FieldType = fftDateTime
end>
end end
object frxOrderCorrugated: TfrxReport object frxOrderCorrugated: TfrxReport
Version = '2026.1.7' Version = '2026.1.7'
......
...@@ -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
...@@ -156,15 +156,15 @@ var ...@@ -156,15 +156,15 @@ var
colorArray: TJSONArray; colorArray: TJSONArray;
colorsObject, colorObject: TJSONObject; colorsObject, colorObject: TJSONObject;
colorsString: string; colorsString: string;
i: Integer; i, maxColors: Integer;
begin begin
logger.Log( 5, 'TrptOrderCorrugated.PopulateColorTable' ); logger.Log( 5, 'TrptOrderCorrugated.PopulateColorTable' );
maxColors := 13;
colorsString := uqOrderCorrugated.FieldByName('colors_colors').AsString; colorsString := uqOrderCorrugated.FieldByName('colors_colors').AsString;
colorsObject := TJSONObject.ParseJSONValue(colorsString) as TJSONObject; colorsObject := TJSONObject.ParseJSONValue(colorsString) as TJSONObject;
colorArray := TJSONArray(colorsObject.GetValue<TJSONArray>('items')); colorArray := TJSONArray(colorsObject.GetValue<TJSONArray>('items'));
for i := 0 to colorArray.Count - 1 do for i := 0 to maxColors - 1 do
begin begin
row := frxOrderCorrugated.FindObject('ColorRow' + IntToStr(i + 1)) as TfrxCustomTableRow; row := frxOrderCorrugated.FindObject('ColorRow' + IntToStr(i + 1)) as TfrxCustomTableRow;
colorObject := colorArray.Items[i] as TJSONObject; colorObject := colorArray.Items[i] as TJSONObject;
......
...@@ -50,6 +50,134 @@ object rptOrderCutting: TrptOrderCutting ...@@ -50,6 +50,134 @@ object rptOrderCutting: TrptOrderCutting
DataSetOptions = [] DataSetOptions = []
Left = 444 Left = 444
Top = 206 Top = 206
FieldDefs = <
item
FieldName = 'ORDER_ID'
end
item
FieldName = 'COMPANY_ID'
end
item
FieldName = 'USER_ID'
end
item
FieldName = 'ORDER_DATE'
FieldType = fftDateTime
end
item
FieldName = 'staff_fields_order_date'
FieldType = fftDateTime
end
item
FieldName = 'staff_fields_proof_date'
FieldType = fftDateTime
end
item
FieldName = 'staff_fields_ship_date'
FieldType = fftDateTime
end
item
FieldName = 'staff_fields_ship_via'
FieldType = fftString
Size = 45
end
item
FieldName = 'staff_fields_quantity'
FieldType = fftString
end
item
FieldName = 'staff_fields_price'
FieldType = fftString
end
item
FieldName = 'staff_fields_invoice_to'
FieldType = fftString
Size = 128
end
item
FieldName = 'staff_fields_ship_to'
FieldType = fftString
Size = 128
end
item
FieldName = 'staff_fields_po_number'
FieldType = fftString
Size = 16
end
item
FieldName = 'staff_fields_job_name'
FieldType = fftString
Size = 45
end
item
FieldName = 'staff_fields_quickbooks_item'
FieldType = fftString
Size = 45
end
item
FieldName = 'general_special_instructions'
FieldType = fftString
Size = 2048
end
item
FieldName = 'ORDER_STATUS'
FieldType = fftString
Size = 50
end
item
FieldName = 'ORDER_ID_1'
end
item
FieldName = 'COMPANY_ID_1'
end
item
FieldName = 'ORDER_TYPE'
FieldType = fftString
Size = 45
end
item
FieldName = 'ORDER_DATE_1'
FieldType = fftDateTime
end
item
FieldName = 'PRICE'
end
item
FieldName = 'JOB_NAME'
FieldType = fftString
Size = 128
end
item
FieldName = 'USER_ID_1'
end
item
FieldName = 'LOCATION'
FieldType = fftString
Size = 16
end
item
FieldName = 'IN_QB'
FieldType = fftString
end
item
FieldName = 'QB_ORDER_NUM'
FieldType = fftString
Size = 30
end
item
FieldName = 'QB_ESTIMATE_ID'
FieldType = fftString
Size = 30
end
item
FieldName = 'QB_ORDER_USER'
FieldType = fftString
Size = 60
end
item
FieldName = 'QB_CREATE_DATE'
FieldType = fftDateTime
end>
end end
object frxOrderCutting: TfrxReport object frxOrderCutting: TfrxReport
Version = '2026.1.7' Version = '2026.1.7'
...@@ -62,7 +190,7 @@ object rptOrderCutting: TrptOrderCutting ...@@ -62,7 +190,7 @@ object rptOrderCutting: TrptOrderCutting
PrintOptions.Printer = 'Default' PrintOptions.Printer = 'Default'
PrintOptions.PrintOnSheet = 0 PrintOptions.PrintOnSheet = 0
ReportOptions.CreateDate = 45691.397221759300000000 ReportOptions.CreateDate = 45691.397221759300000000
ReportOptions.LastChange = 45707.397776377300000000 ReportOptions.LastChange = 46143.643605335640000000
ScriptLanguage = 'PascalScript' ScriptLanguage = 'PascalScript'
ScriptText.Strings = ( ScriptText.Strings = (
'begin' 'begin'
...@@ -580,7 +708,7 @@ object rptOrderCutting: TrptOrderCutting ...@@ -580,7 +708,7 @@ object rptOrderCutting: TrptOrderCutting
end end
object SpecialInstructions: TfrxTableObject object SpecialInstructions: TfrxTableObject
AllowVectorExport = True AllowVectorExport = True
Left = 11.918845190000000000 Left = 8.139315190000000000
Top = 238.110390390000000000 Top = 238.110390390000000000
object TableColumn61: TfrxTableColumn object TableColumn61: TfrxTableColumn
Width = 723.779527559055000000 Width = 723.779527559055000000
...@@ -618,7 +746,7 @@ object rptOrderCutting: TrptOrderCutting ...@@ -618,7 +746,7 @@ object rptOrderCutting: TrptOrderCutting
DataSetName = 'frxDBOrderCutting' DataSetName = 'frxDBOrderCutting'
Font.Charset = DEFAULT_CHARSET Font.Charset = DEFAULT_CHARSET
Font.Color = clBlack Font.Color = clBlack
Font.Height = -11 Font.Height = -12
Font.Name = 'Arial' Font.Name = 'Arial'
Font.Style = [] Font.Style = []
Frame.Typ = [ftLeft, ftRight, ftTop, ftBottom] Frame.Typ = [ftLeft, ftRight, ftTop, ftBottom]
......
...@@ -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
......
...@@ -401,11 +401,10 @@ object rptOrderList: TrptOrderList ...@@ -401,11 +401,10 @@ object rptOrderList: TrptOrderList
Left = 941.480349130000000000 Left = 941.480349130000000000
Top = 7.559060000000000000 Top = 7.559060000000000000
Width = 45.354330710000000000 Width = 45.354330710000000000
Height = 30.236220472440900000 Height = 30.236220470000000000
StretchMode = smActualHeight StretchMode = smActualHeight
ContentScaleOptions.Constraints.MaxIterationValue = 0 ContentScaleOptions.Constraints.MaxIterationValue = 0
ContentScaleOptions.Constraints.MinIterationValue = 0 ContentScaleOptions.Constraints.MinIterationValue = 0
DataField = 'QB_REF_NUM'
DataSet = frxDBOrders DataSet = frxDBOrders
DataSetName = 'frxDBOrders' DataSetName = 'frxDBOrders'
Font.Charset = DEFAULT_CHARSET Font.Charset = DEFAULT_CHARSET
...@@ -415,7 +414,7 @@ object rptOrderList: TrptOrderList ...@@ -415,7 +414,7 @@ object rptOrderList: TrptOrderList
Font.Style = [] Font.Style = []
Frame.Typ = [] Frame.Typ = []
Memo.UTF8W = ( Memo.UTF8W = (
'[frxDBOrders."QB_REF_NUM"]') '[frxDBOrders."QB_ORDER_NUM"]')
ParentFont = False ParentFont = False
end end
object Memo56: TfrxMemoView object Memo56: TfrxMemoView
...@@ -1217,11 +1216,6 @@ object rptOrderList: TrptOrderList ...@@ -1217,11 +1216,6 @@ object rptOrderList: TrptOrderList
FieldName = 'PRICE' FieldName = 'PRICE'
Required = True Required = True
end end
object uqOrdersQB_REF_NUM: TStringField
FieldName = 'QB_REF_NUM'
ReadOnly = True
Size = 24
end
object uqOrdersCOLORS: TStringField object uqOrdersCOLORS: TStringField
FieldKind = fkCalculated FieldKind = fkCalculated
FieldName = 'COLORS' FieldName = 'COLORS'
...@@ -1271,6 +1265,10 @@ object rptOrderList: TrptOrderList ...@@ -1271,6 +1265,10 @@ object rptOrderList: TrptOrderList
object uqOrdersORDER_DATE: TDateField object uqOrdersORDER_DATE: TDateField
FieldName = 'ORDER_DATE' FieldName = 'ORDER_DATE'
end end
object uqOrdersQB_ORDER_NUM: TStringField
FieldName = 'QB_ORDER_NUM'
Size = 50
end
end end
object frxDBOrders: TfrxDBDataset object frxDBOrders: TfrxDBDataset
UserName = 'frxDBOrders' UserName = 'frxDBOrders'
...@@ -1280,6 +1278,126 @@ object rptOrderList: TrptOrderList ...@@ -1280,6 +1278,126 @@ object rptOrderList: TrptOrderList
DataSetOptions = [] DataSetOptions = []
Left = 444 Left = 444
Top = 232 Top = 232
FieldDefs = <
item
FieldName = 'ORDER_ID'
end
item
FieldName = 'Loc'
FieldType = fftString
Size = 16
end
item
FieldName = 'COMPANY_NAME'
FieldType = fftString
Size = 90
end
item
FieldName = 'JOB_NAME'
FieldType = fftString
Size = 128
end
item
FieldName = 'ORDER_TYPE'
FieldType = fftString
Size = 45
end
item
FieldName = 'PROOF_DUE'
FieldType = fftDateTime
end
item
FieldName = 'PROOF_DONE'
FieldType = fftDateTime
end
item
FieldName = 'ART_DUE'
FieldType = fftDateTime
end
item
FieldName = 'ART_DONE'
FieldType = fftDateTime
end
item
FieldName = 'PLATE_DUE'
FieldType = fftDateTime
end
item
FieldName = 'PLATE_DONE'
FieldType = fftDateTime
end
item
FieldName = 'MOUNT_DUE'
FieldType = fftDateTime
end
item
FieldName = 'MOUNT_DONE'
FieldType = fftDateTime
end
item
FieldName = 'SHIP_DUE'
FieldType = fftDateTime
end
item
FieldName = 'SHIP_DONE'
FieldType = fftDateTime
end
item
FieldName = 'PRICE'
end
item
FieldName = 'COLORS'
FieldType = fftString
end
item
FieldName = 'po_number'
FieldType = fftString
Size = 16
end
item
FieldName = 'quickbooks_item'
FieldType = fftString
Size = 45
end
item
FieldName = 'NEW_ORDER_DATE'
FieldType = fftString
Size = 20
end
item
FieldName = 'NEW_PROOF_DONE'
FieldType = fftString
Size = 20
end
item
FieldName = 'NEW_ART_DONE'
FieldType = fftString
Size = 20
end
item
FieldName = 'NEW_PLATE_DONE'
FieldType = fftString
Size = 20
end
item
FieldName = 'NEW_MOUNT_DONE'
FieldType = fftString
Size = 20
end
item
FieldName = 'NEW_SHIP_DONE'
FieldType = fftString
Size = 20
end
item
FieldName = 'ORDER_DATE'
FieldType = fftDateTime
end
item
FieldName = 'QB_ORDER_NUM'
FieldType = fftString
Size = 50
end>
end end
object uqColors: TUniQuery object uqColors: TUniQuery
Connection = ucKG Connection = ucKG
......
...@@ -30,7 +30,6 @@ type ...@@ -30,7 +30,6 @@ type
uqOrdersSHIP_DUE: TDateField; uqOrdersSHIP_DUE: TDateField;
uqOrdersSHIP_DONE: TDateTimeField; uqOrdersSHIP_DONE: TDateTimeField;
uqOrdersPRICE: TFloatField; uqOrdersPRICE: TFloatField;
uqOrdersQB_REF_NUM: TStringField;
uqOrdersCOLORS: TStringField; uqOrdersCOLORS: TStringField;
uqColors: TUniQuery; uqColors: TUniQuery;
uqOrderspo_number: TStringField; uqOrderspo_number: TStringField;
...@@ -42,6 +41,7 @@ type ...@@ -42,6 +41,7 @@ type
uqOrdersNEW_MOUNT_DONE: TStringField; uqOrdersNEW_MOUNT_DONE: TStringField;
uqOrdersNEW_SHIP_DONE: TStringField; uqOrdersNEW_SHIP_DONE: TStringField;
uqOrdersORDER_DATE: TDateField; uqOrdersORDER_DATE: TDateField;
uqOrdersQB_ORDER_NUM: TStringField;
procedure DataModuleCreate(Sender: TObject); procedure DataModuleCreate(Sender: TObject);
procedure uqOrdersCalcFields(DataSet: TDataSet); procedure uqOrdersCalcFields(DataSet: TDataSet);
...@@ -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
......
...@@ -4,14 +4,9 @@ object rptOrderWeb: TrptOrderWeb ...@@ -4,14 +4,9 @@ object rptOrderWeb: TrptOrderWeb
Width = 640 Width = 640
object ucKG: TUniConnection object ucKG: TUniConnection
ProviderName = 'MySQL' ProviderName = 'MySQL'
Database = 'kg_order_entry'
Username = 'root'
Server = '192.168.159.10'
Connected = True
LoginPrompt = False LoginPrompt = False
Left = 289 Left = 289
Top = 119 Top = 119
EncryptedPassword = '9AFF92FF8CFF86FF8CFFCFFFCEFF'
end end
object frxPDFExport1: TfrxPDFExport object frxPDFExport1: TfrxPDFExport
UseFileCache = True UseFileCache = True
...@@ -49,6 +44,442 @@ object rptOrderWeb: TrptOrderWeb ...@@ -49,6 +44,442 @@ object rptOrderWeb: TrptOrderWeb
DataSetOptions = [] DataSetOptions = []
Left = 444 Left = 444
Top = 206 Top = 206
FieldDefs = <
item
FieldName = 'ORDER_ID'
end
item
FieldName = 'COMPANY_ID'
end
item
FieldName = 'USER_ID'
end
item
FieldName = 'ORDER_DATE'
FieldType = fftDateTime
end
item
FieldName = 'START_DATE'
FieldType = fftDateTime
end
item
FieldName = 'END_DATE'
FieldType = fftDateTime
end
item
FieldName = 'ORDER_STATUS'
FieldType = fftString
end
item
FieldName = 'SCHED_JSON'
FieldType = fftString
Size = 4096
end
item
FieldName = 'staff_fields_order_date'
FieldType = fftDateTime
end
item
FieldName = 'staff_fields_proof_date'
FieldType = fftDateTime
end
item
FieldName = 'staff_fields_ship_date'
FieldType = fftDateTime
end
item
FieldName = 'staff_fields_ship_via'
FieldType = fftString
Size = 45
end
item
FieldName = 'staff_fields_price'
FieldType = fftString
end
item
FieldName = 'staff_fields_invoice_to'
FieldType = fftString
Size = 128
end
item
FieldName = 'staff_fields_invoice_attention'
FieldType = fftString
Size = 256
end
item
FieldName = 'staff_fields_ship_to'
FieldType = fftString
Size = 128
end
item
FieldName = 'staff_fields_ship_attention'
FieldType = fftString
Size = 256
end
item
FieldName = 'staff_fields_po_number'
FieldType = fftString
Size = 16
end
item
FieldName = 'staff_fields_job_name'
FieldType = fftString
Size = 45
end
item
FieldName = 'staff_fields_art_due'
FieldType = fftDateTime
end
item
FieldName = 'staff_fields_plate_due'
FieldType = fftDateTime
end
item
FieldName = 'plates_job_number'
FieldType = fftString
Size = 16
end
item
FieldName = 'supplied_by_customer_b_w_or_co'
FieldType = fftString
end
item
FieldName = 'supplied_by_customer_plates'
FieldType = fftString
end
item
FieldName = 'supplied_by_customer_sample'
FieldType = fftString
Size = 45
end
item
FieldName = 'supplied_by_customer_dimension'
FieldType = fftString
end
item
FieldName = 'supplied_by_customer_other'
FieldType = fftString
Size = 45
end
item
FieldName = 'supplied_by_customer_disk'
FieldType = fftString
end
item
FieldName = 'supplied_by_customer_e_mail'
FieldType = fftString
Size = 128
end
item
FieldName = 'supplied_by_customer_ftp'
FieldType = fftString
Size = 128
end
item
FieldName = 'plates_plate_material'
FieldType = fftString
Size = 16
end
item
FieldName = 'plates_thickness'
FieldType = fftString
end
item
FieldName = 'supplied_by_customer_total_inc'
FieldType = fftString
Size = 32
end
item
FieldName = 'supplied_by_customer_sheets_us'
FieldType = fftString
Size = 32
end
item
FieldName = 'supplied_by_customer_initials'
FieldType = fftString
Size = 16
end
item
FieldName = 'proofing_pdf'
FieldType = fftString
end
item
FieldName = 'proofing_pdf_to'
FieldType = fftString
Size = 256
end
item
FieldName = 'proofing_pdf_date_1'
FieldType = fftDateTime
end
item
FieldName = 'proofing_pdf_date_2'
FieldType = fftDateTime
end
item
FieldName = 'proofing_pdf_date_3'
FieldType = fftDateTime
end
item
FieldName = 'proofing_full_size_ink_jet_for'
FieldType = fftString
end
item
FieldName = 'proofing_ink_jet_to'
FieldType = fftString
Size = 256
end
item
FieldName = 'proofing_ink_jet_to_2'
FieldType = fftString
Size = 256
end
item
FieldName = 'proofing_ink_jet_date_1'
FieldType = fftDateTime
end
item
FieldName = 'proofing_ink_jet_date_2'
FieldType = fftDateTime
end
item
FieldName = 'proofing_ink_jet_date_3'
FieldType = fftDateTime
end
item
FieldName = 'proofing_color_contract'
FieldType = fftString
Size = 17
end
item
FieldName = 'proofing_color_contrac_to'
FieldType = fftString
Size = 256
end
item
FieldName = 'proofing_color_contrac_date_1'
FieldType = fftDateTime
end
item
FieldName = 'proofing_color_contrac_date_2'
FieldType = fftDateTime
end
item
FieldName = 'proofing_digital_color_key'
FieldType = fftString
end
item
FieldName = 'proofing_digital_color_to'
FieldType = fftString
Size = 256
end
item
FieldName = 'proofing_digital_color_date_1'
FieldType = fftDateTime
end
item
FieldName = 'quantity_and_colors_press_name'
FieldType = fftString
Size = 64
end
item
FieldName = 'quantity_and_colors_anilox_info'
FieldType = fftString
Size = 64
end
item
FieldName = 'plate_marks_microdots'
FieldType = fftString
end
item
FieldName = 'plate_marks_microdots_comments'
FieldType = fftString
Size = 128
end
item
FieldName = 'plate_marks_crosshairs'
FieldType = fftString
end
item
FieldName = 'plate_marks_crosshairs_comments'
FieldType = fftString
Size = 128
end
item
FieldName = 'plate_marks_color_bars'
FieldType = fftString
end
item
FieldName = 'plate_marks_color_bars_comments'
FieldType = fftString
Size = 128
end
item
FieldName = 'plate_marks_other'
FieldType = fftString
Size = 16
end
item
FieldName = 'plate_marks_other_comments'
FieldType = fftString
Size = 128
end
item
FieldName = 'print_orientation_print_orient'
FieldType = fftString
end
item
FieldName = 'layout_around'
FieldType = fftString
end
item
FieldName = 'layout_accross'
FieldType = fftString
end
item
FieldName = 'layout_surface_print'
FieldType = fftString
end
item
FieldName = 'layout_reverse_print'
FieldType = fftString
end
item
FieldName = 'layout_cylinder_repeat'
FieldType = fftString
Size = 16
end
item
FieldName = 'layout_cutoff_dimension'
FieldType = fftString
Size = 16
end
item
FieldName = 'layout_pitch'
FieldType = fftString
Size = 16
end
item
FieldName = 'layout_teeth'
FieldType = fftString
Size = 16
end
item
FieldName = 'layout_bleed'
FieldType = fftString
Size = 16
end
item
FieldName = 'layout_cutback'
FieldType = fftString
Size = 16
end
item
FieldName = 'layout_minimum_trap_dim'
FieldType = fftString
end
item
FieldName = 'layout_maximum_trap_dim'
FieldType = fftString
end
item
FieldName = 'upc_size'
FieldType = fftString
Size = 16
end
item
FieldName = 'upc_bar_width_reduction'
FieldType = fftString
Size = 16
end
item
FieldName = 'quantity_and_colors_qty_colors'
FieldType = fftString
Size = 4096
end
item
FieldName = 'general_comments'
FieldType = fftString
Size = 4096
end
item
FieldName = 'staff_fields_quickbooks_item'
FieldType = fftString
Size = 45
end
item
FieldName = 'staff_fields_quantity'
FieldType = fftString
end
item
FieldName = 'upc_distortion_percent'
FieldType = fftString
Size = 16
end
item
FieldName = 'upc_distortion_amount'
FieldType = fftString
Size = 16
end
item
FieldName = 'staff_fields_art_location'
FieldType = fftString
Size = 16
end
item
FieldName = 'ORDER_ID_1'
end
item
FieldName = 'COMPANY_ID_1'
end
item
FieldName = 'ORDER_TYPE'
FieldType = fftString
Size = 45
end
item
FieldName = 'ORDER_DATE_1'
FieldType = fftDateTime
end
item
FieldName = 'PRICE'
end
item
FieldName = 'JOB_NAME'
FieldType = fftString
Size = 128
end
item
FieldName = 'USER_ID_1'
end
item
FieldName = 'LOCATION'
FieldType = fftString
Size = 16
end
item
FieldName = 'IN_QB'
FieldType = fftString
end
item
FieldName = 'QB_ORDER_NUM'
FieldType = fftString
Size = 30
end
item
FieldName = 'QB_ESTIMATE_ID'
FieldType = fftString
Size = 30
end
item
FieldName = 'QB_ORDER_USER'
FieldType = fftString
Size = 60
end
item
FieldName = 'QB_CREATE_DATE'
FieldType = fftDateTime
end>
end end
object frxOrderWeb: TfrxReport object frxOrderWeb: TfrxReport
Version = '2026.1.7' Version = '2026.1.7'
...@@ -1135,7 +1566,7 @@ object rptOrderWeb: TrptOrderWeb ...@@ -1135,7 +1566,7 @@ object rptOrderWeb: TrptOrderWeb
DataSetName = 'frxDBOrderWeb' DataSetName = 'frxDBOrderWeb'
Font.Charset = DEFAULT_CHARSET Font.Charset = DEFAULT_CHARSET
Font.Color = clBlack Font.Color = clBlack
Font.Height = -12 Font.Height = -9
Font.Name = 'Arial' Font.Name = 'Arial'
Font.Style = [] Font.Style = []
Frame.Typ = [ftLeft, ftRight, ftTop, ftBottom] Frame.Typ = [ftLeft, ftRight, ftTop, ftBottom]
...@@ -4645,7 +5076,6 @@ object rptOrderWeb: TrptOrderWeb ...@@ -4645,7 +5076,6 @@ object rptOrderWeb: TrptOrderWeb
'SELECT * FROM web_plate_orders w JOIN orders o ON w.ORDER_ID = o' + 'SELECT * FROM web_plate_orders w JOIN orders o ON w.ORDER_ID = o' +
'.ORDER_ID WHERE w.ORDER_ID = 1568') '.ORDER_ID WHERE w.ORDER_ID = 1568')
Active = True
Left = 457 Left = 457
Top = 106 Top = 106
object uqOrderWebORDER_ID: TIntegerField object uqOrderWebORDER_ID: TIntegerField
......
...@@ -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
...@@ -155,15 +155,16 @@ var ...@@ -155,15 +155,16 @@ var
colorArray: TJSONArray; colorArray: TJSONArray;
colorsObject, colorObject: TJSONObject; colorsObject, colorObject: TJSONObject;
colorsString: string; colorsString: string;
i: Integer; i, maxColors: Integer;
begin begin
maxColors := 10;
logger.Log( 5, 'TrptOrderWeb.PopulateColorTable' ); logger.Log( 5, 'TrptOrderWeb.PopulateColorTable' );
colorsString := uqOrderWeb.FieldByName('quantity_and_colors_qty_colors').AsString; colorsString := uqOrderWeb.FieldByName('quantity_and_colors_qty_colors').AsString;
colorsObject := TJSONObject.ParseJSONValue(colorsString) as TJSONObject; colorsObject := TJSONObject.ParseJSONValue(colorsString) as TJSONObject;
colorArray := TJSONArray(colorsObject.GetValue<TJSONArray>('items')); colorArray := TJSONArray(colorsObject.GetValue<TJSONArray>('items'));
for i := 0 to colorArray.Count - 1 do for i := 0 to maxColors - 1 do
begin begin
row := frxOrderWeb.FindObject('ColorRow' + IntToStr(i + 1)) as TfrxCustomTableRow; row := frxOrderWeb.FindObject('ColorRow' + IntToStr(i + 1)) as TfrxCustomTableRow;
colorObject := colorArray.Items[i] as TJSONObject; colorObject := colorArray.Items[i] as TJSONObject;
......
...@@ -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);
......
...@@ -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
LogTime := Now; logTime := Now;
FormattedMessage := FormatDateTime('[yyyy-mm-dd HH:nn:ss.zzz]', LogTime); formattedMessage := FormatDateTime('[yyyy-mm-dd HH:nn:ss.zzz]', logTime);
LogMsg := Log.GetMessage; logMsg := Log.GetMessage;
if LogMsg.IsEmpty then if logMsg.IsEmpty then
FormattedMessage := '' formattedMessage := ''
else else
FormattedMessage := FormattedMessage + '[' + IntToStr(logLevel) +'] ' + LogMsg; formattedMessage := formattedMessage + '[' + IntToStr(logLevel) + '] ' + logMsg;
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: integer; Log: ILog); procedure TFileLogAppender.Send(logLevel: Integer; Log: ILog);
var var
formattedMessage: string; logFile: TextFile;
logTime: TDateTime;
logMsg: string; logMsg: string;
txtFile: TextFile; logTime: TDateTime;
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(txtFile); CloseFile(logFile);
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.
...@@ -114,11 +114,11 @@ ...@@ -114,11 +114,11 @@
<VerInfo_Locale>1033</VerInfo_Locale> <VerInfo_Locale>1033</VerInfo_Locale>
<DCC_ExeOutput>.\bin</DCC_ExeOutput> <DCC_ExeOutput>.\bin</DCC_ExeOutput>
<DCC_UnitSearchPath>C:\RADTOOLS\FastMM4;$(DCC_UnitSearchPath)</DCC_UnitSearchPath> <DCC_UnitSearchPath>C:\RADTOOLS\FastMM4;$(DCC_UnitSearchPath)</DCC_UnitSearchPath>
<VerInfo_Keys>CompanyName=EM Systems;FileDescription=$(MSBuildProjectName);FileVersion=0.9.15.1;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=0.9.11;Comments=</VerInfo_Keys> <VerInfo_Keys>CompanyName=EM Systems;FileDescription=$(MSBuildProjectName);FileVersion=0.9.15.4;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=0.9.11;Comments=</VerInfo_Keys>
<VerInfo_MajorVer>0</VerInfo_MajorVer> <VerInfo_MajorVer>0</VerInfo_MajorVer>
<VerInfo_MinorVer>9</VerInfo_MinorVer> <VerInfo_MinorVer>9</VerInfo_MinorVer>
<VerInfo_Release>15</VerInfo_Release> <VerInfo_Release>15</VerInfo_Release>
<VerInfo_Build>1</VerInfo_Build> <VerInfo_Build>4</VerInfo_Build>
</PropertyGroup> </PropertyGroup>
<PropertyGroup Condition="'$(Cfg_1_Win64)'!=''"> <PropertyGroup Condition="'$(Cfg_1_Win64)'!=''">
<AppDPIAwarenessMode>PerMonitorV2</AppDPIAwarenessMode> <AppDPIAwarenessMode>PerMonitorV2</AppDPIAwarenessMode>
...@@ -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>
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment