Skip to content

K
kgOrders
Commit dc71971e by Mac Stephens
Options

Merge remote-tracking branch 'origin/cam'

parents bb24c447 e9209347
Showing with 940 additions and 1610 deletions
kgOrdersClient/AddCustomer.dfm
...@@ -465,7 +465,7 @@ object FViewAddCustomer: TFViewAddCustomer ...@@ -465,7 +465,7 @@ object FViewAddCustomer: TFViewAddCustomer
DataField = 'REP_USER_ID' DataField = 'REP_USER_ID'
DataSource = WebDataSource1 DataSource = WebDataSource1
KeyField = 'userID' KeyField = 'userID'
ListField = 'full_name' ListField = 'representative'
ListSource = wdsUsers ListSource = wdsUsers
end end
object XDataWebClient1: TXDataWebClient object XDataWebClient1: TXDataWebClient
...@@ -579,5 +579,9 @@ object FViewAddCustomer: TFViewAddCustomer ...@@ -579,5 +579,9 @@ object FViewAddCustomer: TFViewAddCustomer
FieldName = 'full_name' FieldName = 'full_name'
Size = 0 Size = 0
end end
object xdwdsUsersrepresentative: TStringField
FieldName = 'representative'
Size = 0
end
end end
end end
kgOrdersClient/AddCustomer.pas
...@@ -79,7 +79,8 @@ type ...@@ -79,7 +79,8 @@ type
XDataWebDataSet1REP_USER_ID: TStringField; XDataWebDataSet1REP_USER_ID: TStringField;
xdwdsUsersfull_name: TStringField; xdwdsUsersfull_name: TStringField;
lblFormState: TWebLabel; lblFormState: TWebLabel;
[async] procedure btnSaveClick(Sender: TObject); [async]
xdwdsUsersrepresentative: TStringField; 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);
...@@ -103,6 +104,7 @@ type ...@@ -103,6 +104,7 @@ type
[async] procedure SendCustomerToServer(); [async] procedure SendCustomerToServer();
[async] procedure SendAddressToServer(); [async] procedure SendAddressToServer();
[async] procedure DelAddress(); [async] procedure DelAddress();
[async] procedure Save();
function VerifyCustomer(): boolean; function VerifyCustomer(): boolean;
function VerifyAddress(): boolean; function VerifyAddress(): boolean;
procedure Clear(); procedure Clear();
...@@ -425,12 +427,17 @@ procedure TFViewAddCustomer.btnSaveClick(Sender: TObject); ...@@ -425,12 +427,17 @@ procedure TFViewAddCustomer.btnSaveClick(Sender: TObject);
begin begin
if VerifyCustomer() then if VerifyCustomer() then
begin begin
await(sendCustomerToServer()); Save();
await(GetCustomer());
ViewMode();
end; end;
end; end;
procedure TFViewAddCustomer.Save;
begin
await(sendCustomerToServer());
await(GetCustomer());
ViewMode();
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
......
kgOrdersClient/View.Customers.pas
...@@ -181,7 +181,10 @@ end; ...@@ -181,7 +181,10 @@ end;
procedure TFViewCustomers.btnAddCustomerClick(Sender: TObject); procedure TFViewCustomers.btnAddCustomerClick(Sender: TObject);
begin begin
ShowSelectCustomerForm(); if AuthService.TokenPayload.Properties['qb_enabled'] then
ShowSelectCustomerForm()
else
ShowToast('QB interface not currently active', 'info');
end; end;
procedure TFViewCustomers.edtFilterChange(Sender: TObject); procedure TFViewCustomers.edtFilterChange(Sender: TObject);
......
kgOrdersClient/View.EditUser.dfm
...@@ -3,8 +3,8 @@ object FViewEditUser: TFViewEditUser ...@@ -3,8 +3,8 @@ object FViewEditUser: TFViewEditUser
Height = 480 Height = 480
OnShow = WebFormCreate OnShow = WebFormCreate
object WebLabel2: TWebLabel object WebLabel2: TWebLabel
Left = 16 Left = 33
Top = 8 Top = 33
Width = 57 Width = 57
Height = 15 Height = 15
Caption = 'Full Name:' Caption = 'Full Name:'
...@@ -14,8 +14,8 @@ object FViewEditUser: TFViewEditUser ...@@ -14,8 +14,8 @@ object FViewEditUser: TFViewEditUser
WidthPercent = 100.000000000000000000 WidthPercent = 100.000000000000000000
end end
object WebLabel3: TWebLabel object WebLabel3: TWebLabel
Left = 14 Left = 283
Top = 37 Top = 8
Width = 53 Width = 53
Height = 15 Height = 15
Caption = 'Password:' Caption = 'Password:'
...@@ -25,7 +25,7 @@ object FViewEditUser: TFViewEditUser ...@@ -25,7 +25,7 @@ object FViewEditUser: TFViewEditUser
WidthPercent = 100.000000000000000000 WidthPercent = 100.000000000000000000
end end
object WebLabel5: TWebLabel object WebLabel5: TWebLabel
Left = 284 Left = 34
Top = 8 Top = 8
Width = 56 Width = 56
Height = 15 Height = 15
...@@ -35,19 +35,8 @@ object FViewEditUser: TFViewEditUser ...@@ -35,19 +35,8 @@ object FViewEditUser: TFViewEditUser
HeightPercent = 100.000000000000000000 HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000 WidthPercent = 100.000000000000000000
end end
object WebLabel6: TWebLabel
Left = 240
Top = 41
Width = 100
Height = 15
Caption = 'Confirm Password:'
Color = clBtnFace
ElementID = 'lblconfirm'
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
end
object WebLabel7: TWebLabel object WebLabel7: TWebLabel
Left = 35 Left = 58
Top = 62 Top = 62
Width = 32 Width = 32
Height = 15 Height = 15
...@@ -58,8 +47,8 @@ object FViewEditUser: TFViewEditUser ...@@ -58,8 +47,8 @@ object FViewEditUser: TFViewEditUser
WidthPercent = 100.000000000000000000 WidthPercent = 100.000000000000000000
end end
object lblactive: TWebLabel object lblactive: TWebLabel
Left = 45 Left = 298
Top = 163 Top = 36
Width = 38 Width = 38
Height = 15 Height = 15
Caption = 'Active?' Caption = 'Active?'
...@@ -79,8 +68,8 @@ object FViewEditUser: TFViewEditUser ...@@ -79,8 +68,8 @@ object FViewEditUser: TFViewEditUser
WidthPercent = 100.000000000000000000 WidthPercent = 100.000000000000000000
end end
object lblAccess: TWebLabel object lblAccess: TWebLabel
Left = 272 Left = 269
Top = 96 Top = 93
Width = 67 Width = 67
Height = 15 Height = 15
Caption = 'Access Type:' Caption = 'Access Type:'
...@@ -99,17 +88,6 @@ object FViewEditUser: TFViewEditUser ...@@ -99,17 +88,6 @@ object FViewEditUser: TFViewEditUser
HeightPercent = 100.000000000000000000 HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000 WidthPercent = 100.000000000000000000
end end
object edtConfirmPassword: TWebEdit
Left = 348
Top = 34
Width = 121
Height = 22
ChildOrder = 7
ElementID = 'edtconfirmpassword'
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
OnChange = edtConfirmPasswordChange
end
object edtEmail: TWebEdit object edtEmail: TWebEdit
Left = 96 Left = 96
Top = 62 Top = 62
...@@ -129,14 +107,13 @@ object FViewEditUser: TFViewEditUser ...@@ -129,14 +107,13 @@ object FViewEditUser: TFViewEditUser
ElementID = 'edtpassword' ElementID = 'edtpassword'
HeightPercent = 100.000000000000000000 HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000 WidthPercent = 100.000000000000000000
OnChange = edtPasswordChange
end end
object btnConfirm: TWebButton object btnConfirm: TWebButton
Left = 96 Left = 96
Top = 200 Top = 200
Width = 96 Width = 96
Height = 25 Height = 25
Caption = 'Confirm' Caption = 'Save'
ChildOrder = 9 ChildOrder = 9
ElementClassName = 'btn btn-light' ElementClassName = 'btn btn-light'
ElementID = 'btnconfirm' ElementID = 'btnconfirm'
...@@ -151,8 +128,8 @@ object FViewEditUser: TFViewEditUser ...@@ -151,8 +128,8 @@ object FViewEditUser: TFViewEditUser
OnClick = btnConfirmClick OnClick = btnConfirmClick
end end
object edtFullname: TWebEdit object edtFullname: TWebEdit
Left = 96 Left = 346
Top = 4 Top = 5
Width = 121 Width = 121
Height = 22 Height = 22
ChildOrder = 14 ChildOrder = 14
...@@ -161,8 +138,8 @@ object FViewEditUser: TFViewEditUser ...@@ -161,8 +138,8 @@ object FViewEditUser: TFViewEditUser
WidthPercent = 100.000000000000000000 WidthPercent = 100.000000000000000000
end end
object edtUsername: TWebEdit object edtUsername: TWebEdit
Left = 346 Left = 96
Top = 4 Top = 6
Width = 121 Width = 121
Height = 22 Height = 22
ChildOrder = 14 ChildOrder = 14
...@@ -190,8 +167,8 @@ object FViewEditUser: TFViewEditUser ...@@ -190,8 +167,8 @@ object FViewEditUser: TFViewEditUser
OnClick = btnCancelClick OnClick = btnCancelClick
end end
object cbStatus: TWebCheckBox object cbStatus: TWebCheckBox
Left = 96 Left = 346
Top = 162 Top = 33
Width = 107 Width = 107
Height = 20 Height = 20
Caption = 'Active?' Caption = 'Active?'
...@@ -217,7 +194,7 @@ object FViewEditUser: TFViewEditUser ...@@ -217,7 +194,7 @@ object FViewEditUser: TFViewEditUser
WidthPercent = 100.000000000000000000 WidthPercent = 100.000000000000000000
end end
object cbAccess: TWebComboBox object cbAccess: TWebComboBox
Left = 352 Left = 346
Top = 90 Top = 90
Width = 145 Width = 145
Height = 23 Height = 23
...@@ -226,12 +203,9 @@ object FViewEditUser: TFViewEditUser ...@@ -226,12 +203,9 @@ object FViewEditUser: TFViewEditUser
WidthPercent = 100.000000000000000000 WidthPercent = 100.000000000000000000
ItemIndex = -1 ItemIndex = -1
Items.Strings = ( Items.Strings = (
'PLATE' 'SALES'
'MOUNT' 'USER'
'SHIP' 'ADMIN')
'ART'
'ALL'
'ACTIVE')
end end
object edtQB: TWebEdit object edtQB: TWebEdit
Left = 346 Left = 346
...@@ -245,14 +219,14 @@ object FViewEditUser: TFViewEditUser ...@@ -245,14 +219,14 @@ object FViewEditUser: TFViewEditUser
end end
object XDataWebClient1: TXDataWebClient object XDataWebClient1: TXDataWebClient
Connection = DMConnection.ApiConnection Connection = DMConnection.ApiConnection
Left = 556 Left = 514
Top = 416 Top = 304
end end
object WebTimer1: TWebTimer object WebTimer1: TWebTimer
Enabled = False Enabled = False
Interval = 500 Interval = 500
OnTimer = WebTimer1Timer OnTimer = WebTimer1Timer
Left = 430 Left = 428
Top = 382 Top = 304
end end
end end
kgOrdersClient/View.EditUser.html
...@@ -6,12 +6,6 @@ ...@@ -6,12 +6,6 @@
<form id="edituserform" class="row g-3 needs-validation" novalidate> <form id="edituserform" class="row g-3 needs-validation" novalidate>
<div class="col-md-6"> <div class="col-md-6">
<label id="lblfullname" for="edtfullname" class="form-label">Full&nbsp;Name</label>
<input id="edtfullname" class="form-control" required>
<div class="invalid-feedback">Full Name is required.</div>
</div>
<div class="col-md-6">
<label id="lblusername" for="edtusername" class="form-label">Username</label> <label id="lblusername" for="edtusername" class="form-label">Username</label>
<input id="edtusername" class="form-control" required> <input id="edtusername" class="form-control" required>
<div class="invalid-feedback">Username is required.</div> <div class="invalid-feedback">Username is required.</div>
...@@ -20,19 +14,26 @@ ...@@ -20,19 +14,26 @@
<div class="col-md-6"> <div class="col-md-6">
<label id="lblpassword" for="edtpassword" class="form-label">Password</label> <label id="lblpassword" for="edtpassword" class="form-label">Password</label>
<input id="edtpassword" type="password" class="form-control" required> <input id="edtpassword" type="password" class="form-control" required>
<div class="invalid-feedback">Passwords must match.</div> <div class="invalid-feedback">Passwords is required.</div>
</div>
<div class="col-md-6">
<label id="lblfullname" for="edtfullname" class="form-label">Full&nbsp;Name</label>
<input id="edtfullname" class="form-control" required>
<div class="invalid-feedback">Full Name is required.</div>
</div> </div>
<div class="col-md-6"> <div class="col-md-6">
<label id="lblconfirm" for="edtconfirmpassword" class="form-label">Confirm&nbsp;Password</label> <label id="lblactive" for="cbstatus" class="form-label">Active</label>
<input id="edtconfirmpassword" type="password" class="form-control" required disabled> <div class="form-check mt-1">
<div class="invalid-feedback">Passwords must match.</div> <input id="cbstatus" class="form-check-input" type="checkbox" style="width: 1.5em; height: 1.5em;">
</div>
</div> </div>
<div class="col-md-6"> <div class="col-md-6">
<label id="lblemail" for="edtemail" class="form-label">Email&nbsp;Address</label> <label id="lblemail" for="edtemail" class="form-label">Email&nbsp;Address</label>
<input id="edtemail" type="email" class="form-control" required> <input id="edtemail" type="email" class="form-control">
<div class="invalid-feedback">Valid email is required.</div>
</div> </div>
<div class="col-md-6"> <div class="col-md-6">
...@@ -47,19 +48,8 @@ ...@@ -47,19 +48,8 @@
<div class="col-md-6"> <div class="col-md-6">
<label id="lblaccess" for="cbaccess" class="form-label">Access&nbsp;Type</label> <label id="lblaccess" for="cbaccess" class="form-label">Access&nbsp;Type</label>
<select id="cbaccess" class="form-select" required> <select id="cbaccess" class="form-select">
<option selected disabled value="">Choose...</option>
<option value="ALL">All</option>
<option value="LIMITED">Limited</option>
</select> </select>
<div class="invalid-feedback">Please select an access type.</div>
</div>
<div class="col-md-6">
<div class="form-check pt-2">
<input id="cbstatus" class="form-check-input" type="checkbox">
<label id="lblactive" for="cbstatus" class="form-check-label">Active</label>
</div>
</div> </div>
<div class="d-flex gap-2 mt-4"> <div class="d-flex gap-2 mt-4">
......
kgOrdersClient/View.EditUser.pas
...@@ -15,9 +15,7 @@ type ...@@ -15,9 +15,7 @@ type
WebLabel2: TWebLabel; WebLabel2: TWebLabel;
WebLabel3: TWebLabel; WebLabel3: TWebLabel;
WebLabel5: TWebLabel; WebLabel5: TWebLabel;
WebLabel6: TWebLabel;
WebLabel7: TWebLabel; WebLabel7: TWebLabel;
edtConfirmPassword: TWebEdit;
edtEmail: TWebEdit; edtEmail: TWebEdit;
edtPassword: TWebEdit; edtPassword: TWebEdit;
btnConfirm: TWebButton; btnConfirm: TWebButton;
...@@ -38,8 +36,6 @@ type ...@@ -38,8 +36,6 @@ type
procedure btnConfirmClick(Sender: TObject); procedure btnConfirmClick(Sender: TObject);
procedure btnCancelClick(Sender: TObject); procedure btnCancelClick(Sender: TObject);
procedure WebTimer1Timer(Sender: TObject); procedure WebTimer1Timer(Sender: TObject);
procedure edtPasswordChange(Sender: TObject);
procedure edtConfirmPasswordChange(Sender: TObject);
private private
{ Private declarations } { Private declarations }
FMessage: string; FMessage: string;
...@@ -51,16 +47,14 @@ type ...@@ -51,16 +47,14 @@ type
Email: string; Email: string;
Access: string; Access: string;
Rights: string; Rights: string;
Perspective: string;
QB: string; QB: string;
[async] procedure EditUser(); [async] procedure EditUser();
[async] function AddUser(): string; [async] function AddUser(): string;
procedure ValidatePasswords;
public public
{ Public declarations } { Public declarations }
Info: string; Info: string;
class function CreateForm(AElementID, Mode, Username, Password, Name, Status, Email, class function CreateForm(AElementID, Mode, Username, Password, Name, Status, Email,
Access, Rights, Perspective, QB: string): TWebForm; Access, Rights, QB: string): TWebForm;
end; end;
var var
...@@ -139,18 +133,8 @@ begin ...@@ -139,18 +133,8 @@ begin
end; end;
procedure TFViewEditUser.edtConfirmPasswordChange(Sender: TObject);
begin
ValidatePasswords;
end;
procedure TFViewEditUser.edtPasswordChange(Sender: TObject);
begin
ValidatePasswords;
end;
class function TFViewEditUser.CreateForm(AElementID, Mode, Username, Password, Name, Status, Email, class function TFViewEditUser.CreateForm(AElementID, Mode, Username, Password, Name, Status, Email,
Access, Rights, Perspective, QB: string): TWebForm; Access, Rights, QB: string): TWebForm;
// Autofills known information about a user on create // Autofills known information about a user on create
procedure AfterCreate(AForm: TObject); procedure AfterCreate(AForm: TObject);
begin begin
...@@ -161,7 +145,6 @@ class function TFViewEditUser.CreateForm(AElementID, Mode, Username, Password, N ...@@ -161,7 +145,6 @@ class function TFViewEditUser.CreateForm(AElementID, Mode, Username, Password, N
TFViewEditUser(AForm).Email := Email; TFViewEditUser(AForm).Email := Email;
TFViewEditUser(AForm).Access := Access; TFViewEditUser(AForm).Access := Access;
TFViewEditUser(AForm).Rights := Rights; TFViewEditUser(AForm).Rights := Rights;
TFViewEditUser(AForm).Perspective := Perspective;
TFViewEditUser(AForm).QB := QB; TFViewEditUser(AForm).QB := QB;
end; end;
...@@ -182,7 +165,6 @@ begin ...@@ -182,7 +165,6 @@ begin
if Mode = 'Edit' then if Mode = 'Edit' then
begin begin
edtPassword.Text := 'hidden'; edtPassword.Text := 'hidden';
edtConfirmPassword.Text := 'hidden';
end; end;
edtEmail.Text := Email; edtEmail.Text := Email;
cbAccess.Text := Access; cbAccess.Text := Access;
...@@ -228,52 +210,4 @@ begin ...@@ -228,52 +210,4 @@ begin
WebTimer1.Enabled := True; WebTimer1.Enabled := True;
end; end;
procedure TFViewEditUser.ValidatePasswords;
var
Pwd, Confirm: string;
PwdInput, ConfirmInput: TJSHTMLInputElement;
begin
PwdInput := TJSHTMLInputElement(edtPassword.ElementHandle);
ConfirmInput := TJSHTMLInputElement(edtConfirmPassword.ElementHandle);
Pwd := PwdInput.value.Trim;
Confirm := ConfirmInput.value.Trim;
// Disable confirm until password exists
if Pwd = '' then
begin
ConfirmInput.disabled := True;
ConfirmInput.value := '';
ConfirmInput.setCustomValidity('');
ConfirmInput.classList.remove('is-invalid');
ConfirmInput.classList.remove('is-valid');
end
else
begin
ConfirmInput.disabled := False;
// Live match check
if Confirm = '' then
begin
ConfirmInput.setCustomValidity('');
ConfirmInput.classList.remove('is-invalid');
ConfirmInput.classList.remove('is-valid');
end
else if Confirm = Pwd then
begin
ConfirmInput.setCustomValidity('');
ConfirmInput.classList.add('is-valid');
ConfirmInput.classList.remove('is-invalid');
end
else
begin
ConfirmInput.setCustomValidity('Passwords must match');
ConfirmInput.classList.add('is-invalid');
ConfirmInput.classList.remove('is-valid');
end;
end;
end;
end. end.
kgOrdersClient/View.Items.pas
...@@ -444,34 +444,40 @@ var ...@@ -444,34 +444,40 @@ var
itemOptions: string; itemOptions: string;
newform: TFViewAddItem; newform: TFViewAddItem;
begin begin
newform := TFViewAddItem.CreateNew; console.log(AuthService.TokenPayload.Properties['qb_enabled']);
if AuthService.TokenPayload.Properties['qb_enabled'] then
begin
newform := TFViewAddItem.CreateNew;
newform.Caption := 'Select Item to Add'; newform.Caption := 'Select Item to Add';
newForm.Popup := True; newForm.Popup := True;
newForm.position:= poScreenCenter; newForm.position:= poScreenCenter;
newForm.Border := fbDialog; newForm.Border := fbDialog;
// used to manage Back button handling to close subform // used to manage Back button handling to close subform
window.location.hash := 'subform'; window.location.hash := 'subform';
newform.ShowModal( newform.ShowModal(
procedure(AValue: TModalResult) procedure(AValue: TModalResult)
begin
if newform.confirm then
begin begin
xdwdsItems.Append; if newform.confirm then
begin
xdwdsItems.Append;
xdwdsItems.FieldByName('QB_ID').AsString := newform.QB_ID; xdwdsItems.FieldByName('QB_ID').AsString := newform.QB_ID;
xdwdsItems.FieldByName('name').AsString := newform.name; xdwdsItems.FieldByName('name').AsString := newform.name;
xdwdsItems.FieldByName('description').AsString := newform.description; xdwdsItems.FieldByName('description').AsString := newform.description;
xdwdsItems.FieldByName('status').AsString := newform.status; xdwdsItems.FieldByName('status').AsString := newform.status;
xdwdsItems.Post; xdwdsItems.Post;
EditMode(); EditMode();
lblFormState.Caption := 'Add Mode'; lblFormState.Caption := 'Add Mode';
end; end;
end end
); );
end
else
ShowToast('QB interface not currently active', 'info');
end; end;
procedure TFViewItems.btnCancelClick(Sender: TObject); procedure TFViewItems.btnCancelClick(Sender: TObject);
......
kgOrdersClient/View.Main.pas
...@@ -50,7 +50,7 @@ type ...@@ -50,7 +50,7 @@ type
{ Public declarations } { Public declarations }
class procedure Display(LogoutProc: TLogoutProc); class procedure Display(LogoutProc: TLogoutProc);
procedure ShowForm( AFormClass: TWebFormClass ); procedure ShowForm( AFormClass: TWebFormClass );
procedure EditUser( Mode, Username, Password, Name, Status, Email, Access, Rights, Perspective, QB: string); procedure EditUser( Mode, Username, Password, Name, Status, Email, Access, Rights, QB: string);
procedure ViewOrderEntryCorrugated(orderInfo, customerInfo, mode, info: string); procedure ViewOrderEntryCorrugated(orderInfo, customerInfo, mode, info: string);
procedure ViewOrderEntryWeb(orderInfo, customerInfo, mode, info: string); procedure ViewOrderEntryWeb(orderInfo, customerInfo, mode, info: string);
procedure ViewOrderEntryCuttingDie(orderInfo, customerInfo, mode, info: string); procedure ViewOrderEntryCuttingDie(orderInfo, customerInfo, mode, info: string);
...@@ -94,8 +94,12 @@ begin ...@@ -94,8 +94,12 @@ begin
lblUsername.Caption := ' ' + userName.ToLower + ' '; lblUsername.Caption := ' ' + userName.ToLower + ' ';
FChildForm := nil; FChildForm := nil;
change := false; change := false;
if (not (JS.toBoolean(AuthService.TokenPayload.Properties['user_admin']))) then console.log(JS.toBoolean(AuthService.TokenPayload.Properties['user_access_type']));
if (not (JS.toString(AuthService.TokenPayload.Properties['user_access_type']) = 'ADMIN')) then
begin
lblUsers.enabled := false; lblUsers.enabled := false;
lblCustomers.Enabled := false;
end;
ShowForm(TFViewOrders); ShowForm(TFViewOrders);
lblAppTitle.Caption := 'Koehler-Gibson Orders'; lblAppTitle.Caption := 'Koehler-Gibson Orders';
...@@ -274,12 +278,12 @@ begin ...@@ -274,12 +278,12 @@ begin
end; end;
procedure TFViewMain.EditUser(Mode, Username, Password, Name, Status, Email, procedure TFViewMain.EditUser(Mode, Username, Password, Name, Status, Email,
Access, Rights, Perspective, QB: string); Access, Rights, QB: string);
begin begin
if Assigned(FChildForm) then if Assigned(FChildForm) then
FChildForm.Free; FChildForm.Free;
FChildForm := TFViewEditUser.CreateForm(WebPanel1.ElementID, Mode, Username, FChildForm := TFViewEditUser.CreateForm(WebPanel1.ElementID, Mode, Username,
Password, Name, Status, Email, Access, Rights, Perspective, QB); Password, Name, Status, Email, Access, Rights, QB);
end; end;
procedure TFViewMain.ViewOrders(info: string); procedure TFViewMain.ViewOrders(info: string);
......
kgOrdersClient/View.OrderEntryCorrugated.pas
...@@ -389,24 +389,31 @@ procedure TFOrderEntryCorrugated.btnQBClick(Sender: TObject); ...@@ -389,24 +389,31 @@ procedure TFOrderEntryCorrugated.btnQBClick(Sender: TObject);
var var
orderJSON: TJSONObject; orderJSON: TJSONObject;
begin begin
if JS.toString(AuthService.TokenPayload.Properties['user_qb_id']) <> '' then if AuthService.TokenPayload.Properties['qb_enabled'] then
begin begin
if ( VerifyQBOrder() )then
begin begin
if wdbcbINQB.Checked = false then if JS.toString(AuthService.TokenPayload.Properties['user_qb_id']) <> '' then
begin begin
Utils.ShowSpinner('spinner'); if ( VerifyQBOrder() )then
orderJSON := TJSONObject.Create; begin
orderJSON.AddPair('ORDER_ID', xdwdsOrder.FieldByName('ORDER_ID').AsString); if wdbcbINQB.Checked = false then
orderJSON.AddPair('USER_ID', JS.toString(AuthService.TokenPayload.Properties['user_id'])); begin
addEstimate(orderJSON.ToString); Utils.ShowSpinner('spinner');
orderJSON := TJSONObject.Create;
orderJSON.AddPair('ORDER_ID', xdwdsOrder.FieldByName('ORDER_ID').AsString);
orderJSON.AddPair('USER_ID', JS.toString(AuthService.TokenPayload.Properties['user_id']));
addEstimate(orderJSON.ToString);
end
else
ShowToast('Failure:Cannot submit orders already in QuickBooks', 'failure');
end;
end end
else else
ShowToast('Failure:Cannot submit orders already in QuickBooks', 'failure'); ShowToast('Failure:User not authorized to add to QuickBooks', 'failure');
end; end
end end
else else
ShowToast('Failure:User not authorized to add to QuickBooks', 'failure'); ShowToast('QB interface not currently active', 'info');
end; end;
[async] procedure TFOrderEntryCorrugated.GenerateReportPDF; [async] procedure TFOrderEntryCorrugated.GenerateReportPDF;
......
kgOrdersClient/View.OrderEntryCuttingDie.pas
...@@ -193,24 +193,29 @@ procedure TFOrderEntryCuttingDie.btnQBClick(Sender: TObject); ...@@ -193,24 +193,29 @@ procedure TFOrderEntryCuttingDie.btnQBClick(Sender: TObject);
var var
orderJSON: TJSONObject; orderJSON: TJSONObject;
begin begin
if JS.toString(AuthService.TokenPayload.Properties['user_qb_id']) <> '' then if AuthService.TokenPayload.Properties['qb_enabled'] then
begin begin
if ( VerifyQBOrder() )then if JS.toString(AuthService.TokenPayload.Properties['user_qb_id']) <> '' then
begin begin
if wdbcbINQB.Checked = false then if ( VerifyQBOrder() )then
begin begin
Utils.ShowSpinner('spinner'); if wdbcbINQB.Checked = false then
orderJSON := TJSONObject.Create; begin
orderJSON.AddPair('ORDER_ID', xdwdsOrder.FieldByName('ORDER_ID').AsString); Utils.ShowSpinner('spinner');
orderJSON.AddPair('USER_ID', JS.toString(AuthService.TokenPayload.Properties['user_id'])); orderJSON := TJSONObject.Create;
addEstimate(orderJSON.ToString); orderJSON.AddPair('ORDER_ID', xdwdsOrder.FieldByName('ORDER_ID').AsString);
end orderJSON.AddPair('USER_ID', JS.toString(AuthService.TokenPayload.Properties['user_id']));
else addEstimate(orderJSON.ToString);
ShowToast('Failure:Cannot submit orders already in QuickBooks', 'failure'); end
end; else
ShowToast('Failure:Cannot submit orders already in QuickBooks', 'failure');
end;
end
else
ShowToast('Failure:User not authorized to add to QuickBooks', 'failure');
end end
else else
ShowToast('Failure:User not authorized to add to QuickBooks', 'failure'); ShowToast('QB interface not currently active', 'info');
end; end;
procedure TFOrderEntryCuttingDie.WebButton2Click(Sender: TObject); procedure TFOrderEntryCuttingDie.WebButton2Click(Sender: TObject);
......
kgOrdersClient/View.OrderEntryWeb.pas
...@@ -454,24 +454,29 @@ procedure TFOrderEntryWeb.btnQBClick(Sender: TObject); ...@@ -454,24 +454,29 @@ procedure TFOrderEntryWeb.btnQBClick(Sender: TObject);
var var
orderJSON: TJSONObject; orderJSON: TJSONObject;
begin begin
if JS.toString(AuthService.TokenPayload.Properties['user_qb_id']) <> '' then if AuthService.TokenPayload.Properties['qb_enabled'] then
begin begin
if ( VerifyQBOrder() )then if JS.toString(AuthService.TokenPayload.Properties['user_qb_id']) <> '' then
begin begin
if wdbcbINQB.Checked = false then if ( VerifyQBOrder() )then
begin begin
Utils.ShowSpinner('spinner'); if wdbcbINQB.Checked = false then
orderJSON := TJSONObject.Create; begin
orderJSON.AddPair('ORDER_ID', xdwdsOrder.FieldByName('ORDER_ID').AsString); Utils.ShowSpinner('spinner');
orderJSON.AddPair('USER_ID', JS.toString(AuthService.TokenPayload.Properties['user_id'])); orderJSON := TJSONObject.Create;
addEstimate(orderJSON.ToString); orderJSON.AddPair('ORDER_ID', xdwdsOrder.FieldByName('ORDER_ID').AsString);
end orderJSON.AddPair('USER_ID', JS.toString(AuthService.TokenPayload.Properties['user_id']));
else addEstimate(orderJSON.ToString);
ShowToast('Failure:Cannot submit orders already in QuickBooks', 'failure'); end
end; else
ShowToast('Failure:Cannot submit orders already in QuickBooks', 'failure');
end;
end
else
ShowToast('Failure:User not authorized to add to QuickBooks', 'failure');
end end
else else
ShowToast('Failure:User not authorized to add to QuickBooks', 'failure'); ShowToast('QB interface not currently active', 'info');
end; end;
procedure TFOrderEntryWeb.AddEstimate(orderID: string); procedure TFOrderEntryWeb.AddEstimate(orderID: string);
......
kgOrdersClient/View.Orders.pas
...@@ -848,7 +848,9 @@ begin ...@@ -848,7 +848,9 @@ begin
searchOptions := '&pagenumber=' + IntToStr(PageNumber) + searchOptions := '&pagenumber=' + IntToStr(PageNumber) +
'&pagesize=' + IntToStr(PageSize) + '&pagesize=' + IntToStr(PageSize) +
'&orderby=' + OrderBy + '&orderby=' + OrderBy +
'&direction=' + direction; '&direction=' + direction +
'&accessRights=' + JS.toString(AuthService.TokenPayload.Properties['user_access_type']) +
'&userID=' + JS.toString(AuthService.TokenPayload.Properties['user_id']);
//Status 1 //Status 1
if ( (filterType1 <> '') and (filterType1 <> 'NONE') ) then if ( (filterType1 <> '') and (filterType1 <> 'NONE') ) then
......
kgOrdersClient/View.Users.pas
...@@ -117,7 +117,6 @@ var ...@@ -117,7 +117,6 @@ var
Email: TJSNode; Email: TJSNode;
Access: TJSNode; Access: TJSNode;
Rights: TJSNode; Rights: TJSNode;
Perspective: TJSNode;
QB: TJSNode; QB: TJSNode;
isAdmin: boolean; isAdmin: boolean;
isActive: boolean; isActive: boolean;
...@@ -139,12 +138,11 @@ begin ...@@ -139,12 +138,11 @@ begin
Email := cells[5]; Email := cells[5];
Access := cells[6]; Access := cells[6];
Rights := cells[7]; Rights := cells[7];
Perspective := cells[8]; QB := cells[8];
QB := cells[9];
FViewMain.EditUser('Edit', Username.innerText, Password.innerText, FullName.innerText, FViewMain.EditUser('Edit', Username.innerText, Password.innerText, FullName.innerText,
Status.innerText, Email.innerText, Access.innerText, Status.innerText, Email.innerText, Access.innerText,
Rights.innerText, Perspective.innerText, QB.innerText); Rights.innerText, QB.innerText);
end; end;
...@@ -455,7 +453,7 @@ end; ...@@ -455,7 +453,7 @@ end;
procedure TFViewUsers.btnAddUserClick(Sender: TObject); procedure TFViewUsers.btnAddUserClick(Sender: TObject);
begin begin
//Info := ''; //Info := '';
FViewMain.EditUser('Add', '', '', '', '', '', '', '', '', ''); FViewMain.EditUser('Add', '', '', '', '', '', '', '', '');
end; end;
......
kgOrdersServer/Source/Api.Database.dfm
...@@ -6,7 +6,6 @@ object ApiDatabase: TApiDatabase ...@@ -6,7 +6,6 @@ object ApiDatabase: TApiDatabase
ProviderName = 'MySQL' ProviderName = 'MySQL'
Database = 'kg_order_entry' Database = 'kg_order_entry'
Username = 'root' Username = 'root'
Server = '192.168.159.158'
LoginPrompt = False LoginPrompt = False
Left = 75 Left = 75
Top = 65 Top = 65
...@@ -408,4 +407,29 @@ object ApiDatabase: TApiDatabase ...@@ -408,4 +407,29 @@ object ApiDatabase: TApiDatabase
Required = True Required = True
end end
end end
object uqUsers: TUniQuery
Connection = ucKG
SQL.Strings = (
'SELECT USER_ID, NAME, STATUS from users ORDER BY NAME')
OnCalcFields = uqUsersCalcFields
Left = 318
Top = 252
object uqUsersUSER_ID: TIntegerField
FieldName = 'USER_ID'
Required = True
end
object uqUsersNAME: TStringField
FieldName = 'NAME'
Size = 40
end
object uqUsersSTATUS: TStringField
FieldName = 'STATUS'
Size = 7
end
object uqUsersREPRESENTATIVE: TStringField
FieldKind = fkCalculated
FieldName = 'REPRESENTATIVE'
Calculated = True
end
end
end end
kgOrdersServer/Source/Api.Database.pas
...@@ -112,7 +112,13 @@ type ...@@ -112,7 +112,13 @@ type
uqOrdersStatusScheduleORIGINAL_STATUS_DATE: TDateField; uqOrdersStatusScheduleORIGINAL_STATUS_DATE: TDateField;
uqOrdersStatusScheduleUSER_ID: TLongWordField; uqOrdersStatusScheduleUSER_ID: TLongWordField;
uqOrdersStatusScheduleORDER_REVISION: TLongWordField; uqOrdersStatusScheduleORDER_REVISION: TLongWordField;
uqUsers: TUniQuery;
uqUsersUSER_ID: TIntegerField;
uqUsersNAME: TStringField;
uqUsersSTATUS: TStringField;
uqUsersREPRESENTATIVE: TStringField;
procedure DataModuleCreate(Sender: TObject); procedure DataModuleCreate(Sender: TObject);
procedure uqUsersCalcFields(DataSet: TDataSet);
private private
{ Private declarations } { Private declarations }
public public
...@@ -158,4 +164,9 @@ begin ...@@ -158,4 +164,9 @@ begin
end; end;
end; end;
procedure TApiDatabase.uqUsersCalcFields(DataSet: TDataSet);
begin
uqUsersREPRESENTATIVE.AsString := uqUsersNAME.AsString + '(' + uqUsersSTATUS.AsString + ')';
end;
end. end.
kgOrdersServer/Source/Auth.ServiceImpl.pas
...@@ -27,9 +27,9 @@ type ...@@ -27,9 +27,9 @@ type
userAccessType: string; userAccessType: string;
userEmail: string; userEmail: string;
userStatus: string; userStatus: string;
qbEnabled: boolean;
procedure AfterConstruction; override; procedure AfterConstruction; override;
procedure BeforeDestruction; override; procedure BeforeDestruction; override;
property Query: TUniQuery read GetQuery;
function CheckUser(const user, password: string): Integer; function CheckUser(const user, password: string): Integer;
public public
function Login(const user, password: string): string; function Login(const user, password: string): string;
...@@ -55,7 +55,15 @@ uses ...@@ -55,7 +55,15 @@ uses
procedure TAuthService.AfterConstruction; procedure TAuthService.AfterConstruction;
begin begin
inherited; inherited;
authDB := TAuthDatabase.Create(nil); try
authDB := TAuthDatabase.Create(nil);
except
on E: Exception do
begin
Logger.Log(1, 'Error when creating the Auth database: ' + E.Message);
raise EXDataHttpException.Create(500, 'Unable to create Auth database: A KGOrders Server Error has occured!');
end;
end;
end; end;
procedure TAuthService.BeforeDestruction; procedure TAuthService.BeforeDestruction;
...@@ -81,6 +89,7 @@ begin ...@@ -81,6 +89,7 @@ begin
try try
webClientVersion := iniFile.ReadString('Settings', 'webClientVersion', ''); webClientVersion := iniFile.ReadString('Settings', 'webClientVersion', '');
Result.AddPair('webClientVersion', webClientVersion); Result.AddPair('webClientVersion', webClientVersion);
qbEnabled := iniFile.ReadBool('Quickbooks', 'Enabled', false);
if webClientVersion = '' then if webClientVersion = '' then
begin begin
...@@ -102,6 +111,7 @@ end; ...@@ -102,6 +111,7 @@ end;
function TAuthService.Login(const user, password: string): string; function TAuthService.Login(const user, password: string): string;
var var
userState: Integer; userState: Integer;
iniFile: TIniFile;
JWT: TJWT; JWT: TJWT;
begin begin
Logger.Log(3, Format( 'AuthService.Login - User: "%s"', [User])); Logger.Log(3, Format( 'AuthService.Login - User: "%s"', [User]));
...@@ -128,8 +138,18 @@ begin ...@@ -128,8 +138,18 @@ begin
logger.Log(2, 'Login Error: User does not exist!'); logger.Log(2, 'Login Error: User does not exist!');
end end
else if userState = 2 then else if userState = 2 then
begin
raise EXDataHttpUnauthorized.Create('User not active!'); raise EXDataHttpUnauthorized.Create('User not active!');
logger.Log(2, 'Login Error: User not active!'); logger.Log(2, 'Login Error: User not active!');
end;
iniFile := TIniFile.Create(ChangeFileExt(ParamStr(0), '.ini'));
try
qbEnabled := iniFile.ReadBool('Quickbooks', 'Enabled', false);
finally
iniFile.Free;
end;
JWT := TJWT.Create; JWT := TJWT.Create;
try try
...@@ -144,7 +164,7 @@ begin ...@@ -144,7 +164,7 @@ begin
JWT.Claims.SetClaimOfType<string>('user_email', userEmail); JWT.Claims.SetClaimOfType<string>('user_email', userEmail);
JWT.Claims.SetClaimOfType<string>('user_qb_id', userQBID); JWT.Claims.SetClaimOfType<string>('user_qb_id', userQBID);
JWT.Claims.SetClaimOfType<string>('user_access_type', userAccessType); JWT.Claims.SetClaimOfType<string>('user_access_type', userAccessType);
JWT.Claims.SetClaimOfType<string>('user_admin', LowerCase(BoolToStr(SameText(userAccessType, 'ADMIN'), True))); JWT.Claims.SetClaimOfType<boolean>('qb_enabled', qbEnabled);
Result := TJOSE.SHA256CompactToken(serverConfig.jwtTokenSecret, JWT); Result := TJOSE.SHA256CompactToken(serverConfig.jwtTokenSecret, JWT);
finally finally
......
kgOrdersServer/Source/Lookup.Service.pas
...@@ -33,6 +33,7 @@ type ...@@ -33,6 +33,7 @@ type
rights: integer; rights: integer;
perspectiveID: string; perspectiveID: string;
QBID: string; QBID: string;
representative: string;
end; end;
TUserList = class TUserList = class
......
kgOrdersServer/Source/Lookup.ServiceImpl.pas
...@@ -339,13 +339,22 @@ begin ...@@ -339,13 +339,22 @@ begin
restClient.Free; restClient.Free;
restRequest.Free; restRequest.Free;
restResponse.Free; restResponse.Free;
estimateJSON.Free;
end; end;
end; end;
procedure TLookupService.AfterConstruction; procedure TLookupService.AfterConstruction;
begin begin
inherited; inherited;
ordersDB := TApiDatabase.Create(nil); try
ordersDB := TApiDatabase.Create(nil);
except
on E: Exception do
begin
Logger.Log(1, 'Error when creating the API database: ' + E.Message);
raise EXDataHttpException.Create(500, 'Unable to create API database: A KGOrders Server Error has occured!');
end;
end;
end; end;
procedure TLookupService.BeforeDestruction; procedure TLookupService.BeforeDestruction;
...@@ -400,62 +409,66 @@ var ...@@ -400,62 +409,66 @@ var
begin begin
logger.Log(3, 'TLookupService.GetCustomers'); logger.Log(3, 'TLookupService.GetCustomers');
params := TStringList.Create; params := TStringList.Create;
params.StrictDelimiter := true; try
params.Delimiter := '&'; params.StrictDelimiter := true;
params.DelimitedText := customerInfo; params.Delimiter := '&';
PageSize := 0; params.DelimitedText := customerInfo;
PageNum := 0; PageSize := 0;
PageNum := 0;
if (params.Values['pagenumber'] <> '') then if (params.Values['pagenumber'] <> '') then
PageNum := StrToInt(params.Values['pagenumber']); PageNum := StrToInt(params.Values['pagenumber']);
if params.Values['pagesize'] <> '' then if params.Values['pagesize'] <> '' then
PageSize := StrToInt(params.Values['pagesize']); PageSize := StrToInt(params.Values['pagesize']);
if ( ( PageSize <> 0 ) and (PageNum <> 0 ) ) then if ( ( PageSize <> 0 ) and (PageNum <> 0 ) ) then
begin begin
offset := IntToStr((PageNum - 1) * PageSize); offset := IntToStr((PageNum - 1) * PageSize);
limit := IntToStr(PageSize); limit := IntToStr(PageSize);
limitSQL := ' limit ' + limit + ' offset ' + offset; limitSQL := ' limit ' + limit + ' offset ' + offset;
end; end;
try try
SQL := 'select * from customers' + limitSQL; SQL := 'select * from customers' + limitSQL;
doQuery(ordersDB.UniQuery1, SQL); doQuery(ordersDB.UniQuery1, SQL);
result := TCustomerList.Create; result := TCustomerList.Create;
Result.data := TList<TCustomerItem>.Create; Result.data := TList<TCustomerItem>.Create;
TXDataOperationContext.Current.Handler.ManagedObjects.Add(Result.data); TXDataOperationContext.Current.Handler.ManagedObjects.Add(Result.data);
result.count := 0; result.count := 0;
while not ordersDB.UniQuery1.Eof do while not ordersDB.UniQuery1.Eof do
begin begin
customer := TCustomerItem.Create; customer := TCustomerItem.Create;
TXDataOperationContext.Current.Handler.ManagedObjects.Add(customer); TXDataOperationContext.Current.Handler.ManagedObjects.Add(customer);
customer.NAME := ordersDB.UniQuery1.FieldByName('NAME').AsString; customer.NAME := ordersDB.UniQuery1.FieldByName('NAME').AsString;
customer.CUSTOMER_ID := ordersDB.UniQuery1.FieldByName('CUSTOMER_ID').AsInteger; customer.CUSTOMER_ID := ordersDB.UniQuery1.FieldByName('CUSTOMER_ID').AsInteger;
customer.SHORT_NAME := ordersDB.UniQuery1.FieldByName('SHORT_NAME').AsString; customer.SHORT_NAME := ordersDB.UniQuery1.FieldByName('SHORT_NAME').AsString;
customer.staff_fields_invoice_to := ordersDB.UniQuery1.FieldByName('BILL_ADDRESS').AsString + customer.staff_fields_invoice_to := ordersDB.UniQuery1.FieldByName('BILL_ADDRESS').AsString +
', ' + ordersDB.UniQuery1.FieldByName('BILL_CITY').AsString + ', ' + ordersDB.UniQuery1.FieldByName('BILL_CITY').AsString +
', ' + ordersDB.UniQuery1.FieldByName('BILL_STATE').AsString + ', ' + ordersDB.UniQuery1.FieldByName('BILL_STATE').AsString +
' ' + ordersDB.UniQuery1.FieldByName('BILL_ZIP').AsString; ' ' + ordersDB.UniQuery1.FieldByName('BILL_ZIP').AsString;
customer.START_DATE := ordersDB.UniQuery1.FieldByName('START_DATE').AsString; customer.START_DATE := ordersDB.UniQuery1.FieldByName('START_DATE').AsString;
result.data.Add(customer); result.data.Add(customer);
ordersDB.UniQuery1.Next; ordersDB.UniQuery1.Next;
end; end;
ordersDB.UniQuery1.Close; ordersDB.UniQuery1.Close;
SQL := 'SELECT COUNT(*) AS total_count from customers'; SQL := 'SELECT COUNT(*) AS total_count from customers';
doQuery(ordersDB.UniQuery1, SQL); doQuery(ordersDB.UniQuery1, SQL);
Result.count := ordersDB.UniQuery1.FieldByName('total_count').AsInteger; Result.count := ordersDB.UniQuery1.FieldByName('total_count').AsInteger;
ordersDB.UniQuery1.Close; ordersDB.UniQuery1.Close;
except except
on E: Exception do on E: Exception do
begin begin
Logger.Log(2, 'Error in GetCustomers: ' + E.Message); Logger.Log(2, 'Error in GetCustomers: ' + E.Message);
raise EXDataHttpException.Create(500, 'Unable to retrieve customer list: A KG Orders Database issue has occurred!'); raise EXDataHttpException.Create(500, 'Unable to retrieve customer list: A KG Orders Database issue has occurred!');
end;
end; end;
finally
params.Free;
end; end;
end; end;
...@@ -528,17 +541,18 @@ var ...@@ -528,17 +541,18 @@ var
SQL: string; SQL: string;
begin begin
Logger.Log(3, 'TLookupService.GetRepUsers'); Logger.Log(3, 'TLookupService.GetRepUsers');
SQL := 'SELECT USER_ID, NAME from users where QB_ID IS NOT NULL AND QB_ID <> ' + quotedStr(''); SQL := 'SELECT USER_ID, NAME, STATUS from users ORDER BY NAME';
result := TList<TUserItem>.Create; result := TList<TUserItem>.Create;
doQuery(ordersDB.UniQuery1, SQL); doQuery(ordersDB.uqUsers, SQL);
while not ordersDB.UniQuery1.Eof do while not ordersDB.uqUsers.Eof do
begin begin
USER := TUserItem.Create; USER := TUserItem.Create;
TXDataOperationContext.Current.Handler.ManagedObjects.Add( USER ); TXDataOperationContext.Current.Handler.ManagedObjects.Add( USER );
USER.userID := ordersDB.UniQuery1.FieldByName('USER_ID').AsString; USER.userID := ordersDB.uqUsersUSER_ID.AsString;
USER.full_name := ordersDB.UniQuery1.FieldByName('NAME').AsString; USER.full_name := ordersDB.uqUsersNAME.AsString;
USER.representative := ordersDB.uqUsersREPRESENTATIVE.AsString;
result.Add(USER); result.Add(USER);
ordersDB.UniQuery1.Next; ordersDB.uqUsers.Next;
end; end;
end; end;
...@@ -553,9 +567,9 @@ var ...@@ -553,9 +567,9 @@ var
begin begin
logger.Log(3, 'TLookupService.GenerateOrderListPDF'); logger.Log(3, 'TLookupService.GenerateOrderListPDF');
rptOrderList := TrptOrderList.Create(nil); rptOrderList := TrptOrderList.Create(nil);
params := TStringList.Create;
try try
try try
params := TStringList.Create;
params.StrictDelimiter := true; params.StrictDelimiter := true;
params.Delimiter := '&'; params.Delimiter := '&';
params.DelimitedText := searchOptions; params.DelimitedText := searchOptions;
...@@ -590,6 +604,7 @@ begin ...@@ -590,6 +604,7 @@ begin
end; end;
finally finally
rptOrderList.Free; rptOrderList.Free;
params.Free;
end; end;
end; end;
...@@ -614,6 +629,7 @@ begin ...@@ -614,6 +629,7 @@ begin
logger.Log(3, 'TLookupSerivce.AddShippingAddress'); logger.Log(3, 'TLookupSerivce.AddShippingAddress');
result := TJSONObject.Create; result := TJSONObject.Create;
JSONData := TJSONObject.ParseJSONValue(AddressInfo) as TJSONObject; JSONData := TJSONObject.ParseJSONValue(AddressInfo) as TJSONObject;
if JSONData = nil then if JSONData = nil then
raise Exception.Create('Invalid JSON format'); // If parsing fails, raise an exception raise Exception.Create('Invalid JSON format'); // If parsing fails, raise an exception
mode := JSONData.GetValue<string>('mode'); mode := JSONData.GetValue<string>('mode');
...@@ -709,6 +725,7 @@ begin ...@@ -709,6 +725,7 @@ begin
DateFormat.ShortDateFormat := 'yyyy-mm-dd'; DateFormat.ShortDateFormat := 'yyyy-mm-dd';
DateFormat.DateSeparator := '-'; DateFormat.DateSeparator := '-';
JSONData := TJSONObject.ParseJSONValue(customerInfo) as TJSONObject; JSONData := TJSONObject.ParseJSONValue(customerInfo) as TJSONObject;
if JSONData = nil then if JSONData = nil then
raise Exception.Create('Invalid JSON format'); // If parsing fails, raise an exception raise Exception.Create('Invalid JSON format'); // If parsing fails, raise an exception
mode := JSONData.GetValue<string>('mode'); mode := JSONData.GetValue<string>('mode');
...@@ -893,8 +910,6 @@ begin ...@@ -893,8 +910,6 @@ begin
end; end;
end; end;
function TLookupService.generateSubQuery(currStatus: string): string; function TLookupService.generateSubQuery(currStatus: string): string;
// Generates the subquery in order to retrieve all the status due/done dates // Generates the subquery in order to retrieve all the status due/done dates
// This must be a subquery because there are at most 5 different entries which // This must be a subquery because there are at most 5 different entries which
...@@ -1030,77 +1045,91 @@ var ...@@ -1030,77 +1045,91 @@ var
OrderID, CompanyID, JobName, orderType: string; OrderID, CompanyID, JobName, orderType: string;
status1, status2: TStatusSearchInfo; status1, status2: TStatusSearchInfo;
ForPDF: Boolean; ForPDF: Boolean;
accessRights, userID: string;
begin begin
result := TSQLQuery.Create; result := TSQLQuery.Create;
params := TStringList.Create; params := TStringList.Create;
params.StrictDelimiter := true;
params.Delimiter := '&';
params.DelimitedText := searchOptions;
ForPDF := SameText(params.Values['forPDF'], 'true'); try
params.StrictDelimiter := true;
params.Delimiter := '&';
params.DelimitedText := searchOptions;
if not ForPDF then ForPDF := SameText(params.Values['forPDF'], 'true');
begin
PageNum := StrToIntDef(params.Values['pagenumber'], 1);
PageSize := StrToIntDef(params.Values['pagesize'], 500);
offset := IntToStr((PageNum - 1) * PageSize);
limit := IntToStr(PageSize);
end;
OrderBy := params.Values['orderby'] + ' ' + params.Values['direction']; if not ForPDF then
orderType := params.Values['orderType'].ToLower(); begin
OrderID := params.Values['orderID']; PageNum := StrToIntDef(params.Values['pagenumber'], 1);
companyID := params.Values['companyID']; PageSize := StrToIntDef(params.Values['pagesize'], 500);
jobName := params.Values['jobName']; offset := IntToStr((PageNum - 1) * PageSize);
limit := IntToStr(PageSize);
status1 := createStatusSearchInfo(params, '1'); end;
status2 := createStatusSearchInfo(params, '2');
OrderBy := params.Values['orderby'] + ' ' + params.Values['direction'];
SQL := 'SELECT o.ORDER_ID, c.SHORT_NAME, o.LOCATION AS Loc, c.NAME AS COMPANY_NAME, o.JOB_NAME, o.ORDER_TYPE, o.IN_QB, o.QB_ORDER_NUM,' + orderType := params.Values['orderType'].ToLower();
generateSubquery('PROOF') + OrderID := params.Values['orderID'];
generateSubquery('ART') + companyID := params.Values['companyID'];
generateSubquery('PLATE') + jobName := params.Values['jobName'];
generateSubquery('MOUNT') + accessRights := params.Values['accessRights'];
generateSubquery('SHIP'); userID := params.Values['userID'];
whereSQL := ' FROM orders o JOIN customers c ON c.CUSTOMER_ID = o.COMPANY_ID ' + status1 := createStatusSearchInfo(params, '1');
'LEFT JOIN qb_sales_orders qb ON qb.ORDER_ID = o.ORDER_ID ' + status2 := createStatusSearchInfo(params, '2');
'LEFT JOIN corrugated_plate_orders cpo ON o.ORDER_ID = cpo.ORDER_ID ' +
'LEFT JOIN web_plate_orders wpo ON o.ORDER_ID = wpo.ORDER_ID ' + SQL := 'SELECT o.ORDER_ID, c.SHORT_NAME, o.LOCATION AS Loc, c.NAME AS COMPANY_NAME, o.JOB_NAME, o.ORDER_TYPE, o.IN_QB, o.QB_ORDER_NUM,' +
'LEFT JOIN cutting_die_orders cdo ON o.ORDER_ID = cdo.ORDER_ID WHERE 0 = 0'; generateSubquery('PROOF') +
generateSubquery('ART') +
if (status1.filterType <> '') and (status1.filterType <> 'NONE') then generateSubquery('PLATE') +
whereSQL := whereSQL + generateStatusWhereSQL(status1); generateSubquery('MOUNT') +
if (status2.filterType <> '') and (status2.filterType <> 'NONE') then generateSubquery('SHIP');
whereSQL := whereSQL + generateStatusWhereSQL(status2);
if (orderType <> '') and (orderType <> 'any') then whereSQL := ' FROM orders o JOIN customers c ON c.CUSTOMER_ID = o.COMPANY_ID ' +
begin 'LEFT JOIN qb_sales_orders qb ON qb.ORDER_ID = o.ORDER_ID ' +
if (orderType <> 'cutting die') then 'LEFT JOIN corrugated_plate_orders cpo ON o.ORDER_ID = cpo.ORDER_ID ' +
whereSQL := whereSQL + ' AND o.ORDER_TYPE = ' + QuotedStr(orderType + '_plate') 'LEFT JOIN web_plate_orders wpo ON o.ORDER_ID = wpo.ORDER_ID ' +
'LEFT JOIN cutting_die_orders cdo ON o.ORDER_ID = cdo.ORDER_ID WHERE 0 = 0';
if (status1.filterType <> '') and (status1.filterType <> 'NONE') then
whereSQL := whereSQL + generateStatusWhereSQL(status1);
if (status2.filterType <> '') and (status2.filterType <> 'NONE') then
whereSQL := whereSQL + generateStatusWhereSQL(status2);
if (orderType <> '') and (orderType <> 'any') then
begin
if (orderType <> 'cutting die') then
whereSQL := whereSQL + ' AND o.ORDER_TYPE = ' + QuotedStr(orderType + '_plate')
else
whereSQL := whereSQL + ' AND o.ORDER_TYPE = ' + QuotedStr('cutting_die');
end;
if OrderID <> '' then
whereSQL := whereSQL + ' AND o.ORDER_ID = ' + OrderID;
if companyID <> '' then
whereSQL := whereSQL + ' AND c.CUSTOMER_ID = ' + companyID;
if jobName <> '' then
whereSQL := whereSQL + ' AND o.JOB_NAME LIKE ' + QuotedStr('%' + jobName + '%');
if accessRights = 'SALES' then
begin
whereSQL := whereSQL + ' AND c.REP_USER_ID = ' + userID;
end;
orderBySQL := ' ORDER BY ' + OrderBy;
SQL := SQL + ' o.PRICE, qb.QB_REF_NUM, ' +
'COALESCE(cpo.staff_fields_po_number, wpo.staff_fields_po_number, cdo.staff_fields_po_number) AS po_number, ' +
'COALESCE(cpo.staff_fields_quickbooks_item, wpo.staff_fields_quickbooks_item, cdo.staff_fields_quickbooks_item) AS quickbooks_item, ' +
'COALESCE(cpo.staff_fields_order_date, wpo.staff_fields_order_date, cdo.staff_fields_order_date) AS ORDER_DATE ';
if not ForPDF then
SQL := SQL + whereSQL + orderBySQL + ' LIMIT ' + limit + ' OFFSET ' + offset
else else
whereSQL := whereSQL + ' AND o.ORDER_TYPE = ' + QuotedStr('cutting_die'); SQL := SQL + whereSQL + orderBySQL;
end;
if OrderID <> '' then
whereSQL := whereSQL + ' AND o.ORDER_ID = ' + OrderID;
if companyID <> '' then
whereSQL := whereSQL + ' AND c.CUSTOMER_ID = ' + companyID;
if jobName <> '' then
whereSQL := whereSQL + ' AND o.JOB_NAME LIKE ' + QuotedStr('%' + jobName + '%');
orderBySQL := ' ORDER BY ' + OrderBy;
SQL := SQL + ' o.PRICE, qb.QB_REF_NUM, ' +
'COALESCE(cpo.staff_fields_po_number, wpo.staff_fields_po_number, cdo.staff_fields_po_number) AS po_number, ' +
'COALESCE(cpo.staff_fields_quickbooks_item, wpo.staff_fields_quickbooks_item, cdo.staff_fields_quickbooks_item) AS quickbooks_item, ' +
'COALESCE(cpo.staff_fields_order_date, wpo.staff_fields_order_date, cdo.staff_fields_order_date) AS ORDER_DATE ';
if not ForPDF then
SQL := SQL + whereSQL + orderBySQL + ' LIMIT ' + limit + ' OFFSET ' + offset
else
SQL := SQL + whereSQL + orderBySQL;
result.SQL := SQL; result.SQL := SQL;
result.whereSQL := whereSQL; result.whereSQL := whereSQL;
finally
params.Free;
end;
end; end;
function TLookupService.getColorCount(colors: string): string; function TLookupService.getColorCount(colors: string): string;
...@@ -1231,7 +1260,6 @@ var ...@@ -1231,7 +1260,6 @@ var
orderID: string; orderID: string;
SQL: string; SQL: string;
table: string; table: string;
ADDRESS: TAddressItem;
begin begin
logger.Log(3,'TLookupService.GetCorrugatedOrder'); logger.Log(3,'TLookupService.GetCorrugatedOrder');
orderID := orderInfo; orderID := orderInfo;
...@@ -1341,7 +1369,6 @@ var ...@@ -1341,7 +1369,6 @@ var
orderType: string; orderType: string;
orderID: string; orderID: string;
SQL: string; SQL: string;
ADDRESS: TAddressItem;
begin begin
logger.Log(3, 'TLookupService.GetWebOrder'); logger.Log(3, 'TLookupService.GetWebOrder');
try try
...@@ -1469,7 +1496,6 @@ var ...@@ -1469,7 +1496,6 @@ var
orderType: string; orderType: string;
orderID: string; orderID: string;
SQL: string; SQL: string;
ADDRESS: TAddressItem;
begin begin
logger.Log(3, 'TLookupService.GetCuttingDieOrder'); logger.Log(3, 'TLookupService.GetCuttingDieOrder');
try try
...@@ -1530,56 +1556,60 @@ var ...@@ -1530,56 +1556,60 @@ var
item: TItemItem; item: TItemItem;
begin begin
logger.Log(3, 'TLookupService.GetItems'); logger.Log(3, 'TLookupService.GetItems');
params := TStringList.Create;
try try
params := TStringList.Create; try
params.StrictDelimiter := true; params.StrictDelimiter := true;
// parse the searchOptions // parse the searchOptions
params.Delimiter := '&'; params.Delimiter := '&';
params.DelimitedText := searchOptions; params.DelimitedText := searchOptions;
SQL := 'select * from qb_items order by qb_item_name asc';
if ( ( params.Values['pagenumber'] <> '' ) and ( params.Values['pagesize'] <> '' ) ) then SQL := 'select * from qb_items order by qb_item_name asc';
begin
pageNum := StrToInt(params.Values['pagenumber']);
PageSize := StrToInt(params.Values['pagesize']);
OrderBy := params.Values['orderby'];
limit := IntToStr(PageSize); if ( ( params.Values['pagenumber'] <> '' ) and ( params.Values['pagesize'] <> '' ) ) then
offset := IntToStr((PageNum - 1) * PageSize); begin
SQL := SQL + ' limit ' + limit + ' offset ' + offset; pageNum := StrToInt(params.Values['pagenumber']);
end; PageSize := StrToInt(params.Values['pagesize']);
OrderBy := params.Values['orderby'];
doQuery(ordersDB.UniQuery1, SQL); limit := IntToStr(PageSize);
offset := IntToStr((PageNum - 1) * PageSize);
SQL := SQL + ' limit ' + limit + ' offset ' + offset;
end;
Result:= TItemList.Create; doQuery(ordersDB.UniQuery1, SQL);
Result.data := TList<TItemItem>.Create;
TXDataOperationContext.Current.Handler.ManagedObjects.Add( Result.data );
while not ordersDB.UniQuery1.Eof do Result:= TItemList.Create;
begin Result.data := TList<TItemItem>.Create;
item := TItemItem.Create; TXDataOperationContext.Current.Handler.ManagedObjects.Add( Result.data );
TXDataOperationContext.Current.Handler.ManagedObjects.Add( item );
Result.data.Add( item );
item.ID := ordersDB.UniQuery1.FieldByName('qb_items_id').AsString;
item.name := ordersDB.UniQuery1.FieldByName('qb_item_name').AsString;
item.description := ordersDB.UniQuery1.FieldByName('item_desc').AsString;
item.status := ordersDB.UniQuery1.FieldByName('status').AsString;
item.QB_ID := ordersDB.UniQuery1.FieldByName('qb_items_qb_id').AsString;
ordersDB.UniQuery1.Next; while not ordersDB.UniQuery1.Eof do
end; begin
ordersDB.UniQuery1.Close; item := TItemItem.Create;
SQL:= 'select count(*) as total_count from qb_items'; TXDataOperationContext.Current.Handler.ManagedObjects.Add( item );
doQuery(ordersDB.UniQuery1, SQL); Result.data.Add( item );
Result.count := ordersDB.UniQuery1.FieldByName('total_count').AsInteger; item.ID := ordersDB.UniQuery1.FieldByName('qb_items_id').AsString;
ordersDB.UniQuery1.Close; item.name := ordersDB.UniQuery1.FieldByName('qb_item_name').AsString;
except item.description := ordersDB.UniQuery1.FieldByName('item_desc').AsString;
on E: Exception do item.status := ordersDB.UniQuery1.FieldByName('status').AsString;
begin item.QB_ID := ordersDB.UniQuery1.FieldByName('qb_items_qb_id').AsString;
Logger.Log(2, 'Error in GetItems: ' + E.Message);
raise EXDataHttpException.Create(500, 'Unable to retrieve item list:A KG Orders database issue has occurred!'); ordersDB.UniQuery1.Next;
end;
ordersDB.UniQuery1.Close;
SQL:= 'select count(*) as total_count from qb_items';
doQuery(ordersDB.UniQuery1, SQL);
Result.count := ordersDB.UniQuery1.FieldByName('total_count').AsInteger;
ordersDB.UniQuery1.Close;
except
on E: Exception do
begin
Logger.Log(2, 'Error in GetItems: ' + E.Message);
raise EXDataHttpException.Create(500, 'Unable to retrieve item list:A KG Orders database issue has occurred!');
end;
end; end;
finally
params.Free;
end; end;
end; end;
...@@ -1673,71 +1703,73 @@ var ...@@ -1673,71 +1703,73 @@ var
begin begin
logger.log(3, 'TLookupService.EditUser'); logger.log(3, 'TLookupService.EditUser');
params := TStringList.Create; params := TStringList.Create;
params.Delimiter := '&'; try
params.StrictDelimiter := true; params.Delimiter := '&';
params.DelimitedText := editOptions; params.StrictDelimiter := true;
user := params.Values['username']; params.DelimitedText := editOptions;
password := params.Values['password']; user := params.Values['username'];
full_name := params.Values['fullname']; password := params.Values['password'];
status := params.Values['status']; full_name := params.Values['fullname'];
email := params.Values['email']; status := params.Values['status'];
access := params.Values['access']; email := params.Values['email'];
rights := params.Values['rights']; access := params.Values['access'];
perspective := params.Values['perspective']; rights := params.Values['rights'];
QB := params.Values['QB']; perspective := params.Values['perspective'];
newUser := params.Values['newuser']; QB := params.Values['QB'];
newUser := params.Values['newuser'];
SQL := 'select * from users where USER_NAME = ' + QuotedStr(user);
doQuery(ordersDB.UniQuery1, SQL);
if ordersDB.UniQuery1.IsEmpty then SQL := 'select * from users where USER_NAME = ' + QuotedStr(user);
Result := 'Failure:No such user found' doQuery(ordersDB.UniQuery1, SQL);
else
begin
ordersDB.UniQuery1.Edit;
//user.password := ordersDB.UniQuery1.FieldByName('PASSWORD').AsString; if ordersDB.UniQuery1.IsEmpty then
Result := 'Failure:No such user found'
else
begin
ordersDB.UniQuery1.Edit;
if not newUser.IsEmpty then if not newUser.IsEmpty then
ordersDB.UniQuery1.FieldByName('USER_NAME').AsString := newUser; ordersDB.UniQuery1.FieldByName('USER_NAME').AsString := newUser;
if not full_name.IsEmpty then if not full_name.IsEmpty then
ordersDB.UniQuery1.FieldByName('NAME').AsString := full_name; ordersDB.UniQuery1.FieldByName('NAME').AsString := full_name;
if not status.IsEmpty then if not status.IsEmpty then
begin begin
if StrToBool(status) then if StrToBool(status) then
ordersDB.UniQuery1.FieldByName('STATUS').AsString := 'ACTIVE' ordersDB.UniQuery1.FieldByName('STATUS').AsString := 'ACTIVE'
else else
ordersDB.UniQuery1.FieldByName('STATUS').AsString := 'INACTIVE' ordersDB.UniQuery1.FieldByName('STATUS').AsString := 'INACTIVE'
end; end;
if not email.IsEmpty then if not email.IsEmpty then
ordersDB.UniQuery1.FieldByName('EMAIL').AsString := email; ordersDB.UniQuery1.FieldByName('EMAIL').AsString := email;
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 rights.IsEmpty then
ordersDB.UniQuery1.FieldByName('SYSTEM_RIGHTS').AsInteger := StrToInt(rights); ordersDB.UniQuery1.FieldByName('SYSTEM_RIGHTS').AsInteger := StrToInt(rights);
if not perspective.IsEmpty then if not perspective.IsEmpty then
ordersDB.UniQuery1.FieldByName('PERSPECTIVE_ID').AsString := perspective; ordersDB.UniQuery1.FieldByName('PERSPECTIVE_ID').AsString := perspective;
if not QB.IsEmpty then if not QB.IsEmpty then
ordersDB.UniQuery1.FieldByName('QB_ID').AsString := QB; ordersDB.UniQuery1.FieldByName('QB_ID').AsString := QB;
{if((not (Password = 'hidden')) and (not (Password.IsEmpty))) then if((not (Password = 'hidden')) and (not (Password.IsEmpty))) then
begin begin
hashString := ordersDB.UniQuery1.FieldByName('date_created').AsString + password; hashString := ordersDB.UniQuery1.FieldByName('NAME').AsString + password;
hashPW := THashSHA2.GetHashString(hashString, THashSHA2.TSHA2Version.SHA512).ToUpper; hashPW := THashSHA2.GetHashString(hashString, THashSHA2.TSHA2Version.SHA512).ToUpper;
ordersDB.UniQuery1.FieldByName('password').AsString := hashPW; ordersDB.UniQuery1.FieldByName('password').AsString := hashPW;
end;} end;
ordersDB.UniQuery1.Post; ordersDB.UniQuery1.Post;
Result := 'Success: User Successfully Edited'; Result := 'Success: User Successfully Edited';
end;
ordersDB.UniQuery1.Close;
finally
params.Free;
end; end;
ordersDB.UniQuery1.Close;
end; end;
procedure TLookupService.AddToOrdersTable(mode, ORDER_TYPE: string; JSONData: TJSONObject); procedure TLookupService.AddToOrdersTable(mode, ORDER_TYPE: string; JSONData: TJSONObject);
...@@ -1761,12 +1793,7 @@ begin ...@@ -1761,12 +1793,7 @@ begin
ordersDB.UniQuery1.FieldByName('ORDER_TYPE').AsString := ORDER_TYPE; ordersDB.UniQuery1.FieldByName('ORDER_TYPE').AsString := ORDER_TYPE;
if mode = 'ADD' then if mode = 'ADD' then
ordersDB.UniQuery1.FieldByName('ORDER_DATE').AsDateTime := Now ordersDB.UniQuery1.FieldByName('ORDER_DATE').AsDateTime := Now;
else
begin
// No idea why I need this line but without it an error gets thrown
//ordersDB.UniQuery1.FieldByName('ORDER_DATE').AsDateTime := ordersDB.UniQuery1.FieldByName('ORDER_DATE').AsDateTime;
end;
if JSONData.GetValue<string>('staff_fields_price') = '' then if JSONData.GetValue<string>('staff_fields_price') = '' then
ordersDB.UniQuery1.FieldByName('PRICE').AsString := '0' ordersDB.UniQuery1.FieldByName('PRICE').AsString := '0'
...@@ -1802,6 +1829,7 @@ begin ...@@ -1802,6 +1829,7 @@ begin
DateFormat.ShortDateFormat := 'yyyy-mm-dd'; DateFormat.ShortDateFormat := 'yyyy-mm-dd';
DateFormat.DateSeparator := '-'; DateFormat.DateSeparator := '-';
JSONData := TJSONObject.ParseJSONValue(orderInfo) as TJSONObject; JSONData := TJSONObject.ParseJSONValue(orderInfo) as TJSONObject;
if JSONData = nil then if JSONData = nil then
raise Exception.Create('Invalid JSON format'); // If parsing fails, raise an exception raise Exception.Create('Invalid JSON format'); // If parsing fails, raise an exception
mode := JSONData.GetValue<string>('mode'); mode := JSONData.GetValue<string>('mode');
...@@ -1949,123 +1977,93 @@ begin ...@@ -1949,123 +1977,93 @@ begin
logger.Log(3, 'TLookupService.SetStatus'); logger.Log(3, 'TLookupService.SetStatus');
StatusInfo := TJSONObject.ParseJSONValue(statusOptions) as TJSONObject; StatusInfo := TJSONObject.ParseJSONValue(statusOptions) as TJSONObject;
params := TStringList.Create; params := TStringList.Create;
// parse the statusOptions try
params.Delimiter := '&'; params.Delimiter := '&';
params.StrictDelimiter := true; params.StrictDelimiter := true;
params.DelimitedText := statusOptions; params.DelimitedText := statusOptions;
ORDER_ID := StatusInfo.GetValue<integer>('ORDER_ID'); ORDER_ID := StatusInfo.GetValue<integer>('ORDER_ID');
Date := StatusInfo.GetValue<string>('date'); Date := StatusInfo.GetValue<string>('date');
Status := StatusInfo.GetValue<string>('status'); Status := StatusInfo.GetValue<string>('status');
UserID := StatusInfo.GetValue<string>('USER_ID'); UserID := StatusInfo.GetValue<string>('USER_ID');
OrderType := StatusInfo.GetValue<string>('OrderType'); OrderType := StatusInfo.GetValue<string>('OrderType');
{if ( (Status = 'PROOF') and (OrderType <> 'cutting die') ) then
begin
NextStatus := 'ART';
StatusField := 'staff_fields_art_due';
end
else if Status = 'ART' then
begin
NextStatus := 'PLATE';
StatusField := 'staff_fields_plate_due';
end
else if ( (Status = 'PLATE') and (OrderType <> 'web plate') ) then
begin
NextStatus := 'MOUNT';
StatusField := 'staff_fields_mount_due';
end
else
begin
NextStatus := 'SHIP';
StatusField := 'staff_fields_ship_date';
end;}
Date := DateToStr(StrToDate(Date) + 1); Date := DateToStr(StrToDate(Date) + 1);
SQL := 'select * from orders_status where ORDER_ID = ' + IntToStr(ORDER_ID) + ' AND ' + SQL := 'select * from orders_status where ORDER_ID = ' + IntToStr(ORDER_ID) + ' AND ' +
'ORDER_STATUS = ' + quotedStr(Status); 'ORDER_STATUS = ' + quotedStr(Status);
doQuery(ordersDB.UniQuery1, SQL); doQuery(ordersDB.UniQuery1, SQL);
if ordersDB.UniQuery1.IsEmpty then if ordersDB.UniQuery1.IsEmpty then
// Add Status // Add Status
begin begin
ordersDB.UniQuery1.Insert; ordersDB.UniQuery1.Insert;
ordersDB.UniQuery1.FieldByName('ORDER_ID').AsString := IntToStr(ORDER_ID); ordersDB.UniQuery1.FieldByName('ORDER_ID').AsString := IntToStr(ORDER_ID);
ordersDB.UniQuery1.FieldByName('ORDER_STATUS').AsString := Status; ordersDB.UniQuery1.FieldByName('ORDER_STATUS').AsString := Status;
ordersDB.UniQuery1.FieldByName('STATUS_DATE').AsDateTime := StrToDateTime(Date); ordersDB.UniQuery1.FieldByName('STATUS_DATE').AsDateTime := StrToDateTime(Date);
ordersDB.UniQuery1.FieldByName('STATUS_TIMESTAMP').AsDateTime := Now; ordersDB.UniQuery1.FieldByName('STATUS_TIMESTAMP').AsDateTime := Now;
ordersDB.UniQuery1.FieldByName('USER_ID').AsString := UserID; ordersDB.UniQuery1.FieldByName('USER_ID').AsString := UserID;
ordersDB.UniQuery1.FieldByName('ORDER_REVISION').AsInteger := 1; ordersDB.UniQuery1.FieldByName('ORDER_REVISION').AsInteger := 1;
end end
else else
// Edit Status // Edit Status
begin begin
ordersDB.UniQuery1.Edit; ordersDB.UniQuery1.Edit;
ordersDB.UniQuery1.FieldByName('STATUS_DATE').AsDateTime := StrToDateTime(Date); ordersDB.UniQuery1.FieldByName('STATUS_DATE').AsDateTime := StrToDateTime(Date);
ordersDB.UniQuery1.FieldByName('STATUS_TIMESTAMP').AsDateTime := Now; ordersDB.UniQuery1.FieldByName('STATUS_TIMESTAMP').AsDateTime := Now;
ordersDB.UniQuery1.FieldByName('ORDER_REVISION').AsInteger := ordersDB.UniQuery1.FieldByName('ORDER_REVISION').AsInteger + 1; ordersDB.UniQuery1.FieldByName('ORDER_REVISION').AsInteger := ordersDB.UniQuery1.FieldByName('ORDER_REVISION').AsInteger + 1;
end; end;
ordersDB.UniQuery1.Post; ordersDB.UniQuery1.Post;
if StatusInfo.GetValue<string>('staff_fields_ship_date') <> '12/30/1899' then if StatusInfo.GetValue<string>('staff_fields_ship_date') <> '12/30/1899' then
AddStatusSchedule('SHIP', StatusInfo, ORDER_ID); AddStatusSchedule('SHIP', StatusInfo, ORDER_ID);
if StatusInfo.GetValue<string>('staff_fields_art_due') <> '12/30/1899' then if StatusInfo.GetValue<string>('staff_fields_art_due') <> '12/30/1899' then
AddStatusSchedule('ART', StatusInfo, ORDER_ID); AddStatusSchedule('ART', StatusInfo, ORDER_ID);
if StatusInfo.GetValue<string>('staff_fields_plate_due') <> '12/30/1899' then if StatusInfo.GetValue<string>('staff_fields_plate_due') <> '12/30/1899' then
AddStatusSchedule('PLATE', StatusInfo, ORDER_ID); AddStatusSchedule('PLATE', StatusInfo, ORDER_ID);
if StatusInfo.GetValue<string>('staff_fields_mount_due') <> '12/30/1899' then if StatusInfo.GetValue<string>('staff_fields_mount_due') <> '12/30/1899' then
AddStatusSchedule('MOUNT', StatusInfo, ORDER_ID); AddStatusSchedule('MOUNT', StatusInfo, ORDER_ID);
if Status <> 'SHIP' then if Status <> 'SHIP' then
begin begin
order := TJSONObject.Create; order := TJSONObject.Create;
try try
{ SQL := 'select * from orders_status_schedule where ORDER_ID = ' + IntToStr(ORDER_ID) + ' AND ' + // update the order as well
'ORDER_STATUS = ' + quotedStr(NextStatus); if OrderType = 'web plate' then
table := 'web_plate_orders'
else if OrderType = 'cutting die' then
table := 'cutting_die_orders'
else
table := 'corrugated_plate_orders';
doQuery(ordersDB.UniQuery1, SQL);
if ordersDB.UniQuery1.IsEmpty then
order.AddPair('mode', 'ADD')
else
order.AddPair('mode', 'EDIT');
order.AddPair(StatusField, Date);
order.AddPair('USER_ID', UserID);
AddStatusSchedule(NextStatus, order, ORDER_ID); }
// update the order as well
if OrderType = 'web plate' then
table := 'web_plate_orders'
else if OrderType = 'cutting die' then
table := 'cutting_die_orders'
else
table := 'corrugated_plate_orders';
SQL := 'select * from ' + table + ' where ORDER_ID = ' + IntToStr(ORDER_ID);
doQuery(OrdersDB.UniQuery1, SQL);
OrdersDB.UniQuery1.Edit;
SQL := 'select * from ' + table + ' where ORDER_ID = ' + IntToStr(ORDER_ID); if StatusInfo.GetValue<string>('staff_fields_ship_date') <> '12/30/1899' then
doQuery(OrdersDB.UniQuery1, SQL); OrdersDB.UniQuery1.FieldByName('staff_fields_ship_date').AsString := StatusInfo.GetValue<string>('staff_fields_ship_date');
OrdersDB.UniQuery1.Edit; if StatusInfo.GetValue<string>('staff_fields_art_due') <> '12/30/1899' then
OrdersDB.UniQuery1.FieldByName('staff_fields_art_due').AsString := StatusInfo.GetValue<string>('staff_fields_art_due');
if StatusInfo.GetValue<string>('staff_fields_ship_date') <> '12/30/1899' then if StatusInfo.GetValue<string>('staff_fields_plate_due') <> '12/30/1899' then
OrdersDB.UniQuery1.FieldByName('staff_fields_ship_date').AsString := StatusInfo.GetValue<string>('staff_fields_ship_date'); OrdersDB.UniQuery1.FieldByName('staff_fields_plate_due').AsString := StatusInfo.GetValue<string>('staff_fields_plate_due');
if StatusInfo.GetValue<string>('staff_fields_art_due') <> '12/30/1899' then if StatusInfo.GetValue<string>('staff_fields_mount_due') <> '12/30/1899' then
OrdersDB.UniQuery1.FieldByName('staff_fields_art_due').AsString := StatusInfo.GetValue<string>('staff_fields_art_due'); OrdersDB.UniQuery1.FieldByName('staff_fields_mount_due').AsString := StatusInfo.GetValue<string>('staff_fields_mount_due');
if StatusInfo.GetValue<string>('staff_fields_plate_due') <> '12/30/1899' then OrdersDB.UniQuery1.Post;
OrdersDB.UniQuery1.FieldByName('staff_fields_plate_due').AsString := StatusInfo.GetValue<string>('staff_fields_plate_due');
if StatusInfo.GetValue<string>('staff_fields_mount_due') <> '12/30/1899' then
OrdersDB.UniQuery1.FieldByName('staff_fields_mount_due').AsString := StatusInfo.GetValue<string>('staff_fields_mount_due');
OrdersDB.UniQuery1.Post;
finally finally
order.Free; order.Free;
end;
end; end;
end;
result := 'success:Status Successfully set'; result := 'success:Status Successfully set';
except except
on E: Exception do on E: Exception do
logger.Log(2, 'An error occurred when setting status: ' + E.Message); logger.Log(2, 'An error occurred when setting status: ' + E.Message);
end;
finally
params.Free;
end; end;
end; end;
...@@ -2089,63 +2087,67 @@ var ...@@ -2089,63 +2087,67 @@ var
params: TStringList; params: TStringList;
begin begin
logger.Log(3, 'TLookupService.AddUser'); logger.Log(3, 'TLookupService.AddUser');
params := TStringList.Create;
try try
params := TStringList.Create; try
params.StrictDelimiter := True; params.StrictDelimiter := True;
params.Delimiter := '&'; params.Delimiter := '&';
params.DelimitedText := userInfo; params.DelimitedText := userInfo;
dateCreated := Now; dateCreated := Now;
user := params.Values['username']; user := params.Values['username'];
password := params.Values['password']; password := params.Values['password'];
full_name := params.Values['fullname']; full_name := params.Values['fullname'];
status := params.Values['status']; status := params.Values['status'];
email := params.Values['email']; email := params.Values['email'];
access := params.Values['access']; access := params.Values['access'];
rights := params.Values['rights']; rights := params.Values['rights'];
perspective := params.Values['perspective']; perspective := params.Values['perspective'];
QB := params.Values['QB']; QB := params.Values['QB'];
SQL := 'SELECT * FROM users WHERE USER_NAME = ' + QuotedStr(user.ToLower); SQL := 'SELECT * FROM users WHERE USER_NAME = ' + QuotedStr(user.ToLower);
ordersDB.UniQuery1.Close; ordersDB.UniQuery1.Close;
ordersDB.UniQuery1.SQL.Text := SQL; ordersDB.UniQuery1.SQL.Text := SQL;
ordersDB.UniQuery1.Open; ordersDB.UniQuery1.Open;
if ordersDB.UniQuery1.IsEmpty then if ordersDB.UniQuery1.IsEmpty then
begin begin
ordersDB.UniQuery1.Insert; ordersDB.UniQuery1.Insert;
ordersDB.UniQuery1.FieldByName('USER_NAME').AsString := user; ordersDB.UniQuery1.FieldByName('USER_NAME').AsString := user;
ordersDB.UniQuery1.FieldByName('PASSWORD').AsString := THashSHA2.GetHashString(full_name + password, THashSHA2.TSHA2Version.SHA512).ToUpper; ordersDB.UniQuery1.FieldByName('PASSWORD').AsString := THashSHA2.GetHashString(full_name + password, THashSHA2.TSHA2Version.SHA512).ToUpper;
ordersDB.UniQuery1.FieldByName('NAME').AsString := full_name; ordersDB.UniQuery1.FieldByName('NAME').AsString := full_name;
if StrToBoolDef(status, False) then if StrToBoolDef(status, False) then
ordersDB.UniQuery1.FieldByName('STATUS').AsString := 'ACTIVE' ordersDB.UniQuery1.FieldByName('STATUS').AsString := 'ACTIVE'
else else
ordersDB.UniQuery1.FieldByName('STATUS').AsString := 'INACTIVE'; ordersDB.UniQuery1.FieldByName('STATUS').AsString := 'INACTIVE';
ordersDB.UniQuery1.FieldByName('EMAIL').AsString := email; ordersDB.UniQuery1.FieldByName('EMAIL').AsString := email;
ordersDB.UniQuery1.FieldByName('ACCESS_TYPE').AsString := access; ordersDB.UniQuery1.FieldByName('ACCESS_TYPE').AsString := access;
if not TryStrToInt(rights, rightsInt) then if not TryStrToInt(rights, rightsInt) then
rightsInt := 0; rightsInt := 0;
ordersDB.UniQuery1.FieldByName('SYSTEM_RIGHTS').AsInteger := rightsInt; ordersDB.UniQuery1.FieldByName('SYSTEM_RIGHTS').AsInteger := rightsInt;
ordersDB.UniQuery1.FieldByName('PERSPECTIVE_ID').AsString := perspective; ordersDB.UniQuery1.FieldByName('PERSPECTIVE_ID').AsString := perspective;
ordersDB.UniQuery1.FieldByName('QB_ID').AsString := QB; ordersDB.UniQuery1.FieldByName('QB_ID').AsString := QB;
ordersDB.UniQuery1.Post; ordersDB.UniQuery1.Post;
Result := 'Success: User successfully added'; Result := 'Success: User successfully added';
end end
else else
Result := 'Failure: Username already taken'; Result := 'Failure: Username already taken';
except except
on E: Exception do on E: Exception do
begin begin
logger.Log(2, 'An error occurred in TlookupServiceImpl.AddUser: ' + E.Message); logger.Log(2, 'An error occurred in TlookupServiceImpl.AddUser: ' + E.Message);
raise EXDataHttpException.Create(500, 'Unable to Add User: A KG Orders database issue has occurred!'); raise EXDataHttpException.Create(500, 'Unable to Add User: A KG Orders database issue has occurred!');
end;
end; end;
finally
params.Free;
end; end;
end; end;
...@@ -2167,6 +2169,7 @@ begin ...@@ -2167,6 +2169,7 @@ begin
logger.Log(3, 'TLookupService.AddItem'); logger.Log(3, 'TLookupService.AddItem');
result := TJSONObject.Create; result := TJSONObject.Create;
JSONData := TJSONObject.ParseJSONValue(itemInfo) as TJSONObject; JSONData := TJSONObject.ParseJSONValue(itemInfo) as TJSONObject;
if JSONData = nil then if JSONData = nil then
raise Exception.Create('Invalid JSON format'); // If parsing fails, raise an exception raise Exception.Create('Invalid JSON format'); // If parsing fails, raise an exception
mode := JSONData.GetValue<string>('mode'); mode := JSONData.GetValue<string>('mode');
...@@ -2219,7 +2222,7 @@ begin ...@@ -2219,7 +2222,7 @@ begin
end; end;
except except
on E: Exception do on E: Exception do
logger.Log(2, 'An error occurred when adding an item: ' + E.Message); logger.Log(2, 'An error occurred when adding an item: ' + E.Message);
end; end;
...@@ -2231,8 +2234,7 @@ function TLookupService.DelUser(username: string): string; ...@@ -2231,8 +2234,7 @@ function TLookupService.DelUser(username: string): string;
// deleting users prematurely. // deleting users prematurely.
// username: username to be deleted. // username: username to be deleted.
var var
SQL: string; SQL: string;
params: TStringList;
begin begin
logger.Log(3, 'TLookupService.DelUser'); logger.Log(3, 'TLookupService.DelUser');
SQL := 'select * from users where username = ' + QuotedStr(username.toLower); SQL := 'select * from users where username = ' + QuotedStr(username.toLower);
......
kgOrdersServer/Source/QBServiceImplementation.pas
...@@ -98,7 +98,6 @@ var ...@@ -98,7 +98,6 @@ var
f: TStringList; f: TStringList;
fi: string; fi: string;
JSObj: TJSONObject; JSObj: TJSONObject;
iniFile: TIniFile;
Encoder: TBase64Encoding; Encoder: TBase64Encoding;
begin begin
// 1. Encode credentials (same as working Postman request) // 1. Encode credentials (same as working Postman request)
...@@ -129,7 +128,7 @@ begin ...@@ -129,7 +128,7 @@ begin
SSLIO.SSLOptions.SSLVersions := [sslvTLSv1_2]; SSLIO.SSLOptions.SSLVersions := [sslvTLSv1_2];
IdHTTP.IOHandler := SSLIO; IdHTTP.IOHandler := SSLIO;
// Set headers (EXACT match with Postman) // Set headers
IdHTTP.Request.ContentType := 'application/x-www-form-urlencoded'; IdHTTP.Request.ContentType := 'application/x-www-form-urlencoded';
IdHTTP.Request.Accept := 'application/json'; IdHTTP.Request.Accept := 'application/json';
IdHTTP.Request.CustomHeaders.AddValue('Authorization', 'Basic ' + EncodedAuth); IdHTTP.Request.CustomHeaders.AddValue('Authorization', 'Basic ' + EncodedAuth);
...@@ -162,7 +161,6 @@ end; ...@@ -162,7 +161,6 @@ end;
procedure TQBService.SaveTokens(AccessToken, RefreshToken: string); procedure TQBService.SaveTokens(AccessToken, RefreshToken: string);
var var
f: TStringList; f: TStringList;
iniStr, line: string;
iniFile: TIniFile; iniFile: TIniFile;
begin begin
iniFile := TIniFile.Create( ExtractFilePath(Application.ExeName) + 'kgOrdersServer.ini' ); iniFile := TIniFile.Create( ExtractFilePath(Application.ExeName) + 'kgOrdersServer.ini' );
......
kgOrdersServer/Source/qbAPI.dfm
...@@ -148,7 +148,7 @@ object fQB: TfQB ...@@ -148,7 +148,7 @@ object fQB: TfQB
OnClick = Button12Click OnClick = Button12Click
end end
object Button15: TButton object Button15: TButton
Left = 646 Left = 631
Top = 32 Top = 32
Width = 137 Width = 137
Height = 25 Height = 25
......
kgOrdersServer/Source/rOrderCorrugated.dfm
...@@ -7,7 +7,6 @@ object rptOrderCorrugated: TrptOrderCorrugated ...@@ -7,7 +7,6 @@ object rptOrderCorrugated: TrptOrderCorrugated
Database = 'kg_order_entry' Database = 'kg_order_entry'
Username = 'root' Username = 'root'
Server = '192.168.159.10' Server = '192.168.159.10'
Connected = True
LoginPrompt = False LoginPrompt = False
Left = 289 Left = 289
Top = 119 Top = 119
...@@ -53,442 +52,6 @@ object rptOrderCorrugated: TrptOrderCorrugated ...@@ -53,442 +52,6 @@ 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 = '2025.2.4' Version = '2025.2.4'
...@@ -4815,7 +4378,6 @@ object rptOrderCorrugated: TrptOrderCorrugated ...@@ -4815,7 +4378,6 @@ object rptOrderCorrugated: TrptOrderCorrugated
'select * from corrugated_plate_orders c join orders o on c.ORDER' + 'select * from corrugated_plate_orders c join orders o on c.ORDER' +
'_ID = o.ORDER_ID where c.ORDER_ID = 20646') '_ID = o.ORDER_ID where c.ORDER_ID = 20646')
Active = True
Left = 457 Left = 457
Top = 106 Top = 106
object uqOrderCorrugatedORDER_ID: TIntegerField object uqOrderCorrugatedORDER_ID: TIntegerField
......
kgOrdersServer/Source/rOrderCutting.dfm
...@@ -7,7 +7,6 @@ object rptOrderCutting: TrptOrderCutting ...@@ -7,7 +7,6 @@ object rptOrderCutting: TrptOrderCutting
Database = 'kg_order_entry' Database = 'kg_order_entry'
Username = 'root' Username = 'root'
Server = '192.168.159.10' Server = '192.168.159.10'
Connected = True
LoginPrompt = False LoginPrompt = False
Left = 289 Left = 289
Top = 119 Top = 119
...@@ -53,134 +52,6 @@ object rptOrderCutting: TrptOrderCutting ...@@ -53,134 +52,6 @@ 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 = '2025.2.4' Version = '2025.2.4'
...@@ -1782,7 +1653,6 @@ object rptOrderCutting: TrptOrderCutting ...@@ -1782,7 +1653,6 @@ object rptOrderCutting: TrptOrderCutting
'select * from cutting_die_orders c join orders o on c.ORDER_ID =' + 'select * from cutting_die_orders c join orders o on c.ORDER_ID =' +
' o.ORDER_ID where c.ORDER_ID = 20649') ' o.ORDER_ID where c.ORDER_ID = 20649')
Active = True
Left = 457 Left = 457
Top = 106 Top = 106
object uqOrderCuttingORDER_ID: TIntegerField object uqOrderCuttingORDER_ID: TIntegerField
......
kgOrdersServer/Source/rOrderWeb.dfm
...@@ -7,7 +7,6 @@ object rptOrderWeb: TrptOrderWeb ...@@ -7,7 +7,6 @@ object rptOrderWeb: TrptOrderWeb
Database = 'kg_order_entry' Database = 'kg_order_entry'
Username = 'root' Username = 'root'
Server = '192.168.159.10' Server = '192.168.159.10'
Connected = True
LoginPrompt = False LoginPrompt = False
Left = 289 Left = 289
Top = 119 Top = 119
...@@ -51,442 +50,6 @@ object rptOrderWeb: TrptOrderWeb ...@@ -51,442 +50,6 @@ 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 = '2025.2.4' Version = '2025.2.4'
...@@ -5082,7 +4645,6 @@ object rptOrderWeb: TrptOrderWeb ...@@ -5082,7 +4645,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 = 20648') '.ORDER_ID WHERE w.ORDER_ID = 20648')
Active = True
Left = 457 Left = 457
Top = 106 Top = 106
object uqOrderWebORDER_ID: TIntegerField object uqOrderWebORDER_ID: TIntegerField
......
kgOrdersServer/bin/kgOrdersServer.ini
...@@ -2,7 +2,7 @@ ...@@ -2,7 +2,7 @@
MemoLogLevel=4 MemoLogLevel=4
FileLogLevel=4 FileLogLevel=4
webClientVersion=1.0.0 webClientVersion=1.0.0
LogFileNum=126 LogFileNum=158
[Database] [Database]
--Server=192.168.116.138 --Server=192.168.116.138
...@@ -15,6 +15,7 @@ Password=emsys01 ...@@ -15,6 +15,7 @@ Password=emsys01
--Password=emsys!012 --Password=emsys!012
[Quickbooks] [Quickbooks]
Enabled=0
CompanyID=9341454336461805 CompanyID=9341454336461805
ClientID=ABYqlDx1EsacZYXvHIJ7RDB7zmnQdwABU3fwQLIZPmBgU0VW1P ClientID=ABYqlDx1EsacZYXvHIJ7RDB7zmnQdwABU3fwQLIZPmBgU0VW1P
ClientSecret=PM7OnvQWsgOqjWfDpZAnyRttDN9446Am6d85pDxr ClientSecret=PM7OnvQWsgOqjWfDpZAnyRttDN9446Am6d85pDxr
......
kgOrdersServer/bin/kgOrdersServer_MemoryManager_EventLog.txt
...@@ -18630,3 +18630,343 @@ This application has leaked memory. The small block leaks are (excluding expecte ...@@ -18630,3 +18630,343 @@ This application has leaked memory. The small block leaks are (excluding expecte
213 - 244 bytes: UnicodeString x 28 213 - 244 bytes: UnicodeString x 28
Note: Memory leak detail is logged to a text file in the same folder as this application. To disable this memory leak check, undefine "EnableMemoryLeakReporting". Note: Memory leak detail is logged to a text file in the same folder as this application. To disable this memory leak check, undefine "EnableMemoryLeakReporting".
--------------------------------2025/11/21 15:17:16--------------------------------
FastMM has detected an attempt to call a virtual method on a freed object. An access violation will now be raised in order to abort the current operation.
Freed object class: System.JSON.TJSONArray
Virtual method: Destroy
Virtual method address: 893A9C
The allocation number was: 232624
The object was allocated by thread 0x212C, and the stack trace (return addresses) at the time was:
4FA10F [System.pas][System][TObject.NewInstance][18357]
4FA812 [System.pas][System][@ClassCreate$qqrpvzc][19687]
893952 [System.JSON.pas][System.JSON][Json.TJSONArray.Create][3392]
890509 [System.JSON.pas][System.JSON][Json.TJSONByteReader.FlushString][1843]
8908F7 [System.JSON.pas][System.JSON][Json.TJSONValue.ParseArray][2031]
890A96 [System.JSON.pas][System.JSON][Json.TJSONValue.ParseValue][2084]
890842 [System.JSON.pas][System.JSON][Json.TJSONValue.ParsePair][2013]
8936A7 [System.JSON.pas][System.JSON][Json.TJSONObject.Parse][3281]
8907A6 [System.JSON.pas][System.JSON][Json.TJSONValue.ParseObject][1992]
890A84 [System.JSON.pas][System.JSON][Json.TJSONValue.ParseValue][2082]
891432 [System.JSON.pas][System.JSON][Json.TJSONValue.ParseJSONValue][2331]
The object was subsequently freed by thread 0x212C, and the stack trace (return addresses) at the time was:
4FA12D [System.pas][System][TObject.FreeInstance][18366]
4FA85D [System.pas][System][@ClassDestroy$qqrxp14System.TObject][19730]
893B1F [System.JSON.pas][System.JSON][Json.TJSONArray.Destroy][3438]
4FA223 [System.pas][System][TObject.Free][18429]
892BB1 [System.JSON.pas][System.JSON][Json.TJSONPair.Destroy][2893]
4FA223 [System.pas][System][TObject.Free][18429]
892F08 [System.JSON.pas][System.JSON][Json.TJSONObject.Destroy][3049]
4FA223 [System.pas][System][TObject.Free][18429]
1EE2131 [Lookup.ServiceImpl.pas][Lookup.ServiceImpl][Serviceimpl.TLookupService.GetColorCount][1166]
1EE26DB [Lookup.ServiceImpl.pas][Lookup.ServiceImpl][Serviceimpl.TLookupService.GetOrders][1240]
580620 [System.Rtti.pas][System.Rtti][Rtti.RawInvoke$qqrpvp23System.Rtti.TParamBlock][8726]
The current thread ID is 0x212C, and the stack trace (return addresses) leading to this error is:
4FA223 [System.pas][System][TObject.Free][18429]
1EE2139 [Lookup.ServiceImpl.pas][Lookup.ServiceImpl][Serviceimpl.TLookupService.GetColorCount][1167]
1EE26DB [Lookup.ServiceImpl.pas][Lookup.ServiceImpl][Serviceimpl.TLookupService.GetOrders][1240]
580620 [System.Rtti.pas][System.Rtti][Rtti.RawInvoke$qqrpvp23System.Rtti.TParamBlock][8726]
580A05 [System.Rtti.pas][System.Rtti][Rtti.Invoke$qqrpvx42System.%DynamicArray$18System.Rtti.TValue%24System.Typinfo.TCallConvp24System.Typinfo.TTypeInfooo][8971]
4FE445 [System.pas][System][@FinalizeRecord$qqrpvt1][33317]
B1F7BD [XData.Aurelius.Model.pas][XData.Aurelius.Model][Aurelius.Model.TXDataAureliusModel.GetActionInfo][490]
6CF9336 [GetRawStackTrace]
512C30 [FastMM4.pas][FastMM4][FastFreeMem$qqrpv][6336]
5141B8 [FastMM4.pas][FastMM4][DebugFreeMem$qqrpv][9847]
5141CD [FastMM4.pas][FastMM4][DebugFreeMem$qqrpv][9854]
Current memory dump of 256 bytes starting at pointer address 7DAD3360:
8C CC FC 01 80 80 80 80 80 80 80 80 80 80 80 80 3A 72 F7 74 80 80 80 80 00 00 00 00 60 D9 AC 7D
00 00 00 00 00 00 00 00 48 3F 51 00 00 00 00 00 C7 82 03 00 BA 72 4F 00 0F A1 4F 00 12 A8 4F 00
F4 A1 4F 00 80 E5 C9 00 91 CF CA 00 94 CE CA 00 06 D5 CA 00 DF E8 CA 00 7B EA CA 00 6A C3 EE 00
2C 21 00 00 2C 21 00 00 2D A1 4F 00 5D A8 4F 00 16 A2 4F 00 23 A2 4F 00 E2 05 EC 00 C8 E0 EC 00
D5 A6 EC 00 BC 2B ED 00 CD 85 EE 00 67 8B EE 00 92 8C EE 00 14 00 00 00 60 76 CA 00 5D E0 76 8D
C8 4A 59 00 78 CC A9 7D 0A 00 00 00 0C 00 00 00 00 00 00 00 A2 1F 89 72 00 00 00 00 60 D9 AC 7D
00 00 00 00 00 00 00 00 48 3F 51 00 00 00 00 00 C4 82 03 00 BA 72 4F 00 0F A1 4F 00 12 A8 4F 00
F4 A1 4F 00 80 E5 C9 00 91 CF CA 00 94 CE CA 00 06 D5 CA 00 DF E8 CA 00 7B EA CA 00 6A C3 EE 00
. : r t . . . . ` }
. . . . . . . . H ? Q . . . . . . . r O . . O . . O .
O . . . . . . . { . j .
, ! . . , ! . . - O . ] O . . O . # O . . . .
. + . . g . . . . . . ` v . ] v
J Y . x } . . . . . . . . . . . . . r . . . . ` }
. . . . . . . . H ? Q . . . . . . . r O . . O . . O .
O . . . . . . . { . j .
--------------------------------2025/11/21 15:18:16--------------------------------
FastMM has detected an attempt to call a virtual method on a freed object. An access violation will now be raised in order to abort the current operation.
Freed object class: System.JSON.TJSONArray
Virtual method: Destroy
Virtual method address: ED3A9C
The allocation number was: 232619
The object was allocated by thread 0x2B18, and the stack trace (return addresses) at the time was:
B3A10F [System.pas][System][TObject.NewInstance][18357]
B3A812 [System.pas][System][@ClassCreate$qqrpvzc][19687]
ED3952 [System.JSON.pas][System.JSON][Json.TJSONArray.Create][3392]
ED0509 [System.JSON.pas][System.JSON][Json.TJSONByteReader.FlushString][1843]
ED08F7 [System.JSON.pas][System.JSON][Json.TJSONValue.ParseArray][2031]
ED0A96 [System.JSON.pas][System.JSON][Json.TJSONValue.ParseValue][2084]
ED0842 [System.JSON.pas][System.JSON][Json.TJSONValue.ParsePair][2013]
ED36A7 [System.JSON.pas][System.JSON][Json.TJSONObject.Parse][3281]
ED07A6 [System.JSON.pas][System.JSON][Json.TJSONValue.ParseObject][1992]
ED0A84 [System.JSON.pas][System.JSON][Json.TJSONValue.ParseValue][2082]
ED1432 [System.JSON.pas][System.JSON][Json.TJSONValue.ParseJSONValue][2331]
The object was subsequently freed by thread 0x2B18, and the stack trace (return addresses) at the time was:
B3A12D [System.pas][System][TObject.FreeInstance][18366]
B3A85D [System.pas][System][@ClassDestroy$qqrxp14System.TObject][19730]
ED3B1F [System.JSON.pas][System.JSON][Json.TJSONArray.Destroy][3438]
B3A223 [System.pas][System][TObject.Free][18429]
ED2BB1 [System.JSON.pas][System.JSON][Json.TJSONPair.Destroy][2893]
B3A223 [System.pas][System][TObject.Free][18429]
ED2F08 [System.JSON.pas][System.JSON][Json.TJSONObject.Destroy][3049]
B3A223 [System.pas][System][TObject.Free][18429]
2522105 [Lookup.ServiceImpl.pas][Lookup.ServiceImpl][Serviceimpl.TLookupService.GetColorCount][1166]
25226AF [Lookup.ServiceImpl.pas][Lookup.ServiceImpl][Serviceimpl.TLookupService.GetOrders][1240]
BC0620 [System.Rtti.pas][System.Rtti][Rtti.RawInvoke$qqrpvp23System.Rtti.TParamBlock][8726]
The current thread ID is 0x2B18, and the stack trace (return addresses) leading to this error is:
B3A223 [System.pas][System][TObject.Free][18429]
252210D [Lookup.ServiceImpl.pas][Lookup.ServiceImpl][Serviceimpl.TLookupService.GetColorCount][1167]
25226AF [Lookup.ServiceImpl.pas][Lookup.ServiceImpl][Serviceimpl.TLookupService.GetOrders][1240]
BC0620 [System.Rtti.pas][System.Rtti][Rtti.RawInvoke$qqrpvp23System.Rtti.TParamBlock][8726]
BC0A05 [System.Rtti.pas][System.Rtti][Rtti.Invoke$qqrpvx42System.%DynamicArray$18System.Rtti.TValue%24System.Typinfo.TCallConvp24System.Typinfo.TTypeInfooo][8971]
B3E445 [System.pas][System][@FinalizeRecord$qqrpvt1][33317]
115F7BD [XData.Aurelius.Model.pas][XData.Aurelius.Model][Aurelius.Model.TXDataAureliusModel.GetActionInfo][490]
429336 [GetRawStackTrace]
B52C30 [FastMM4.pas][FastMM4][FastFreeMem$qqrpv][6336]
B541B8 [FastMM4.pas][FastMM4][DebugFreeMem$qqrpv][9847]
B541CD [FastMM4.pas][FastMM4][DebugFreeMem$qqrpv][9854]
Current memory dump of 256 bytes starting at pointer address 7D203400:
8C CC 60 02 80 80 80 80 80 80 80 80 80 80 80 80 1F 5E 88 6C 80 80 80 80 00 00 00 00 60 D9 1F 7D
00 00 00 00 00 00 00 00 48 3F B5 00 00 00 00 00 C2 82 03 00 BA 72 B3 00 0F A1 B3 00 12 A8 B3 00
F4 A1 B3 00 80 E5 2D 01 91 CF 2E 01 94 CE 2E 01 06 D5 2E 01 DF E8 2E 01 7B EA 2E 01 6A C3 52 01
18 2B 00 00 18 2B 00 00 2D A1 B3 00 5D A8 B3 00 16 A2 B3 00 23 A2 B3 00 E2 05 50 01 C8 E0 50 01
D5 A6 50 01 BC 2B 51 01 CD 85 52 01 67 8B 52 01 92 8C 52 01 14 00 00 00 60 76 2E 01 D0 F4 49 96
C8 4A BD 00 78 CC 1C 7D 0A 00 00 00 0C 00 00 00 00 00 00 00 2F 0B B6 69 00 00 00 00 60 D9 1F 7D
00 00 00 00 00 00 00 00 48 3F B5 00 00 00 00 00 BF 82 03 00 BA 72 B3 00 0F A1 B3 00 12 A8 B3 00
F4 A1 B3 00 80 E5 2D 01 91 CF 2E 01 94 CE 2E 01 06 D5 2E 01 DF E8 2E 01 7B EA 2E 01 6A C3 52 01
` . . ^ l . . . . ` . }
. . . . . . . . H ? . . . . . . . r . . . . .
. - . . . . . . . . . . { . . j R .
. + . . . + . . - . ] . . . # . . P . P .
P . + Q . R . g R . R . . . . . ` v . . I
J . x . } . . . . . . . . . . . . / . i . . . . ` . }
. . . . . . . . H ? . . . . . . . r . . . . .
. - . . . . . . . . . . { . . j R .
--------------------------------2025/11/21 15:20:54--------------------------------
FastMM has detected an attempt to call a virtual method on a freed object. An access violation will now be raised in order to abort the current operation.
Freed object class: System.JSON.TJSONArray
Virtual method: Destroy
Virtual method address: 1143A9C
The allocation number was: 232619
The object was allocated by thread 0x32A4, and the stack trace (return addresses) at the time was:
DAA10F [System.pas][System][TObject.NewInstance][18357]
DAA812 [System.pas][System][@ClassCreate$qqrpvzc][19687]
1143952 [System.JSON.pas][System.JSON][Json.TJSONArray.Create][3392]
1140509 [System.JSON.pas][System.JSON][Json.TJSONByteReader.FlushString][1843]
11408F7 [System.JSON.pas][System.JSON][Json.TJSONValue.ParseArray][2031]
1140A96 [System.JSON.pas][System.JSON][Json.TJSONValue.ParseValue][2084]
1140842 [System.JSON.pas][System.JSON][Json.TJSONValue.ParsePair][2013]
11436A7 [System.JSON.pas][System.JSON][Json.TJSONObject.Parse][3281]
11407A6 [System.JSON.pas][System.JSON][Json.TJSONValue.ParseObject][1992]
1140A84 [System.JSON.pas][System.JSON][Json.TJSONValue.ParseValue][2082]
1141432 [System.JSON.pas][System.JSON][Json.TJSONValue.ParseJSONValue][2331]
The object was subsequently freed by thread 0x32A4, and the stack trace (return addresses) at the time was:
DAA12D [System.pas][System][TObject.FreeInstance][18366]
DAA85D [System.pas][System][@ClassDestroy$qqrxp14System.TObject][19730]
1143B1F [System.JSON.pas][System.JSON][Json.TJSONArray.Destroy][3438]
DAA223 [System.pas][System][TObject.Free][18429]
1142BB1 [System.JSON.pas][System.JSON][Json.TJSONPair.Destroy][2893]
DAA223 [System.pas][System][TObject.Free][18429]
1142F08 [System.JSON.pas][System.JSON][Json.TJSONObject.Destroy][3049]
DAA223 [System.pas][System][TObject.Free][18429]
2792131 [Lookup.ServiceImpl.pas][Lookup.ServiceImpl][Serviceimpl.TLookupService.GetColorCount][1166]
27926DB [Lookup.ServiceImpl.pas][Lookup.ServiceImpl][Serviceimpl.TLookupService.GetOrders][1240]
E30620 [System.Rtti.pas][System.Rtti][Rtti.RawInvoke$qqrpvp23System.Rtti.TParamBlock][8726]
The current thread ID is 0x32A4, and the stack trace (return addresses) leading to this error is:
DAA223 [System.pas][System][TObject.Free][18429]
2792139 [Lookup.ServiceImpl.pas][Lookup.ServiceImpl][Serviceimpl.TLookupService.GetColorCount][1167]
27926DB [Lookup.ServiceImpl.pas][Lookup.ServiceImpl][Serviceimpl.TLookupService.GetOrders][1240]
E30620 [System.Rtti.pas][System.Rtti][Rtti.RawInvoke$qqrpvp23System.Rtti.TParamBlock][8726]
E30A05 [System.Rtti.pas][System.Rtti][Rtti.Invoke$qqrpvx42System.%DynamicArray$18System.Rtti.TValue%24System.Typinfo.TCallConvp24System.Typinfo.TTypeInfooo][8971]
DAE445 [System.pas][System][@FinalizeRecord$qqrpvt1][33317]
13CF7BD [XData.Aurelius.Model.pas][XData.Aurelius.Model][Aurelius.Model.TXDataAureliusModel.GetActionInfo][490]
429336 [GetRawStackTrace]
DC2C30 [FastMM4.pas][FastMM4][FastFreeMem$qqrpv][6336]
DC41B8 [FastMM4.pas][FastMM4][DebugFreeMem$qqrpv][9847]
DC41CD [FastMM4.pas][FastMM4][DebugFreeMem$qqrpv][9854]
Current memory dump of 256 bytes starting at pointer address 7D813360:
8C CC 87 02 80 80 80 80 80 80 80 80 80 80 80 80 4F 4F A6 68 80 80 80 80 00 00 00 00 60 D9 80 7D
00 00 00 00 00 00 00 00 48 3F DC 00 00 00 00 00 C2 82 03 00 BA 72 DA 00 0F A1 DA 00 12 A8 DA 00
F4 A1 DA 00 80 E5 54 01 91 CF 55 01 94 CE 55 01 06 D5 55 01 DF E8 55 01 7B EA 55 01 6A C3 79 01
A4 32 00 00 A4 32 00 00 2D A1 DA 00 5D A8 DA 00 16 A2 DA 00 23 A2 DA 00 E2 05 77 01 C8 E0 77 01
D5 A6 77 01 BC 2B 78 01 CD 85 79 01 67 8B 79 01 92 8C 79 01 14 00 00 00 60 76 55 01 48 03 53 9A
C8 4A E4 00 78 CC 7D 7D 0A 00 00 00 0C 00 00 00 00 00 00 00 B7 FC AC 65 00 00 00 00 60 D9 80 7D
00 00 00 00 00 00 00 00 48 3F DC 00 00 00 00 00 BF 82 03 00 BA 72 DA 00 0F A1 DA 00 12 A8 DA 00
F4 A1 DA 00 80 E5 54 01 91 CF 55 01 94 CE 55 01 06 D5 55 01 DF E8 55 01 7B EA 55 01 6A C3 79 01
. O O h . . . . ` }
. . . . . . . . H ? . . . . . . . r . . . . .
. T . U . U . . U . U . { U . j y .
2 . . 2 . . - . ] . . . # . . w . w .
w . + x . y . g y . y . . . . . ` v U . H . S
J . x } } . . . . . . . . . . . . e . . . . ` }
. . . . . . . . H ? . . . . . . . r . . . . .
. T . U . U . . U . U . { U . j y .
--------------------------------2025/11/21 15:22:53--------------------------------
FastMM has detected an attempt to call a virtual method on a freed object. An access violation will now be raised in order to abort the current operation.
Freed object class: System.JSON.TJSONObject
Virtual method: GetHashCode
Virtual method address: 11A33C
The allocation number was: 643128
The object was allocated by thread 0x2E14, and the stack trace (return addresses) at the time was:
1172BA [System.pas][System][@GetMem$qqri][4966]
11A10F [System.pas][System][TObject.NewInstance][18357]
11A812 [System.pas][System][@ClassCreate$qqrpvzc][19687]
4B2D26 [System.JSON.pas][System.JSON][Json.TJSONObject.Create][2962]
11A880 [System.pas][System][@AfterConstruction$qqrxp14System.TObject][19736]
4B078E [System.JSON.pas][System.JSON][Json.TJSONValue.ParseObject][1990]
4B0A84 [System.JSON.pas][System.JSON][Json.TJSONValue.ParseValue][2082]
4B1432 [System.JSON.pas][System.JSON][Json.TJSONValue.ParseJSONValue][2331]
4B1601 [System.JSON.pas][System.JSON][Json.TJSONValue.ParseJSONValue][2389]
1B09A99 [Lookup.ServiceImpl.pas][Lookup.ServiceImpl][Serviceimpl.TLookupService.AddCorrugatedOrder][1837]
1A0620 [System.Rtti.pas][System.Rtti][Rtti.RawInvoke$qqrpvp23System.Rtti.TParamBlock][8726]
The object was subsequently freed by thread 0x2E14, and the stack trace (return addresses) at the time was:
11A12D [System.pas][System][TObject.FreeInstance][18366]
11A85D [System.pas][System][@ClassDestroy$qqrxp14System.TObject][19730]
4B2F39 [System.JSON.pas][System.JSON][Json.TJSONObject.Destroy][3054]
11A223 [System.pas][System][TObject.Free][18429]
1B0A1A7 [Lookup.ServiceImpl.pas][Lookup.ServiceImpl][Serviceimpl.TLookupService.AddCorrugatedOrder][1916]
1A0620 [System.Rtti.pas][System.Rtti][Rtti.RawInvoke$qqrpvp23System.Rtti.TParamBlock][8726]
1A0A05 [System.Rtti.pas][System.Rtti][Rtti.Invoke$qqrpvx42System.%DynamicArray$18System.Rtti.TValue%24System.Typinfo.TCallConvp24System.Typinfo.TTypeInfooo][8971]
11E445 [System.pas][System][@FinalizeRecord$qqrpvt1][33317]
73F7BD [XData.Aurelius.Model.pas][XData.Aurelius.Model][Aurelius.Model.TXDataAureliusModel.GetActionInfo][490]
6909336 [GetRawStackTrace]
132C30 [FastMM4.pas][FastMM4][FastFreeMem$qqrpv][6336]
The current thread ID is 0x2E14, and the stack trace (return addresses) leading to this error is:
176B99 [System.Generics.Defaults.pas][System.Generics.Defaults][Generics.Defaults.GetHashCode_Class$qqrp40System.Generics.Defaults.TSimpleInstancexp14System.TObject][1201]
499226 [System.Generics.Collections.pas][Bcl.Json.BaseObjectConverter][Generics.Collections.%TDictionary__2$p14System.TObjecti%.Hash][7854]
499F9F [System.Generics.Collections.pas][Bcl.Json.BaseObjectConverter][Generics.Collections.%TDictionary__2$p14System.TObjecti%.ContainsKey][8197]
77FD2A [Bcl.Collections.pas][XData.Payload.Reader][Collections.%THashSet__1$p14System.TObject%.Contains][482]
7EEF47 [XData.Server.Module.pas][XData.Server.Module][Server.Module.TActionExecuter.Execute][2913]
11B654 [System.pas][System][@HandleFinally$qqrv][22108]
4C4FB8 [System.Rtti.pas][Bcl.Json.ValueConverter][Rtti.TValue.%AsType$p22System.Json.TJSONValue%$qqrxo$p22System.Json.TJSONValue][2711]
774E4522 [Unknown function at RtlInterlockedCompareExchange64]
774E44F4 [Unknown function at RtlInterlockedCompareExchange64]
7749EA32 [RtlUnwind]
96DFF2 [CRVio][ReadFromBuffer]
Current memory dump of 256 bytes starting at pointer address 7D6A7770:
8C CC BE 01 80 80 80 80 80 80 80 80 80 80 80 80 42 21 2A 75 80 80 80 80 00 00 00 00 30 3F 6A 7D
00 00 00 00 00 00 00 00 48 3F 13 00 00 00 00 00 4C CE 09 00 BA 72 11 00 97 C0 11 00 34 C5 11 00
C8 5F 1E 00 D5 8C 1E 00 12 A8 11 00 4D D2 9C 00 98 1D 9C 00 EF 6A 9F 00 68 FF 1E 00 95 01 1F 00
14 2E 00 00 BC 03 00 00 D6 72 11 00 51 C1 11 00 04 E4 11 00 0D A2 11 00 F1 A2 11 00 26 A1 11 00
5D A8 11 00 96 7F 1E 00 23 A2 11 00 A2 1F 9C 00 23 A2 11 00 12 00 00 00 B0 04 02 00 E5 2E 7D 81
B0 04 02 00 01 00 00 00 02 00 00 00 0D 00 0A 00 00 00 1A D1 82 7E 80 80 00 00 00 00 30 3F 6A 7D
00 00 00 00 00 00 00 00 48 3F 13 00 00 00 00 00 8A C4 09 00 BA 72 11 00 0F A1 11 00 12 A8 11 00
36 0A 69 00 FA 09 69 00 73 08 69 00 65 8E 8B 00 52 94 8B 00 B3 8C 8B 00 4C 92 8B 00 74 D6 77 00
. B ! * u . . . . 0 ? j }
. . . . . . . . H ? . . . . . . L . . r . . . . 4 . .
_ . . . . . . . M . . . j . h . . . . .
. . . . . . . r . . Q . . . . . . . . . . & . .
] . .  . . # . . . . # . . . . . . . . . . }
. . . . . . . . . . . . . . . . . . ~ . . . . 0 ? j }
. . . . . . . . H ? . . . . . . . . r . . . . . . . .
6 . i . . i . s . i . e . R . . L . t w .
--------------------------------2025/11/21 15:22:55--------------------------------
FastMM has detected an attempt to call a virtual method on a freed object. An access violation will now be raised in order to abort the current operation.
Freed object class: System.JSON.TJSONObject
Virtual method: Destroy
Virtual method address: 4B2ED4
The allocation number was: 643128
The object was allocated by thread 0x2E14, and the stack trace (return addresses) at the time was:
1172BA [System.pas][System][@GetMem$qqri][4966]
11A10F [System.pas][System][TObject.NewInstance][18357]
11A812 [System.pas][System][@ClassCreate$qqrpvzc][19687]
4B2D26 [System.JSON.pas][System.JSON][Json.TJSONObject.Create][2962]
11A880 [System.pas][System][@AfterConstruction$qqrxp14System.TObject][19736]
4B078E [System.JSON.pas][System.JSON][Json.TJSONValue.ParseObject][1990]
4B0A84 [System.JSON.pas][System.JSON][Json.TJSONValue.ParseValue][2082]
4B1432 [System.JSON.pas][System.JSON][Json.TJSONValue.ParseJSONValue][2331]
4B1601 [System.JSON.pas][System.JSON][Json.TJSONValue.ParseJSONValue][2389]
1B09A99 [Lookup.ServiceImpl.pas][Lookup.ServiceImpl][Serviceimpl.TLookupService.AddCorrugatedOrder][1837]
1A0620 [System.Rtti.pas][System.Rtti][Rtti.RawInvoke$qqrpvp23System.Rtti.TParamBlock][8726]
The object was subsequently freed by thread 0x2E14, and the stack trace (return addresses) at the time was:
11A12D [System.pas][System][TObject.FreeInstance][18366]
11A85D [System.pas][System][@ClassDestroy$qqrxp14System.TObject][19730]
4B2F39 [System.JSON.pas][System.JSON][Json.TJSONObject.Destroy][3054]
11A223 [System.pas][System][TObject.Free][18429]
1B0A1A7 [Lookup.ServiceImpl.pas][Lookup.ServiceImpl][Serviceimpl.TLookupService.AddCorrugatedOrder][1916]
1A0620 [System.Rtti.pas][System.Rtti][Rtti.RawInvoke$qqrpvp23System.Rtti.TParamBlock][8726]
1A0A05 [System.Rtti.pas][System.Rtti][Rtti.Invoke$qqrpvx42System.%DynamicArray$18System.Rtti.TValue%24System.Typinfo.TCallConvp24System.Typinfo.TTypeInfooo][8971]
11E445 [System.pas][System][@FinalizeRecord$qqrpvt1][33317]
73F7BD [XData.Aurelius.Model.pas][XData.Aurelius.Model][Aurelius.Model.TXDataAureliusModel.GetActionInfo][490]
6909336 [GetRawStackTrace]
132C30 [FastMM4.pas][FastMM4][FastFreeMem$qqrpv][6336]
The current thread ID is 0x2E14, and the stack trace (return addresses) leading to this error is:
11A223 [System.pas][System][TObject.Free][18429]
7EA24B [XData.Server.Module.pas][XData.Server.Module][Server.Module.TXDataRequestHandler.DestroyIfNotInManagers][1679]
49A25D [System.Generics.Collections.pas][Bcl.Json.BaseObjectConverter][Generics.Collections.%TDictionary__2$p14System.TObjecti%.TKeyEnumerator.DoGetCurrent][8279]
7E82A3 [XData.Server.Module.pas][XData.Server.Module][Server.Module.TXDataRequestHandler.CleanUp][1267]
7890CC [XData.Module.Base.pas][XData.Module.Base][Module.Base.TXDataBaseRequestHandler.InnerProcessRequest][869]
11B654 [System.pas][System][@HandleFinally$qqrv][22108]
774E4522 [Unknown function at RtlInterlockedCompareExchange64]
774E44F4 [Unknown function at RtlInterlockedCompareExchange64]
7749EA32 [RtlUnwind]
68E44E5
774AA77C [ZwRaiseException]
Current memory dump of 256 bytes starting at pointer address 7D6A7770:
8C CC BE 01 80 80 80 80 80 80 80 80 80 80 80 80 42 21 2A 75 80 80 80 80 00 00 00 00 11 84 6A 7D
00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 4C CE 09 00 BA 72 11 00 97 C0 11 00 34 C5 11 00
C8 5F 1E 00 D5 8C 1E 00 12 A8 11 00 4D D2 9C 00 98 1D 9C 00 EF 6A 9F 00 68 FF 1E 00 95 01 1F 00
14 2E 00 00 14 2E 00 00 D6 72 11 00 51 C1 11 00 04 E4 11 00 0D A2 11 00 F1 A2 11 00 26 A1 11 00
5D A8 11 00 96 7F 1E 00 23 A2 11 00 93 D2 9C 00 23 A2 11 00 12 00 00 00 B0 04 02 00 E6 CC 6A 81
8C CC BE 01 80 80 80 80 80 80 80 80 80 80 80 80 80 80 19 33 95 7E 80 80 00 00 00 00 30 3F 6A 7D
00 00 00 00 00 00 00 00 48 3F 13 00 00 00 00 00 8A C4 09 00 BA 72 11 00 0F A1 11 00 12 A8 11 00
36 0A 69 00 FA 09 69 00 73 08 69 00 65 8E 8B 00 52 94 8B 00 B3 8C 8B 00 4C 92 8B 00 74 D6 77 00
. B ! * u . . . . . j }
. . . . . . . . . . . . . . . . L . . r . . . . 4 . .
_ . . . . . . . M . . . j . h . . . . .
. . . . . . . . r . . Q . . . . . . . . . . & . .
] . .  . . # . . . # . . . . . . . . . j
. . 3 ~ . . . . 0 ? j }
. . . . . . . . H ? . . . . . . . . r . . . . . . . .
6 . i . . i . s . i . e . R . . L . t w .
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