Skip to content

K
kgOrders
Commit baa3b955 by Elias Sarraf
Options

Merge remote-tracking branch 'origin/cam'

parents 245de583 bb45ab03
Showing with 1153 additions and 696 deletions
kgOrdersClient/Auth.Service.pas
......@@ -109,6 +109,7 @@ procedure TAuthService.Login(AUser, APassword: string; ASuccess: TOnLoginSuccess
end;
begin
console.log('login');
if (AUser = '') or (APassword = '') then
begin
AError('Please enter a username and a password');
......
kgOrdersClient/ConnectionModule.pas
unit ConnectionModule;
unit ConnectionModule;
interface
uses
System.SysUtils, System.Classes, WEBLib.Modules, XData.Web.Connection,
App.Types, App.Config, XData.Web.Client;
System.SysUtils, System.Classes, WEBLib.Modules, WEBLib.Dialogs,
App.Types, App.Config, XData.Web.Connection, XData.Web.Client;
type
TDMConnection = class(TWebDataModule)
......@@ -19,7 +19,7 @@ type
FUnauthorizedAccessProc: TUnauthorizedAccessProc;
public
const clientVersion = '0.9.15.1';
const clientVersion = '0.9.15.5';
procedure InitApp(SuccessProc: TSuccessProc;
UnauthorizedAccessProc: TUnauthorizedAccessProc);
procedure SetClientConfig(Callback: TVersionCheckCallback);
......@@ -42,8 +42,17 @@ uses
{$R *.dfm}
procedure TDMConnection.ApiConnectionError(Error: TXDataWebConnectionError);
var
errorMsg: string;
begin
TFViewErrorPage.DisplayConnectionError(Error);
errorMsg := Error.ErrorMessage;
if errorMsg = '' then
errorMsg := 'Connection error';
if Assigned(FUnauthorizedAccessProc) then
FUnauthorizedAccessProc(errorMsg)
else
ShowMessage(errorMsg);
end;
......@@ -63,8 +72,19 @@ end;
procedure TDMConnection.AuthConnectionError(Error: TXDataWebConnectionError);
var
errorMsg: string;
begin
TFViewErrorPage.DisplayConnectionError(Error);
errorMsg := Error.ErrorMessage;
if errorMsg = '' then
errorMsg := 'Connection error';
if errorMsg = 'Error connecting to XData server' then
ShowMessage( 'Error connecting to kgOrdersServer' + sLineBreak + 'Please contact EM Systems support' )
else if Assigned(FUnauthorizedAccessProc) then
FUnauthorizedAccessProc(errorMsg)
else
ShowMessage(errorMsg);
end;
......@@ -87,13 +107,12 @@ begin
LoadConfig(@ConfigLoaded);
end;
procedure TDMConnection.SetClientConfig(Callback: TVersionCheckCallback);
begin
XDataWebClient1.Connection := AuthConnection;
console.log('ClientConfig');
XDataWebClient1.RawInvoke('IAuthService.VerifyVersion', [clientVersion],
procedure(Response: TXDataClientResponse)
procedure(Response: TXDataClientResponse) //this is the success callback
var
jsonResult: TJSObject;
error: string;
......@@ -101,14 +120,17 @@ begin
jsonResult := TJSObject(Response.Result);
if jsonResult.HasOwnProperty('error') then
error := string(jsonResult['error'])
else
error := '';
if error <> '' then
Callback(False, error)
begin
error := string(jsonResult['error']);
Callback(False, error);
end
else
Callback(True, '');
end,
procedure(Error: TXDataClientError) //this is the error callback
begin
Callback(False, Error.ErrorMessage);
end);
end;
......
kgOrdersClient/Utils.pas
......@@ -92,6 +92,12 @@ end;
procedure ShowErrorModal(msg: string);
begin
HideSpinner('spinner');
if msg = '' then
begin
msg := 'Error connecting to EM Sytems Server.' + slinebreak +
'Please contact EM Systems Support.'
end;
asm
var modal = document.getElementById('main_errormodal');
var label = document.getElementById('main_lblmodal_body');
......
kgOrdersClient/View.Customer.Add.html
......@@ -57,7 +57,7 @@
<label for="wdbe_first_name" style="font-weight: 700; font-size: 15px;" class="form-label mt-2">Customer ID:</label>
<input id="edtcompanyaccountname"type="text" class="form-control" style="width: 150px" required/>
<div class="invalid-feedback" id="shortnamefeedback" style="font-size: 15px;">
Please Provide a Company ID.
Please Provide a Customer ID.
</div>
</div>
<div class="col-auto">
......@@ -121,7 +121,7 @@
<div class="row">
<div class="overflow-auto mt-2"
style="max-height: calc(100vh - 250px); padding-bottom: 0; width: 100%;">
<table id="tblPhoneGrid" class="table table-striped table-bordered" style="width: 100%;">
<table id="tblShippingAddress" class="table table-striped table-bordered" style="width: 100%;">
<thead class="sticky-top thead-light">
<tr style="font-size: 0.875rem;">
<!-- headers -->
......
kgOrdersClient/View.Customer.Select.dfm
......@@ -206,7 +206,6 @@ object FSelectCustomer: TFSelectCustomer
ScrollMode = scmItemScrolling
DesignTimeSampleData = True
OnCellClick = TMSFNCGrid1CellClick
ExplicitLeft = 4
end
object btnCancel: TWebButton
Left = 556
......
kgOrdersClient/View.Customer.Select.pas
......@@ -86,13 +86,12 @@ begin
ShowToast('Please Select a Customer', 'danger')
else
begin
if ( string(self.Caption).ToLower.Contains('add') and xdwdsCustomers.FieldByName('InKGOrders').AsBoolean) then
if ( xdwdsCustomers.FieldByName('InKGOrders').AsBoolean ) then
ShowToast('failure:Customer Already in Database')
else
begin
confirm := true;
QB_ID := xdwdsCustomers.FieldByName('Id').AsString;
FViewMain.ViewAddCustomer('', QB_ID);
Close();
end;
end;
......
kgOrdersClient/View.Customers.dfm
......@@ -112,6 +112,7 @@ object FViewCustomers: TFViewCustomers
Header.ListItemElementClassName = 'page-item'
Header.ListLinkElementClassName = 'page-link'
WordWrap = True
OnClickCell = wdbtcCustomersClickCell
OnDblClickCell = wdbtcCustomersDblClickCell
Columns = <
item
......
kgOrdersClient/View.Customers.pas
......@@ -38,6 +38,7 @@ type
procedure wdbtcCustomersDblClickCell(Sender: TObject; ACol, ARow: Integer);
procedure edtFilterChange(Sender: TObject);
procedure wcbPageSizeChange(Sender: TObject);
procedure wdbtcCustomersClickCell(Sender: TObject; ACol, ARow: Integer);
private
{ Private declarations }
procedure GeneratePagination(TotalPages: Integer);
......@@ -82,7 +83,8 @@ begin
newform.ShowModal(
procedure(AValue: TModalResult)
begin
if newform.confirm then
FViewMain.ViewAddCustomer('', newform.QB_ID);
end
);
end;
......@@ -169,6 +171,12 @@ begin
getCustomers(GenerateSearchOptions());
end;
procedure TFViewCustomers.wdbtcCustomersClickCell(Sender: TObject; ACol,
ARow: Integer);
begin
console.log(xdwdsCustomersSHORT_NAME.AsString);
end;
procedure TFViewCustomers.wdbtcCustomersDblClickCell(Sender: TObject; ACol,
ARow: Integer);
begin
......
kgOrdersClient/View.Home.dfm
......@@ -22,18 +22,11 @@ object FViewHome: TFViewHome
HeightPercent = 100.000000000000000000
Lines.Strings = (
'Change Log:'
'1) Setting a status now autofills due dates.'
'2) Fixed order dates displaying on 3 lines rather than 2.'
'3) Adjusted pdfs so that special instructions would have enough ' +
'space.'
'4) Fixed issue with PDF generation.'
'5) Removed ability to put 0 or a negative number for price and q' +
'uantity on order entry fields.')
'1) Updated access type'
'2) Removed user profile')
ReadOnly = True
SelLength = 0
SelStart = 323
SelStart = 62
WidthPercent = 100.000000000000000000
end
end
kgOrdersClient/View.Item.Add.pas
......@@ -91,10 +91,8 @@ begin
QB_ID := xdwdsCustomers.FieldByName('qb_items_qb_id').AsString;
name := xdwdsCustomers.FieldByName('qb_item_name').AsString;
description := xdwdsCustomers.FieldByName('item_desc').AsString;
if xdwdsCustomers.FieldByName('status').AsBoolean then
status := 'ACTIVE'
else
status := 'INACTIVE';
status := xdwdsCustomers.FieldByName('status').AsString;
confirm := true;
Close;
end;
......
kgOrdersClient/View.Items.pas
......@@ -439,9 +439,12 @@ end;
procedure TFViewItems.btnAddClick(Sender: TObject);
var
itemOptions: string;
itemOptions, AccessType: string;
newform: TFViewAddItem;
begin
AccessType := JS.toString(AuthService.TokenPayload.Properties['user_access_type']);
if( ( AccessType = 'ADMIN' ) or ( AccessType = 'QBUSR' ) ) then
begin
newform := TFViewAddItem.CreateNew;
newform.Caption := 'Select Item to Add';
......@@ -463,6 +466,8 @@ begin
xdwdsItems.FieldByName('name').AsString := newform.name;
xdwdsItems.FieldByName('description').AsString := newform.description;
xdwdsItems.FieldByName('status').AsString := newform.status;
console.log(xdwdsItems.FieldByName('status').AsString);
console.log(newform.status);
xdwdsItems.Post;
EditMode();
......@@ -470,6 +475,10 @@ begin
end;
end
);
end
else
ShowToast('Failure:User not authorized to add item from QuickBooks', 'failure');
end;
procedure TFViewItems.btnCancelClick(Sender: TObject);
......@@ -498,15 +507,22 @@ end;
procedure TFViewItems.btnDeleteClick(Sender: TObject);
begin
ShowNotificationModal('Deleting items is not yet implemented.');
ShowToast('Deleting items is not yet implemented.', 'info');
end;
procedure TFViewItems.btnUpdateClick(Sender: TObject);
var
itemOptions: string;
itemOptions, AccessType: string;
newform: TFViewAddItem;
begin
AccessType := JS.toString(AuthService.TokenPayload.Properties['user_access_type']);
if( ( AccessType = 'ADMIN' ) or ( AccessType = 'QBUSR' ) ) then
begin
UpdateItem();
end
else
ShowToast('Failure:User not authorized to update item from QuickBooks', 'failure');
end;
procedure TFViewItems.UpdateItem();
......@@ -560,10 +576,10 @@ begin
if change then
begin
EditMode;
ShowToast('Update successful. Changes have been highlighted');
ShowToast('Changes have been highlighted');
end
else
ShowToast('Update successful. No Changes needed');
ShowToast('No Changes needed');
except
on E: EXDataClientRequestException do
Utils.ShowErrorModal(E.ErrorResult.ErrorMessage);
......
kgOrdersClient/View.Login.pas
......@@ -54,7 +54,7 @@ procedure TFViewLogin.btnLoginClick(Sender: TObject);
procedure LoginError(AMsg: string);
begin
ShowNotification('Login Error: ' + AMsg);
ShowNotification(AMsg);
end;
var
hashPW: string;
......
kgOrdersClient/View.Main.dfm
......@@ -22,17 +22,6 @@ object FViewMain: TFViewMain
Transparent = False
WidthPercent = 100.000000000000000000
end
object wllblUserProfile: TWebLinkLabel
Left = 529
Top = 21
Width = 59
Height = 14
ElementID = 'dropdown.menu.userprofile'
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
OnClick = wllblUserProfileClick
Caption = ' User Profile'
end
object wllblLogout: TWebLinkLabel
Left = 554
Top = 148
......@@ -74,6 +63,7 @@ object FViewMain: TFViewMain
Height = 14
ElementID = 'dropdown.menu.itemlist'
ElementFont = efCSS
Enabled = False
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
OnClick = lblItemsListClick
......@@ -86,6 +76,7 @@ object FViewMain: TFViewMain
Height = 14
ElementID = 'dropdown.menu.users'
ElementFont = efCSS
Enabled = False
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
OnClick = lblUsersClick
......@@ -114,6 +105,7 @@ object FViewMain: TFViewMain
ElementID = 'lblcustomers'
ElementFont = efCSS
ElementPosition = epRelative
Enabled = False
HeightStyle = ssAuto
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
......@@ -140,6 +132,7 @@ object FViewMain: TFViewMain
Caption = 'QB Info'
ElementID = 'dropdown.menu.linktoqb'
ElementFont = efCSS
Enabled = False
HeightStyle = ssAuto
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
......@@ -153,8 +146,14 @@ object FViewMain: TFViewMain
Caption = 'TEST MODE'
ElementID = 'view.main.test'
ElementFont = efCSS
Font.Charset = ANSI_CHARSET
Font.Color = clBlack
Font.Height = -11
Font.Name = 'Arial'
Font.Style = []
HeightStyle = ssAuto
HeightPercent = 100.000000000000000000
ParentFont = False
WidthPercent = 100.000000000000000000
end
object WebPanel1: TWebPanel
......
kgOrdersClient/View.Main.html
......@@ -4,7 +4,7 @@
<div class="d-flex align-items-center">
<a id="view.main.apptitle" class="navbar-brand" href="index.html">Koehler-Gibson Orders</a>
<span id="view.main.version" class="small text-muted ms-2 me-5"></span>
<span id="view.main.test" class="test-warning fw-bold mb-1" style="display: none;">TEST MODE</span>
<span id="view.main.test" class="test-warning fw-bold mb-1 text-nowrap" style="display: none; font-size: 0.85rem;">TEST MODE</span>
</div>
<ul class="navbar-nav ml-auto">
<li class="nav-item">
......@@ -28,9 +28,6 @@
<a class="dropdown-item" id="dropdown.menu.home" href="#"><i class="fa fa-home fa-fw"></i><span> Home</span></a>
</li>
<li>
<a class="dropdown-item" id="dropdown.menu.userprofile" href="#"><i class="fa fa-user fa-fw"></i><span> User Profile</span></a>
</li>
<li>
<a class="dropdown-item" id="dropdown.menu.users" href="#"><i class="fas fa-address-book fa-fw"></i><span> Users</span></a>
</li>
<li>
......
kgOrdersClient/View.Main.pas
......@@ -12,7 +12,6 @@ uses
type
TFViewMain = class(TWebForm)
lblUsername: TWebLabel;
wllblUserProfile: TWebLinkLabel;
wllblLogout: TWebLinkLabel;
WebPanel1: TWebPanel;
lblHome: TWebLinkLabel;
......@@ -29,7 +28,6 @@ type
WebLabel1: TWebLabel;
procedure WebFormCreate(Sender: TObject);
procedure mnuLogoutClick(Sender: TObject);
procedure wllblUserProfileClick(Sender: TObject);
procedure wllblLogoutClick(Sender: TObject);
procedure lblHomeClick(Sender: TObject);
procedure lblItemsListClick(Sender: TObject);
......@@ -75,7 +73,6 @@ implementation
uses
Auth.Service,
View.Login,
View.UserProfile,
View.Home,
View.Items,
View.Users,
......@@ -92,7 +89,7 @@ uses
procedure TFViewMain.WebFormCreate(Sender: TObject);
var
userName: string;
userName, AccessType: string;
test: boolean;
begin
FUserInfo := GetUserInfo;
......@@ -100,13 +97,20 @@ begin
lblUsername.Caption := ' ' + userName.ToLower + ' ';
FChildForm := nil;
change := false;
AccessType := JS.toString(AuthService.TokenPayload.Properties['user_access_type']);
if (not (JS.toString(AuthService.TokenPayload.Properties['user_access_type']) = 'ADMIN')) then
if ( AccessType = 'ADMIN' ) then
begin
lblUsers.enabled := false;
lblQBInfo.Enabled := false;
lblCustomers.Enabled := false;
lblUsers.enabled := true;
end;
if( ( AccessType = 'ADMIN' ) or ( AccessType = 'QBUSR' ) ) then
begin
lblQBInfo.Enabled := true;
lblCustomers.Enabled := true;
lblItemsList.Enabled := true;
end;
lblAppTitle.Caption := 'Koehler-Gibson Orders';
lblVersion.Caption := 'v' + DMConnection.clientVersion;
ShowForm(TFViewOrders);
......@@ -266,14 +270,6 @@ begin
end;
procedure TFViewMain.wllblUserProfileClick(Sender: TObject);
begin
ShowCrudForm(TFViewUserProfile);
lblAppTitle.Caption := 'Koehler-Gibson User Profile';
setActive('User Profile');
end;
function TFViewMain.GetUserInfo: string;
var
userStr: string;
......
kgOrdersClient/View.OrderEntryCorrugated.pas
......@@ -390,8 +390,10 @@ procedure TFOrderEntryCorrugated.btnQBClick(Sender: TObject);
var
orderJSON: TJSONObject;
qbEnabled: boolean;
AccessType: string;
begin
if JS.toString(AuthService.TokenPayload.Properties['user_qb_id']) <> '' then
AccessType := JS.toString(AuthService.TokenPayload.Properties['user_access_type']);
if( ( AccessType = 'ADMIN' ) or ( AccessType = 'QBUSR' ) ) then
begin
if ( VerifyQBOrder() )then
begin
......@@ -513,6 +515,10 @@ begin
xdwdsOrder.Close;
xdwdsOrder.SetJsonData(jsObj);
xdwdsOrder.Open;
cbLoose.Checked := ( xdwdsOrder.FieldByName('mounting_loose').AsString <> '' );
cbStripMount.Checked := ( xdwdsOrder.FieldByName('mounting_strip_mount').AsString <> '' );
OrderID := xdwdsOrderORDER_ID.AsString;
mode := 'EDIT';
ShowToast(string(jsObj.Properties['status']));
......@@ -630,7 +636,7 @@ begin
notification := TJSObject(Response.Result);
ShowToast(string(notification['status']));
xdwdsShipTo.Close;
xdwdsShipTo.SetJSONData(notification['ADDRESS']);
xdwdsShipTo.SetJSONData(TJSObject(notification['customer'])['SHIPPING_ADDRESS_LIST']);
xdwdsShipTo.Open;
end;
......@@ -666,7 +672,7 @@ begin
AddressJSON.AddPair('state', newform.edtState.Text);
AddressJSON.AddPair('zip', newform.edtZip.Text);
AddressJSON.AddPair('contact', newform.edtContact.Text);
AddressJSON.AddPair('customer_id', customerID);
AddressJSON.AddPair('customer_id', xdwdsOrder.FieldByName('COMPANY_ID').AsString);
ship_block := newform.edtFirstLine.Text + slinebreak +
edtCompanyName.Text + slinebreak +
......@@ -676,6 +682,7 @@ begin
AddressJSON.AddPair('ship_block', ship_block);
AddressJSON.AddPair('mode', 'ADD');
console.log(AddressJSON);
sendAddressToServer(AddressJSON);
end;
end
......@@ -787,7 +794,7 @@ begin
container := TJSHTMLElement(document.getElementById('additionalFields'));
if Assigned(container) then
container.innerHTML := ''; // Wipe previous content
container.innerHTML := ''; // Wipe previous colors
if xdwdsOrdercolors_colors.Value <> '' then
begin
......@@ -800,6 +807,7 @@ begin
end;
end;
if xdwdsOrder.FieldByName('mounting_loose').AsString <> '' then
cbLoose.Checked := true;
......
kgOrdersClient/View.OrderEntryCuttingDie.pas
......@@ -194,8 +194,10 @@ procedure TFOrderEntryCuttingDie.btnQBClick(Sender: TObject);
var
orderJSON: TJSONObject;
qbEnabled: boolean;
AccessType: string;
begin
if JS.toString(AuthService.TokenPayload.Properties['user_qb_id']) <> '' then
AccessType := JS.toString(AuthService.TokenPayload.Properties['user_access_type']);
if( ( AccessType = 'ADMIN' ) or ( AccessType = 'QBUSR' ) ) then
begin
if ( VerifyQBOrder() )then
begin
......@@ -231,7 +233,7 @@ begin
notification := TJSObject(Response.Result);
ShowToast(string(notification['status']));
xdwdsShipTo.Close;
xdwdsShipTo.SetJSONData(notification['ADDRESS']);
xdwdsShipTo.SetJSONData(TJSObject(notification['customer'])['SHIPPING_ADDRESS_LIST']);
xdwdsShipTo.Open;
end;
......@@ -428,6 +430,7 @@ begin
xdwdsOrder.Close;
xdwdsOrder.SetJsonData(jsObj);
xdwdsOrder.Open;
OrderID := xdwdsOrderORDER_ID.AsString;
mode := 'EDIT';
ShowToast(String(jsObj.Properties['status']));
......@@ -488,8 +491,8 @@ begin
if confirmed then
begin
FViewMain.change := false;
if xdwdsOrder.FieldByName('ORDER_ID').AsString <> '' then
FViewMain.ViewOrderEntryCuttingDie(xdwdsOrder.FieldByName('ORDER_ID').AsString, '', 'EDIT', 'Failure: Changes Discarded')
if orderID <> '' then
FViewMain.ViewOrderEntryCuttingDie(orderID, '', 'EDIT', 'Failure: Changes Discarded')
else
FViewMain.ViewOrders('');
end;
......
kgOrdersClient/View.OrderEntryWeb.pas
......@@ -323,7 +323,7 @@ begin
notification := TJSObject(Response.Result);
ShowToast(string(notification['status']));
xdwdsShipTo.Close;
xdwdsShipTo.SetJSONData(notification['ADDRESS']);
xdwdsShipTo.SetJSONData(TJSObject(notification['customer'])['SHIPPING_ADDRESS_LIST']);
xdwdsShipTo.Open;
end;
......@@ -358,7 +358,7 @@ begin
AddressJSON.AddPair('state', newform.edtState.Text);
AddressJSON.AddPair('zip', newform.edtZip.Text);
AddressJSON.AddPair('contact', newform.edtContact.Text);
AddressJSON.AddPair('customer_id', customerID);
AddressJSON.AddPair('customer_id', xdwdsOrderCOMPANY_ID.AsString);
ship_block := newform.edtFirstLine.Text + slinebreak +
edtCompanyName.Text + slinebreak +
......@@ -454,8 +454,10 @@ procedure TFOrderEntryWeb.btnQBClick(Sender: TObject);
var
orderJSON: TJSONObject;
qbEnabled: boolean;
AccessType: string;
begin
if JS.toString(AuthService.TokenPayload.Properties['user_qb_id']) <> '' then
AccessType := JS.toString(AuthService.TokenPayload.Properties['user_access_type']);
if( ( AccessType = 'ADMIN' ) or ( AccessType = 'QBUSR' ) ) then
begin
if ( VerifyQBOrder() )then
begin
......@@ -597,6 +599,7 @@ begin
xdwdsOrder.Open;
mode := 'EDIT';
OrderID := xdwdsOrderORDER_ID.AsString;
ShowToast(String(jsObj.Properties['status']));
except
on E: EXDataClientRequestException do
......@@ -768,6 +771,7 @@ var
colorList: TJSArray;
color: TJSObject;
items: TJSObject;
container: TJSHTMLElement;
begin
Utils.ShowSpinner('spinner');
try
......@@ -779,6 +783,10 @@ begin
xdwdsOrder.SetJsonData(order);
xdwdsOrder.Open;
container := TJSHTMLElement(document.getElementById('additionalFields'));
if Assigned(container) then
container.innerHTML := ''; // Wipe previous colors
if xdwdsOrderquantity_and_colors_qty_colors.Value <> '' then
begin
colorObject := TJSObject(TJSJSON.parse(xdwdsOrderquantity_and_colors_qty_colors.Value));
......@@ -875,6 +883,7 @@ begin
btnCancel.Enabled := True;
btnEdit.Enabled := false;
btnAdd.Enabled := false;
btnQB.Enabled := false;
cbPdf.Enabled := True;
cbInkJet.Enabled := True;
......@@ -912,6 +921,7 @@ begin
btnCancel.Enabled := false;
btnEdit.Enabled := true;
btnAdd.Enabled := true;
btnQB.Enabled := true;
FViewMain.change := false;
cbPdf.Enabled := False;
......
kgOrdersClient/View.Orders.pas
......@@ -14,7 +14,7 @@ uses
WEBLib.JSON, Auth.Service, XData.Web.Client, WebLib.Storage,
ConnectionModule, App.Types, Vcl.StdCtrls, Vcl.Controls, WEBLib.DBCtrls,
XData.Web.JsonDataset, WEBLib.DB, Data.DB, XData.Web.Dataset, XData.Web.DatasetCommon,
WEBLib.Grids, VCL.Forms;
WEBLib.Grids, VCL.Forms, Math;
type
TFViewOrders = class(TWebForm)
......@@ -552,8 +552,15 @@ end;
procedure TFViewOrders.wcbPageSizeChange(Sender: TObject);
var
ratio: double;
begin
ratio := PageSize/StrToInt(wcbPageSize.Text);
PageSize := StrToInt(wcbPageSize.Text);
if ratio < 1 then
PageNumber := Ceil(PageNumber * ratio)
else
PageNumber := Ceil(PageNumber * ratio) - Trunc(ratio) + 1;
getOrders(generateSearchOptions());
end;
......
kgOrdersClient/View.QBInfo.pas
......@@ -36,11 +36,17 @@ implementation
{$R *.dfm}
uses View.Main, Utils;
uses View.Main, Utils, Auth.Service;
procedure TFQBInfo.btnLinkToQBClick(Sender: TObject);
var
AccessType: String;
begin
GetQBLink();
AccessType := JS.toString(AuthService.TokenPayload.Properties['user_access_type']);
if( ( AccessType = 'ADMIN' ) or ( AccessType = 'QBUSR' ) ) then
GetQBLink()
else
ShowToast('Failure:User not authorized to add to QuickBooks', 'failure');
end;
procedure TFQBInfo.WebFormCreate(Sender: TObject);
......
kgOrdersClient/View.SetStatus.pas
......@@ -220,7 +220,7 @@ begin
else if wlcbStatus.DisplayText = 'Plate Done' then
begin
dtpPlateDue.Date := plateDue;
dtpShipDue.Date := plateDue;
dtpShipDue.Date := dtpDate.Date;
end
else if wlcbStatus.DisplayText = 'Ship Done' then
begin
......@@ -235,10 +235,6 @@ begin
begin
dtpShipDue.Date := shipDue;
end
else if wlcbStatus.DisplayText = 'Art Done' then
begin
dtpShipDue.Date := dtpDate.Date;
end
else if wlcbStatus.DisplayText = 'Ship Done' then
begin
dtpShipDue.Date := shipDue;
......
kgOrdersClient/View.User.Add.dfm
......@@ -195,23 +195,9 @@ object FViewEditUser: TFViewEditUser
ChildOrder = 19
ElementID = 'edtrights'
HeightPercent = 100.000000000000000000
MaxLength = 11
WidthPercent = 100.000000000000000000
end
object cbAccess: TWebComboBox
Left = 346
Top = 90
Width = 145
Height = 23
ElementID = 'cbaccess'
HeightPercent = 100.000000000000000000
TabStop = False
WidthPercent = 100.000000000000000000
ItemIndex = -1
Items.Strings = (
'SALES'
'USER'
'ADMIN')
end
object edtQB: TWebEdit
Left = 346
Top = 62
......@@ -223,6 +209,33 @@ object FViewEditUser: TFViewEditUser
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
end
object cbAccess: TWebLookupComboBox
Left = 346
Top = 93
Width = 145
Height = 22
ElementID = 'cbaccess'
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
ItemIndex = -1
LookupValues = <
item
Value = 'ADMIN'
DisplayText = 'Admin'
end
item
Value = 'USER'
DisplayText = 'User'
end
item
Value = 'SALES'
DisplayText = 'Sales User'
end
item
Value = 'QBUSR'
DisplayText = 'QB User'
end>
end
object XDataWebClient1: TXDataWebClient
Connection = DMConnection.ApiConnection
Left = 514
......
kgOrdersClient/View.User.Add.pas
......@@ -29,9 +29,9 @@ type
lblRights: TWebLabel;
edtRights: TWebEdit;
lblAccess: TWebLabel;
cbAccess: TWebComboBox;
lblQB: TWebLabel;
edtQB: TWebEdit;
cbAccess: TWebLookupComboBox;
procedure WebFormCreate(Sender: TObject);
procedure btnConfirmClick(Sender: TObject);
procedure btnCancelClick(Sender: TObject);
......@@ -90,7 +90,7 @@ begin
'&password=' + edtPassword.Text +
'&status=' + BoolToStr(cbStatus.Checked) +
'&email=' + edtEmail.Text +
'&access=' + cbAccess.Text +
'&access=' + cbAccess.Value +
'&newuser=' + edtUsername.Text +
'&rights=' + edtRights.Text +
'&QB=' + edtQB.Text;
......@@ -123,7 +123,7 @@ begin
'&password=' + edtPassword.Text +
'&status=' + BoolToStr(cbStatus.Checked) +
'&email=' + edtEmail.Text +
'&access=' + cbAccess.Text +
'&access=' + cbAccess.Value +
'&newuser=' + edtUsername.Text +
'&rights=' + edtRights.Text +
'&QB=' + edtQB.Text;
......@@ -176,7 +176,10 @@ begin
edtPassword.Text := 'hidden';
end;
edtEmail.Text := Email;
cbAccess.Text := Access;
if Access = '' then
cbAccess.Value := 'USER'
else
cbAccess.Value := Access;
edtRights.Text := Rights;
edtQB.Text := QB;
if Status = 'ACTIVE' then
......
kgOrdersClient/View.UserProfile.dfm deleted 100644 → 0
object FViewUserProfile: TFViewUserProfile
Width = 604
Height = 434
CSSLibrary = cssBootstrap
ElementFont = efCSS
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
ParentFont = False
OnShow = WebFormShow
object WebLabel1: TWebLabel
Left = 24
Top = 24
Width = 55
Height = 13
Caption = 'User Profile'
ElementID = 'view.userprofile.title'
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
HeightPercent = 100.000000000000000000
ParentFont = False
Visible = False
WidthPercent = 100.000000000000000000
end
object WebLabel3: TWebLabel
Left = 41
Top = 60
Width = 38
Height = 14
Caption = 'User ID:'
ElementID = 'view.userprofile.form.lblUserID'
ElementPosition = epRelative
Font.Charset = ANSI_CHARSET
Font.Color = clBlack
Font.Height = -11
Font.Name = 'Arial'
Font.Style = []
HeightPercent = 100.000000000000000000
ParentFont = False
WidthPercent = 100.000000000000000000
end
object WebLabel2: TWebLabel
Left = 8
Top = 143
Width = 71
Height = 14
Caption = 'Email Address:'
ElementID = 'view.userprofile.form.lblEmail'
ElementPosition = epRelative
Font.Charset = ANSI_CHARSET
Font.Color = clBlack
Font.Height = -11
Font.Name = 'Arial'
Font.Style = []
HeightPercent = 100.000000000000000000
ParentFont = False
WidthPercent = 100.000000000000000000
end
object WebLabel4: TWebLabel
Left = 27
Top = 84
Width = 52
Height = 14
Caption = 'Username:'
ElementID = 'view.userprofile.form.lblUserName'
ElementPosition = epRelative
Font.Charset = ANSI_CHARSET
Font.Color = clBlack
Font.Height = -11
Font.Name = 'Arial'
Font.Style = []
HeightPercent = 100.000000000000000000
ParentFont = False
WidthPercent = 100.000000000000000000
end
object WebLabel5: TWebLabel
Left = 30
Top = 117
Width = 49
Height = 14
Caption = 'Full Name:'
ElementID = 'view.userprofile.form.lblFullName'
ElementPosition = epRelative
Font.Charset = ANSI_CHARSET
Font.Color = clBlack
Font.Height = -11
Font.Name = 'Arial'
Font.Style = []
HeightPercent = 100.000000000000000000
ParentFont = False
WidthPercent = 100.000000000000000000
end
object WebLabel6: TWebLabel
Left = 15
Top = 171
Width = 64
Height = 13
Caption = 'Access Type:'
ElementID = 'view.userprofile.form.lblAccessType'
ElementFont = efCSS
HeightStyle = ssAuto
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
end
object WebLabel7: TWebLabel
Left = 47
Top = 196
Width = 32
Height = 13
Caption = 'QB ID:'
ElementID = 'view.userprofile.form.lblQBID'
ElementFont = efCSS
HeightStyle = ssAuto
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
end
object WebDBEdit1: TWebDBEdit
Left = 90
Top = 168
Width = 121
Height = 22
ChildOrder = 13
ElementClassName = 'form-control'
ElementID = 'view.userprofile.form.edtAccessType'
ElementFont = efCSS
HeightStyle = ssAuto
HeightPercent = 100.000000000000000000
Text = 'WebDBEdit1'
WidthPercent = 100.000000000000000000
DataField = 'AType'
DataSource = wdsUser
end
object WebDBEdit2: TWebDBEdit
Left = 90
Top = 140
Width = 121
Height = 22
ChildOrder = 13
ElementClassName = 'form-control'
ElementID = 'view.userprofile.form.edtEmail'
ElementFont = efCSS
HeightStyle = ssAuto
HeightPercent = 100.000000000000000000
Text = 'WebDBEdit1'
WidthPercent = 100.000000000000000000
DataField = 'email_address'
DataSource = wdsUser
end
object WebDBEdit3: TWebDBEdit
Left = 90
Top = 114
Width = 121
Height = 22
ChildOrder = 13
ElementClassName = 'form-control'
ElementID = 'view.userprofile.form.edtFullName'
ElementFont = efCSS
HeightStyle = ssAuto
HeightPercent = 100.000000000000000000
Text = 'WebDBEdit1'
WidthPercent = 100.000000000000000000
DataField = 'full_name'
DataSource = wdsUser
end
object WebDBEdit4: TWebDBEdit
Left = 85
Top = 81
Width = 121
Height = 22
ChildOrder = 13
ElementClassName = 'form-control'
ElementID = 'view.userprofile.form.edtUsername'
ElementFont = efCSS
HeightStyle = ssAuto
HeightPercent = 100.000000000000000000
Text = 'WebDBEdit1'
WidthPercent = 100.000000000000000000
DataField = 'username'
DataSource = wdsUser
end
object WebDBEdit5: TWebDBEdit
Left = 85
Top = 57
Width = 121
Height = 22
ChildOrder = 13
ElementClassName = 'form-control'
ElementID = 'view.userprofile.form.edtUserID'
ElementFont = efCSS
HeightStyle = ssAuto
HeightPercent = 100.000000000000000000
Text = 'WebDBEdit1'
WidthPercent = 100.000000000000000000
DataField = 'userID'
DataSource = wdsUser
end
object WebDBEdit6: TWebDBEdit
Left = 90
Top = 196
Width = 121
Height = 22
ChildOrder = 13
ElementClassName = 'form-control'
ElementID = 'view.userprofile.form.edtQBID'
ElementFont = efCSS
HeightStyle = ssAuto
HeightPercent = 100.000000000000000000
Text = 'WebDBEdit1'
WidthPercent = 100.000000000000000000
DataField = 'QBID'
DataSource = wdsUser
end
object XDataWebClient1: TXDataWebClient
Connection = DMConnection.ApiConnection
Left = 359
Top = 52
end
object xdwdsUser: TXDataWebDataSet
Left = 314
Top = 216
object xdwdsUseruserID: TStringField
FieldName = 'userID'
end
object xdwdsUserusername: TStringField
FieldName = 'username'
end
object xdwdsUseremail_address: TStringField
FieldName = 'email_address'
end
object xdwdsUserQBID: TStringField
FieldName = 'QBID'
end
object xdwdsUserAType: TStringField
FieldName = 'Atype'
end
object xdwdsUserfull_name: TStringField
FieldName = 'full_name'
end
end
object wdsUser: TWebDataSource
AutoEdit = False
DataSet = xdwdsUser
Left = 422
Top = 262
end
end
kgOrdersClient/View.UserProfile.html deleted 100644 → 0
<div class="container">
<!-- Profile form -->
<div class="row">
<div class="col-lg-8 col-xl-6 mx-auto">
<form id="userprofileform" class="needs-validation" role="form" autocomplete="off" novalidate>
<div class="mb-3">
<label id="view.userprofile.form.lblUserID"
for="view.userprofile.form.edtUserID"
class="form-label">User&nbsp;ID</label>
<input id="view.userprofile.form.edtUserID"
class="form-control"
readonly>
</div>
<div class="mb-3">
<label id="view.userprofile.form.lblUserName"
for="view.userprofile.form.edtUsername"
class="form-label">Username</label>
<input id="view.userprofile.form.edtUsername"
class="form-control">
</div>
<div class="mb-3">
<label id="view.userprofile.form.lblFullName"
for="view.userprofile.form.edtFullName"
class="form-label">Full&nbsp;Name</label>
<input id="view.userprofile.form.edtFullName"
class="form-control">
</div>
<div class="mb-3">
<label id="view.userprofile.form.lblEmail"
for="view.userprofile.form.edtEmail"
class="form-label">Email&nbsp;Address</label>
<input id="view.userprofile.form.edtEmail"
type="email"
class="form-control">
</div>
<div class="mb-3">
<label id="view.userprofile.form.lblAccessType"
for="view.userprofile.form.edtAccessType"
class="form-label">Email&nbsp;Address</label>
<input id="view.userprofile.form.edtAccessType"
type="email"
class="form-control">
</div>
<div class="mb-3">
<label id="view.userprofile.form.lblQBID"
for="view.userprofile.form.edtQBID"
class="form-label">Email&nbsp;Address</label>
<input id="view.userprofile.form.edtQBID"
type="email"
class="form-control">
</div>
</form>
</div>
</div>
</div>
kgOrdersClient/View.UserProfile.pas deleted 100644 → 0
unit View.UserProfile;
interface
uses
System.SysUtils, System.Classes, JS, Web, WEBLib.Graphics, WEBLib.Controls,
WEBLib.Forms, WEBLib.Dialogs, Vcl.Controls, Vcl.StdCtrls, WEBLib.StdCtrls,
XData.Web.Client, WEBLib.ExtCtrls, DB, XData.Web.JsonDataset,
XData.Web.Dataset, XData.Web.Connection, Vcl.Forms, ConnectionModule,
WEBLib.Toast, WEBLib.DBCtrls;
type
TFViewUserProfile = class(TWebForm)
WebLabel1: TWebLabel;
WebLabel3: TWebLabel;
WebLabel2: TWebLabel;
WebLabel4: TWebLabel;
WebLabel5: TWebLabel;
XDataWebClient1: TXDataWebClient;
WebDBEdit1: TWebDBEdit;
WebDBEdit2: TWebDBEdit;
WebDBEdit3: TWebDBEdit;
WebDBEdit4: TWebDBEdit;
WebDBEdit5: TWebDBEdit;
WebDBEdit6: TWebDBEdit;
WebLabel6: TWebLabel;
WebLabel7: TWebLabel;
xdwdsUser: TXDataWebDataSet;
wdsUser: TWebDataSource;
xdwdsUseruserID: TStringField;
xdwdsUserusername: TStringField;
xdwdsUseremail_address: TStringField;
xdwdsUserQBID: TStringField;
xdwdsUserAType: TStringField;
xdwdsUserfull_name: TStringField;
procedure WebFormShow(Sender: TObject);
[async] procedure GetUser();
end;
var
FViewUserProfile: TFViewUserProfile;
implementation
uses
Auth.Service,
XData.Model.Classes,
Utils,
View.Main;
{$R *.dfm}
procedure TFViewUserProfile.WebFormShow(Sender: TObject);
begin
GetUser();
end;
procedure TFViewUserProfile.GetUser;
var
xdcResponse: TXDataClientResponse;
userList: TJSObject;
data: TJSArray;
user: TJSObject;
begin
try
xdcResponse := await(XDataWebClient1.RawInvokeAsync('ILookupService.GetUsers',
[JS.toString(AuthService.TokenPayload.Properties['user_name'])]));
userList := TJSObject(xdcResponse.Result);
data := TJSArray(userList['data']);
user := TJSObject(data[0]);
xdwdsUser.SetJsonData(user);
xdwdsUser.Open;
except
on E: EXDataClientRequestException do
Utils.ShowErrorModal(E.ErrorResult.ErrorMessage);
end;
end;
end.
kgOrdersClient/Win64/Debug/TMSWebRunner.ini deleted 100644 → 0
[Paths]
HtmlPath=C:\Projects\kgOrders\kgOrders\kgOrdersClient\TMSWeb\Debug
HtmlFile=index.html
DefaultURL=http://127.0.0.1:8000/webKGOrders
SingleInstance=0
Debug=0
DebugManager=C:\RADTools\TMS\Products\tms.webcore\Bin\Win32\TMSDBGManager.exe
URL=http://127.0.0.1:8000/$(ProjectName)
URLParams=
Browser=1
BrowserBin=
BrowserParams=
Electron=0
ElectronBuild=0
JSDebugger=0
kgOrdersClient/css/app.css
......@@ -21,6 +21,11 @@
text-align: center;
}
#tblPhoneGrid thead th:nth-child(20) {
font-size: 0.9rem !important;
font-weight: bold; /* Optional: keep it bold if shrinking makes it too thin */
}
input[type="text"] {
min-width: 50px;
max-width: 100%;
......@@ -42,11 +47,11 @@ input[type=number] {
.changed-field {
border: 1px solid #ffc107 !important;
border: 1px solid #FFFF00 !important;
}
.changed-field-label {
background-color: #fff3cd;
background-color: #FFFF00;
border-radius: 4px;
padding: 2px 6px;
}
......
kgOrdersClient/webKGOrders.dpr
......@@ -8,7 +8,6 @@ uses
App.Types in 'App.Types.pas',
ConnectionModule in 'ConnectionModule.pas' {DMConnection: TWebDataModule},
View.Login in 'View.Login.pas' {FViewLogin: TWebForm} {*.html},
View.UserProfile in 'View.UserProfile.pas' {FViewUserProfile: TWebForm} {*.html},
View.ErrorPage in 'View.ErrorPage.pas' {FViewErrorPage: TWebForm} {*.html},
App.Config in 'App.Config.pas',
Paginator.Plugins in 'Paginator.Plugins.pas',
......@@ -65,6 +64,9 @@ end;
procedure UnauthorizedAccessProc(AMessage: string);
begin
if Pos('JWT', AMessage) > 0 then
DisplayLoginView('Login token expired! Please login again')
else
DisplayLoginView(AMessage);
end;
......@@ -89,27 +91,31 @@ begin
end
else
begin
asm
var dlg = document.createElement("dialog");
dlg.classList.add("shadow", "rounded", "border", "p-4");
dlg.style.maxWidth = "500px";
dlg.style.width = "90%";
dlg.style.fontFamily = "system-ui, sans-serif";
dlg.innerHTML =
"<h5 class='fw-bold mb-3 text-danger'>kgOrders web app</h5>" +
"<p class='mb-3' style='white-space: pre-wrap;'>" + ErrorMessage + "</p>" +
"<div class='text-end'>" +
"<button id='refreshBtn' class='btn btn-primary'>Reload</button></div>";
document.body.appendChild(dlg);
dlg.showModal();
document.getElementById("refreshBtn").addEventListener("click", function () {
var base = location.origin + location.pathname;
location.replace(base + "?ver=" + ClientVer + "&r=" + Date.now() + location.hash);
});
end;
// asm
// var dlg = document.createElement("dialog");
// dlg.classList.add("shadow", "rounded", "border", "p-4");
// dlg.style.maxWidth = "500px";
// dlg.style.width = "90%";
// dlg.style.fontFamily = "system-ui, sans-serif";
//
// dlg.innerHTML =
// "<h5 class='fw-bold mb-3 text-danger'>kgOrders web app</h5>" +
// "<p class='mb-3' style='white-space: pre-wrap;'>" + ErrorMessage + "</p>" +
// "<div class='text-end'>" +
// "<button id='refreshBtn' class='btn btn-primary'>Reload</button></div>";
//
// document.body.appendChild(dlg);
// dlg.showModal();
//
// document.getElementById("refreshBtn").addEventListener("click", function () {
// var base = location.origin + location.pathname;
// location.replace(base + "?ver=" + ClientVer + "&r=" + Date.now() + location.hash);
// });
// end;
if Pos('version', ErrorMessage) > 0 then
ShowMessage( ErrorMessage )
else
ShowMessage( 'Error connecting to kgOrdersServer' + sLineBreak + 'Please contact EM Systems support' );
end;
end);
end,
......
kgOrdersClient/webKGOrders.dproj
......@@ -99,9 +99,9 @@
<VerInfo_MajorVer>0</VerInfo_MajorVer>
<VerInfo_MinorVer>9</VerInfo_MinorVer>
<VerInfo_Release>8</VerInfo_Release>
<TMSWebBrowser>1</TMSWebBrowser>
<TMSUseJSDebugger>2</TMSUseJSDebugger>
<TMSWebSingleInstance>1</TMSWebSingleInstance>
<TMSWebBrowser>5</TMSWebBrowser>
<TMSWebOutputPath>..\kgOrdersServer\bin\static</TMSWebOutputPath>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2)'!=''">
......@@ -133,10 +133,6 @@
<Form>FViewLogin</Form>
<DesignClass>TWebForm</DesignClass>
</DCCReference>
<DCCReference Include="View.UserProfile.pas">
<Form>FViewUserProfile</Form>
<DesignClass>TWebForm</DesignClass>
</DCCReference>
<DCCReference Include="View.ErrorPage.pas">
<Form>FViewErrorPage</Form>
<DesignClass>TWebForm</DesignClass>
......
kgOrdersServer/Source/Api.Database.pas
// Where the database is kept. Only used by Lookup.ServiceImpl to retrieve info
// from the data base and send it to the client.
// Author: ???
unit Api.Database;
interface
......@@ -136,7 +133,7 @@ uses
procedure TApiDatabase.DataModuleCreate(Sender: TObject);
begin
Logger.Log( 5, 'TApiDatabase.DataModuleCreate' );
LoadDatabaseSettings( ucKG, 'kgOrdersServer.ini' );
LoadDatabaseSettings( ucKG );
try
ucKG.Connect;
except
......
kgOrdersServer/Source/Auth.Database.pas
// Auth Database to verify logins
unit Auth.Database;
interface
......@@ -50,24 +48,21 @@ uses
procedure TAuthDatabase.DataModuleCreate(Sender: TObject);
begin
Logger.Log( 5, 'TAuthDatabase.DataModuleCreate' );
LoadDatabaseSettings( ucKG, 'kgOrdersServer.ini' );
try
LoadDatabaseSettings( ucKG );
ucKG.Connect;
except
on E: Exception do
begin
Logger.Log( 1, '--TAuthDatabase.DataModuleCreate -Error connecting to database: ' + E.Message );
raise EXDataHttpException.Create(500, 'Error Connecting to database! Please try again later or contact a system admin!');
end;
end;
end;
procedure TAuthDatabase.DataModuleDestroy(Sender: TObject);
begin
ucKG.Connected := false;
Logger.Log( 5, 'TAuthDatabase.DataModuleDestroy' );
end;
end.
kgOrdersServer/Source/Auth.ServiceImpl.pas
......@@ -49,22 +49,33 @@ procedure TAuthService.AfterConstruction;
begin
inherited;
try
Logger.Log(4, 'TAuthService.AfterConstruction');
authDB := TAuthDatabase.Create(nil);
if not authDB.ucKG.Connected then
begin
Logger.Log(1, 'Unable to connect to the database: A KGOrders Server Error has occured!');
raise EXDataHttpException.Create(500, 'Unable to connect to the database: A KGOrders Server Error has occured!');
end;
except
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!');
Logger.Log(1, 'Error creating the Auth database: ' + E.Message);
raise; //EXDataHttpException.Create(500, 'Unable to create Auth database: A KGOrders Server Error has occured!');
end;
end;
end;
procedure TAuthService.BeforeDestruction;
begin
authDB.Free;
inherited;
end;
function TAuthService.VerifyVersion(clientVersion: string): TJSONObject;
var
iniFile: TIniFile;
......@@ -85,7 +96,7 @@ begin
Result.AddPair('error',
'webApp version mismatch' + sLineBreak + ' Client version: ' + clientVersion +
sLineBreak + ' Server version: ' + webClientVersion +
sLineBreak + 'Please click button to clear cache and reload.');
sLineBreak + 'Please clear cache and reload.');
end;
finally
iniFile.Free;
......@@ -146,6 +157,7 @@ begin
end;
end;
function TAuthService.CheckUser(const user, password: string): Integer;
var
SQL: string;
......@@ -175,6 +187,7 @@ begin
end;
end;
function TAuthService.QBAuthorize(code, realmId, state: string): string;
var
iniFile: TIniFile;
......@@ -187,6 +200,7 @@ begin
Logger.Log(3, 'TAuthService.QBAuthorize - end - result: ' + result);
end;
function TAuthService.ExchangeQBAuthCode(code: string): string;
var
iniFile: TIniFile;
......@@ -280,6 +294,8 @@ begin
end;
end;
initialization
RegisterServiceType(TAuthService);
end.
kgOrdersServer/Source/Common.Ini.pas 0 → 100644
unit Common.Ini;
interface
uses
System.SysUtils, System.IniFiles, Vcl.Forms;
type
TIniEntries = class
private
// [Settings]
FMemoLogLevel: Integer;
FFileLogLevel: Integer;
FLogFileNum: Integer;
// [Database]
FDBServer: string;
FDBPort: Integer;
FDBDatabase: string;
FDBUsername: string;
FDBPassword: string;
public
constructor Create;
// Properties
property memoLogLevel: Integer read FMemoLogLevel;
property fileLogLevel: Integer read FFileLogLevel;
property logFileNum: Integer read FLogFileNum;
property dbServer: string read FDBServer;
property dbPort: Integer read FDBPort;
property dbDatabase: string read FDBDatabase;
property dbUsername: string read FDBUsername;
property dbPassword: string read FDBPassword;
end;
procedure LoadIniEntries;
var
IniEntries: TIniEntries;
implementation
uses
Common.Logging;
procedure LoadIniEntries;
begin
Logger.Log(1, 'IniEntries global variable instantiated');
end;
{ TIniEntries }
constructor TIniEntries.Create;
var
iniFile: TIniFile;
begin
iniFile := TIniFile.Create(ChangeFileExt(Application.ExeName, '.ini'));
try
// [Settings]
FMemoLogLevel := iniFile.ReadInteger('Settings', 'MemoLogLevel', 3);
FFileLogLevel := iniFile.ReadInteger('Settings', 'FileLogLevel', 3);
FLogFileNum := iniFile.ReadInteger('Settings', 'LogFileNum', 0);
Inc(FLogFileNum);
iniFile.WriteInteger( 'Settings', 'LogFileNum', FLogFileNum );
// [Database]
FDBServer := iniFile.ReadString('Database', 'Server', '');
FDBPort := iniFile.ReadInteger('Database', 'Port', 0);
FDBDatabase := iniFile.ReadString('Database', 'Database', 'kg_order_entry');
FDBUsername := iniFile.ReadString('Database', 'Username', 'root');
FDBPassword := iniFile.ReadString('Database', 'Password', 'emsys01');
finally
iniFile.Free;
end;
end;
initialization
IniEntries := TIniEntries.Create;
finalization
IniEntries.Free;
end.
kgOrdersServer/Source/Lookup.Service.pas
......@@ -38,6 +38,7 @@ type
state: string;
zip: string;
contact: string;
first_line: string;
end;
TQBCustomerItem = class
......@@ -153,13 +154,14 @@ type
TAddressItem = class
Public
ship_block: string;
ship_id: string;
first_line: string;
shipping_address: string;
city: string;
state: string;
contact: string;
zip: string;
ship_id: string;
contact: string;
ship_block: string;
end;
TCustomerItem = class
......@@ -182,6 +184,12 @@ type
SHIPPING_ADDRESS_LIST: TList<TAddressItem>;
end;
TCustomerResponse = class
Public
customer: TCustomerItem;
status: string;
end;
TCustomerList = class
Public
count: integer;
......@@ -536,7 +544,7 @@ type
function AddUser(userInfo: string): string;
function AddItem(itemInfo: string): TJSONObject;
function AddShippingAddress(Addressinfo: string): TJSONObject;
function AddShippingAddress(Addressinfo: string): TCustomerResponse;
function DelShippingAddress(AddressID, CustomerID: string): TJSONObject;
function DelUser(username: string): string;
function DelOrder(orderID, orderType, UserID: string): TJSONObject;
......
kgOrdersServer/Source/Main.pas
......@@ -42,6 +42,7 @@ implementation
uses
Common.Logging,
Common.Ini,
Common.Config,
Sparkle.Utils,
Api.Database,
......@@ -110,50 +111,19 @@ end;
procedure TFMain.StartServers;
// Reads from the ini file to figure out what IP the database is located at and
// whether or not Twilio automatic updates should be enabled
var
iniFile: TIniFile;
iniStr: string;
bContinue: boolean;
debugMode: boolean;
devMode: boolean;
begin
// The version is centered when the app is running
Logger.Log( 1, '*******************************************************' );
Logger.Log( 1, '* kgOrdersServer *' );
Logger.Log(1, Format(' Version: %s ', [FMain.ExeInfo1.FileVersion]));
Logger.Log( 1, '* Developed by EM Systems, Inc. *' );
Logger.Log( 1, '*******************************************************' );
Logger.Log( 1, '' );
bContinue := True;
iniFile := TIniFile.Create( ExtractFilePath(Application.ExeName) + 'kgOrdersServer.ini' );
try
Logger.Log( 1, 'iniFile: ' + ExtractFilePath(Application.ExeName) + 'kgOrdersServer.ini' );
debugMode := iniFile.ReadBool( 'Settings', 'DebugMode', True );
Logger.Log( 1, 'debugMode: ' + BoolToStr(debugMode, True) );
Logger.Log( 1, 'LogLevels are displayed here. They were set in kgOrdersServer.dpr, it executes first' );
Logger.Log(1, '--- Settings ---');
iniStr := iniFile.ReadString( 'Settings', 'MemoLogLevel', '' );
if iniStr.IsEmpty then
Logger.Log( 1, '--Settings->MemoLogLevel: Entry not found - default: 3' )
else
Logger.Log( 1, '--Settings->MemoLogLevel: ' + iniStr );
iniStr := iniFile.ReadString( 'Settings', 'FileLogLevel', '' );
if iniStr.IsEmpty then
Logger.Log( 1, '--Settings->FileLogLevel: Entry not found - default: 4' )
else
Logger.Log( 1, '--Settings->FileLogLevel: ' + iniStr );
Logger.Log( 1, '' );
iniStr := iniFile.ReadString( 'Settings', 'LogFileNum', '' );
if iniStr.IsEmpty then
Logger.Log( 1, '--Settings->LogFileNum: Entry not found' )
else
Logger.Log( 1, '--Settings->LogFileNum: ' + IntToStr(StrToInt(iniStr) - 1) );
devMode := iniFile.ReadBool( 'Settings', 'devMode', True );
Logger.Log( 1, 'devMode: ' + BoolToStr(devMode, True) );
iniStr := iniFile.ReadString( 'Settings', 'webClientVersion', '' );
if iniStr.IsEmpty then
......@@ -172,25 +142,25 @@ begin
bContinue := False;
end
else
Logger.Log( 1, '----Database->Server: ' + iniStr );
Logger.Log( 1, '----Database->Server: ini entry: ' + iniStr );
iniStr := iniFile.ReadString('Database', 'Database', '');
if iniStr.IsEmpty then
Logger.Log( 1, '----Database->Database: ini entry not found - default: kg_order_entry' )
Logger.Log( 1, '----Database->Database: ini entry not found - default: ' + iniEntries.dbDatabase )
else
Logger.Log( 1, '----Database->Database: ini entry: ' + iniStr );
iniStr := iniFile.ReadString('Database', 'Username', '');
if iniStr.IsEmpty then
Logger.Log( 1, '----Database->Username: Entry not found - default: root' )
Logger.Log( 1, '----Database->Username: Entry not found - default: ' + iniEntries.dbUsername )
else
Logger.Log( 1, '----Database->Username: ' + iniStr );
Logger.Log( 1, '----Database->Username: ini entry: ' + iniStr );
iniStr := iniFile.ReadString('Database', 'Password', '');
if iniStr.IsEmpty then
Logger.Log( 1, '----Database->Password: Entry not found - default: xxxxxx' )
Logger.Log( 1, '----Database->Password: Entry not found - default: xxxxxxxx' )
else
Logger.Log( 1, '----Database->Password: xxxxxxxx' );
Logger.Log( 1, '----Database->Password: ini entry: xxxxxxxx' );
Logger.Log(1, '---Quickbooks---');
......@@ -198,7 +168,7 @@ begin
if iniStr.IsEmpty then
Logger.Log( 1, '--Quickbooks->CompanyID: Entry not found' )
else
Logger.Log( 1, '--Quickbooks->CompanyID: Entry found' );
Logger.Log( 1, '--Quickbooks->CompanyID: ini Entry: found' );
iniStr := IniFile.ReadString( 'Quickbooks', 'ClientID', '' );
if iniStr.IsEmpty then
......@@ -251,8 +221,9 @@ begin
else
begin
Logger.Log( 1, 'ini configuration error: Existing program!' );
if debugMode then
MessageDlg( 'ini configuration error: Existing program!', mtConfirmation, [mbOk], 0 );
if devMode then
MessageDlg( 'ini configuration error!', mtConfirmation, [mbOk], 0 )
else
Close();
end;
end;
......
kgOrdersServer/Source/rOrderCorrugated.pas
......@@ -138,7 +138,7 @@ uses
procedure TrptOrderCorrugated.DataModuleCreate(Sender: TObject);
begin
Logger.Log( 5, 'TrptOrderCorrugated.DataModuleCreate' );
LoadDatabaseSettings( ucKG, 'kgOrdersServer.ini' );
LoadDatabaseSettings( ucKG );
try
ucKG.Connect;
except
......@@ -156,15 +156,15 @@ var
colorArray: TJSONArray;
colorsObject, colorObject: TJSONObject;
colorsString: string;
i: Integer;
i, maxColors: Integer;
begin
logger.Log( 5, 'TrptOrderCorrugated.PopulateColorTable' );
maxColors := 13;
colorsString := uqOrderCorrugated.FieldByName('colors_colors').AsString;
colorsObject := TJSONObject.ParseJSONValue(colorsString) as TJSONObject;
colorArray := TJSONArray(colorsObject.GetValue<TJSONArray>('items'));
for i := 0 to colorArray.Count - 1 do
for i := 0 to maxColors - 1 do
begin
row := frxOrderCorrugated.FindObject('ColorRow' + IntToStr(i + 1)) as TfrxCustomTableRow;
colorObject := colorArray.Items[i] as TJSONObject;
......
kgOrdersServer/Source/rOrderCutting.dfm
......@@ -50,6 +50,134 @@ object rptOrderCutting: TrptOrderCutting
DataSetOptions = []
Left = 444
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
object frxOrderCutting: TfrxReport
Version = '2026.1.7'
......@@ -62,7 +190,7 @@ object rptOrderCutting: TrptOrderCutting
PrintOptions.Printer = 'Default'
PrintOptions.PrintOnSheet = 0
ReportOptions.CreateDate = 45691.397221759300000000
ReportOptions.LastChange = 45707.397776377300000000
ReportOptions.LastChange = 46143.643605335640000000
ScriptLanguage = 'PascalScript'
ScriptText.Strings = (
'begin'
......@@ -580,7 +708,7 @@ object rptOrderCutting: TrptOrderCutting
end
object SpecialInstructions: TfrxTableObject
AllowVectorExport = True
Left = 11.918845190000000000
Left = 8.139315190000000000
Top = 238.110390390000000000
object TableColumn61: TfrxTableColumn
Width = 723.779527559055000000
......@@ -618,7 +746,7 @@ object rptOrderCutting: TrptOrderCutting
DataSetName = 'frxDBOrderCutting'
Font.Charset = DEFAULT_CHARSET
Font.Color = clBlack
Font.Height = -11
Font.Height = -12
Font.Name = 'Arial'
Font.Style = []
Frame.Typ = [ftLeft, ftRight, ftTop, ftBottom]
......
kgOrdersServer/Source/rOrderCutting.pas
......@@ -69,7 +69,7 @@ uses
procedure TrptOrderCutting.DataModuleCreate(Sender: TObject);
begin
Logger.Log( 5, 'TrptOrderCutting.DataModuleCreate' );
LoadDatabaseSettings( ucKG, 'kgOrdersServer.ini' );
LoadDatabaseSettings( ucKG );
try
ucKG.Connect;
except
......
kgOrdersServer/Source/rOrderList.dfm
......@@ -401,11 +401,10 @@ object rptOrderList: TrptOrderList
Left = 941.480349130000000000
Top = 7.559060000000000000
Width = 45.354330710000000000
Height = 30.236220472440900000
Height = 30.236220470000000000
StretchMode = smActualHeight
ContentScaleOptions.Constraints.MaxIterationValue = 0
ContentScaleOptions.Constraints.MinIterationValue = 0
DataField = 'QB_REF_NUM'
DataSet = frxDBOrders
DataSetName = 'frxDBOrders'
Font.Charset = DEFAULT_CHARSET
......@@ -415,7 +414,7 @@ object rptOrderList: TrptOrderList
Font.Style = []
Frame.Typ = []
Memo.UTF8W = (
'[frxDBOrders."QB_REF_NUM"]')
'[frxDBOrders."QB_ORDER_NUM"]')
ParentFont = False
end
object Memo56: TfrxMemoView
......@@ -1217,11 +1216,6 @@ object rptOrderList: TrptOrderList
FieldName = 'PRICE'
Required = True
end
object uqOrdersQB_REF_NUM: TStringField
FieldName = 'QB_REF_NUM'
ReadOnly = True
Size = 24
end
object uqOrdersCOLORS: TStringField
FieldKind = fkCalculated
FieldName = 'COLORS'
......@@ -1271,6 +1265,10 @@ object rptOrderList: TrptOrderList
object uqOrdersORDER_DATE: TDateField
FieldName = 'ORDER_DATE'
end
object uqOrdersQB_ORDER_NUM: TStringField
FieldName = 'QB_ORDER_NUM'
Size = 50
end
end
object frxDBOrders: TfrxDBDataset
UserName = 'frxDBOrders'
......@@ -1280,6 +1278,126 @@ object rptOrderList: TrptOrderList
DataSetOptions = []
Left = 444
Top = 232
FieldDefs = <
item
FieldName = 'ORDER_ID'
end
item
FieldName = 'Loc'
FieldType = fftString
Size = 16
end
item
FieldName = 'COMPANY_NAME'
FieldType = fftString
Size = 90
end
item
FieldName = 'JOB_NAME'
FieldType = fftString
Size = 128
end
item
FieldName = 'ORDER_TYPE'
FieldType = fftString
Size = 45
end
item
FieldName = 'PROOF_DUE'
FieldType = fftDateTime
end
item
FieldName = 'PROOF_DONE'
FieldType = fftDateTime
end
item
FieldName = 'ART_DUE'
FieldType = fftDateTime
end
item
FieldName = 'ART_DONE'
FieldType = fftDateTime
end
item
FieldName = 'PLATE_DUE'
FieldType = fftDateTime
end
item
FieldName = 'PLATE_DONE'
FieldType = fftDateTime
end
item
FieldName = 'MOUNT_DUE'
FieldType = fftDateTime
end
item
FieldName = 'MOUNT_DONE'
FieldType = fftDateTime
end
item
FieldName = 'SHIP_DUE'
FieldType = fftDateTime
end
item
FieldName = 'SHIP_DONE'
FieldType = fftDateTime
end
item
FieldName = 'PRICE'
end
item
FieldName = 'COLORS'
FieldType = fftString
end
item
FieldName = 'po_number'
FieldType = fftString
Size = 16
end
item
FieldName = 'quickbooks_item'
FieldType = fftString
Size = 45
end
item
FieldName = 'NEW_ORDER_DATE'
FieldType = fftString
Size = 20
end
item
FieldName = 'NEW_PROOF_DONE'
FieldType = fftString
Size = 20
end
item
FieldName = 'NEW_ART_DONE'
FieldType = fftString
Size = 20
end
item
FieldName = 'NEW_PLATE_DONE'
FieldType = fftString
Size = 20
end
item
FieldName = 'NEW_MOUNT_DONE'
FieldType = fftString
Size = 20
end
item
FieldName = 'NEW_SHIP_DONE'
FieldType = fftString
Size = 20
end
item
FieldName = 'ORDER_DATE'
FieldType = fftDateTime
end
item
FieldName = 'QB_ORDER_NUM'
FieldType = fftString
Size = 50
end>
end
object uqColors: TUniQuery
Connection = ucKG
......
kgOrdersServer/Source/rOrderList.pas
......@@ -30,7 +30,6 @@ type
uqOrdersSHIP_DUE: TDateField;
uqOrdersSHIP_DONE: TDateTimeField;
uqOrdersPRICE: TFloatField;
uqOrdersQB_REF_NUM: TStringField;
uqOrdersCOLORS: TStringField;
uqColors: TUniQuery;
uqOrderspo_number: TStringField;
......@@ -42,6 +41,7 @@ type
uqOrdersNEW_MOUNT_DONE: TStringField;
uqOrdersNEW_SHIP_DONE: TStringField;
uqOrdersORDER_DATE: TDateField;
uqOrdersQB_ORDER_NUM: TStringField;
procedure DataModuleCreate(Sender: TObject);
procedure uqOrdersCalcFields(DataSet: TDataSet);
......@@ -68,7 +68,7 @@ uses
procedure TrptOrderList.DataModuleCreate(Sender: TObject);
begin
Logger.Log( 5, 'TrptOrderList.DataModuleCreate' );
LoadDatabaseSettings( ucKG, 'kgOrdersServer.ini' );
LoadDatabaseSettings( ucKG );
try
ucKG.Connect;
except
......
kgOrdersServer/Source/rOrderWeb.pas
......@@ -137,7 +137,7 @@ uses
procedure TrptOrderWeb.DataModuleCreate(Sender: TObject);
begin
Logger.Log( 5, 'TrptOrderWeb.DataModuleCreate' );
LoadDatabaseSettings( ucKG, 'kgOrdersServer.ini' );
LoadDatabaseSettings( ucKG );
try
ucKG.Connect;
except
......@@ -155,15 +155,16 @@ var
colorArray: TJSONArray;
colorsObject, colorObject: TJSONObject;
colorsString: string;
i: Integer;
i, maxColors: Integer;
begin
maxColors := 10;
logger.Log( 5, 'TrptOrderWeb.PopulateColorTable' );
colorsString := uqOrderWeb.FieldByName('quantity_and_colors_qty_colors').AsString;
colorsObject := TJSONObject.ParseJSONValue(colorsString) as TJSONObject;
colorArray := TJSONArray(colorsObject.GetValue<TJSONArray>('items'));
for i := 0 to colorArray.Count - 1 do
for i := 0 to maxColors - 1 do
begin
row := frxOrderWeb.FindObject('ColorRow' + IntToStr(i + 1)) as TfrxCustomTableRow;
colorObject := colorArray.Items[i] as TJSONObject;
......
kgOrdersServer/Source/uLibrary.pas
......@@ -3,32 +3,25 @@ unit uLibrary;
interface
uses
System.Classes, Uni;
Common.Ini,
System.Classes,
Uni;
procedure LoadDatabaseSettings( uc: TUniConnection; iniFilename: string );
procedure DoQuery( uq: TUniQuery; sql: string );
procedure LoadDatabaseSettings(uc: TUniConnection);
procedure DoQuery(uq: TUniQuery; sql: string);
implementation
uses
System.SysUtils,
System.IniFiles,
Vcl.Forms,
Data.DB;
procedure LoadDatabaseSettings( uc: TUniConnection; iniFilename: string );
var
iniFile: TIniFile;
procedure LoadDatabaseSettings(uc: TUniConnection);
begin
iniFile := TIniFile.Create( ExtractFilePath(Application.ExeName) + iniFilename );
try
uc.Server := iniFile.ReadString('Database', 'Server', '');
uc.Database := iniFile.ReadString('Database', 'Database', 'kg_order_entry');
uc.Username := iniFile.ReadString('Database', 'Username', 'root');
uc.Password := iniFile.ReadString('Database', 'Password', 'emsys01');
finally
iniFile.Free;
end;
uc.Server := iniEntries.dbServer;
uc.Database := iniEntries.dbDatabase;
uc.Username := iniEntries.dbUsername;
uc.Password := iniEntries.dbPassword;
end;
procedure DoQuery(uq: TUniQuery; sql: string);
......
kgOrdersServer/kgOrdersServer.dpr
......@@ -26,10 +26,11 @@ uses
rOrderCorrugated in 'Source\rOrderCorrugated.pas' {rptOrderCorrugated: TDataModule},
rOrderWeb in 'Source\rOrderWeb.pas' {rptOrderWeb: TDataModule},
rOrderCutting in 'Source\rOrderCutting.pas' {rptOrderCutting: TDataModule},
qbAPI in 'Source\qbAPI.pas' {fQB};
qbAPI in 'Source\qbAPI.pas' {fQB},
Common.Ini in 'Source\Common.Ini.pas';
type
TMemoLogAppender = class( TInterfacedObject, ILogAppender )
TMemoLogAppender = class(TInterfacedObject, ILogAppender)
private
FLogLevel: Integer;
FLogMemo: TMemo;
......@@ -40,18 +41,19 @@ type
procedure Send(logLevel: Integer; Log: ILog);
end;
TFileLogAppender = class( TInterfacedObject, ILogAppender )
TFileLogAppender = class(TInterfacedObject, ILogAppender)
private
FLogLevel: Integer;
FLogFile: string;
FCriticalSection: TCriticalSection;
public
constructor Create(ALogLevel: Integer; AFilename: string);
constructor Create(ALogLevel: Integer; AFilename: string; AFileNum: Integer);
destructor Destroy; override;
procedure Send(logLevel: Integer; Log: ILog);
end;
{ TMemoLogAppender }
constructor TMemoLogAppender.Create(ALogLevel: Integer; ALogMemo: TMemo);
begin
FLogLevel := ALogLevel;
......@@ -67,34 +69,33 @@ end;
procedure TMemoLogAppender.Send(logLevel: Integer; Log: ILog);
var
FormattedMessage: string;
LogTime: TDateTime;
LogMsg: string;
logMsg: string;
logTime: TDateTime;
formattedMessage: string;
begin
FCriticalSection.Acquire;
try
LogTime := Now;
logTime := Now;
FormattedMessage := FormatDateTime('[yyyy-mm-dd HH:nn:ss.zzz]', LogTime);
LogMsg := Log.GetMessage;
if LogMsg.IsEmpty then
FormattedMessage := ''
formattedMessage := FormatDateTime('[yyyy-mm-dd HH:nn:ss.zzz]', logTime);
logMsg := Log.GetMessage;
if logMsg.IsEmpty then
formattedMessage := ''
else
FormattedMessage := FormattedMessage + '[' + IntToStr(logLevel) +'] ' + LogMsg;
formattedMessage := formattedMessage + '[' + IntToStr(logLevel) + '] ' + logMsg;
if logLevel <= FLogLevel then
FLogMemo.Lines.Add( FormattedMessage );
FLogMemo.Lines.Add(formattedMessage);
finally
FCriticalSection.Release;
end;
end;
{ TFileLogAppender }
constructor TFileLogAppender.Create(ALogLevel: integer; AFilename: string);
constructor TFileLogAppender.Create(ALogLevel: integer; AFilename: string; AFileNum: integer);
var
iniFile: TIniFile;
fileNum: integer;
logsDir: string;
begin
FLogLevel := ALogLevel;
......@@ -103,14 +104,7 @@ begin
if not DirectoryExists(logsDir) then
CreateDir(logsDir);
iniFile := TIniFile.Create( ExtractFilePath(Application.ExeName) + 'kgOrdersServer.ini' );
try
fileNum := iniFile.ReadInteger( 'Settings', 'LogFileNum', 0 );
FLogFile := logsDir + AFilename + Format( '%.4d', [fileNum] ) + '.log';
iniFile.WriteInteger( 'Settings', 'LogFileNum', fileNum + 1 );
finally
iniFile.Free;
end;
FLogFile := logsDir + AFilename + Format( '%.4d', [AFileNum] ) + '.log';
end;
destructor TFileLogAppender.Destroy;
......@@ -119,14 +113,16 @@ begin
inherited;
end;
procedure TFileLogAppender.Send(logLevel: integer; Log: ILog);
procedure TFileLogAppender.Send(logLevel: Integer; Log: ILog);
var
formattedMessage: string;
logTime: TDateTime;
logFile: TextFile;
logMsg: string;
txtFile: TextFile;
logTime: TDateTime;
formattedMessage: string;
begin
if logLevel > FLogLevel then
Exit;
FCriticalSection.Acquire;
try
logTime := Now;
......@@ -136,18 +132,18 @@ begin
if logMsg.IsEmpty then
formattedMessage := ''
else
formattedMessage := formattedMessage + '[' + IntToStr(logLevel) +'] ' + logMsg;
formattedMessage := formattedMessage + '[' + IntToStr(logLevel) + '] ' + logMsg;
try
AssignFile( txtFile, FLogFile );
AssignFile( logFile, FLogFile );
if FileExists(FLogFile) then
Append( txtFile )
Append(logFile)
else
ReWrite( txtFile );
if logLevel <= FLogLevel then
WriteLn( txtFile, formattedMessage );
Rewrite(logFile);
try
Writeln(logFile, formattedMessage);
finally
CloseFile(txtFile);
CloseFile(logFile);
end;
finally
FCriticalSection.Release;
......@@ -157,23 +153,55 @@ end;
{$R *.res}
var
iniFilename: string;
iniFile: TIniFile;
MemoLogLevel: Integer;
FileLogLevel: Integer;
iniStr: string;
begin
ReportMemoryLeaksOnShutdown := True;
Application.Initialize;
Application.MainFormOnTaskbar := True;
Application.CreateForm(TFMain, FMain);
iniFile := TIniFile.Create( ExtractFilePath(Application.ExeName) + 'kgOrdersServer.ini' );
iniFilename := ChangeFileExt( Application.ExeName, '.ini' );
iniFile := TIniFile.Create( iniFilename );
try
MemoLogLevel := iniFile.ReadInteger( 'Settings', 'MemoLogLevel', 3 );
FileLogLevel := iniFile.ReadInteger( 'Settings', 'FileLogLevel', 4 );
Logger.AddAppender( TMemoLogAppender.Create(iniEntries.memoLogLevel, FMain.memoinfo) );
Logger.AddAppender( TFileLogAppender.Create(iniEntries.fileLogLevel, 'emT3XDataServer', iniEntries.logFileNum) );
Logger.Log( 1, '*******************************************************' );
Logger.Log( 1, '* kgOrdersServer *' );
Logger.Log( 1, Format(' Version: %s ', [FMain.ExeInfo1.FileVersion]));
Logger.Log( 1, '* Developed by EM Systems, Inc. *' );
Logger.Log( 1, '*******************************************************' );
Logger.Log( 1, '' );
//iniEntries is automatically instantiated when the file Common.Ini is used
//we added LoadIniEntries call to put an entry in the Log file
LoadIniEntries;
Logger.Log( 1, 'iniFile: ' + iniFilename );
iniStr := iniFile.ReadString( 'Settings', 'MemoLogLevel', '' );
if iniStr.IsEmpty then
Logger.Log( 1, '--Settings->MemoLogLevel: ini entry not found - default: ' + IntToStr(iniEntries.memoLogLevel) )
else
Logger.Log( 1, '--Settings->MemoLogLevel: ini entry: ' + iniStr );
iniStr := iniFile.ReadString( 'Settings', 'FileLogLevel', '' );
if iniStr.IsEmpty then
Logger.Log( 1, '--Settings->FileLogLevel: ini entry not found - default: ' + IntToStr(iniEntries.fileLogLevel) )
else
Logger.Log( 1, '--Settings->FileLogLevel: ini entry: ' + iniStr );
Logger.Log( 1, '' );
iniStr := iniFile.ReadString( 'Settings', 'LogFileNum', '' );
if iniStr = '1' then
Logger.Log( 1, '--Settings->LogFileNum: ini entry not found - LogFileNum 1 added to iniFile' )
else
Logger.Log( 1, '--Settings->LogFileNum: ini entry: ' + iniStr );
finally
iniFile.Free;
end;
Logger.AddAppender(TMemoLogAppender.Create( MemoLogLevel, FMain.memoinfo ));
Logger.AddAppender(TFileLogAppender.Create( FileLogLevel, 'kgOrdersServer' ));
Application.Run;
end.
kgOrdersServer/kgOrdersServer.dproj
......@@ -114,11 +114,11 @@
<VerInfo_Locale>1033</VerInfo_Locale>
<DCC_ExeOutput>.\bin</DCC_ExeOutput>
<DCC_UnitSearchPath>C:\RADTOOLS\FastMM4;$(DCC_UnitSearchPath)</DCC_UnitSearchPath>
<VerInfo_Keys>CompanyName=EM Systems;FileDescription=$(MSBuildProjectName);FileVersion=0.9.15.1;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=0.9.11;Comments=</VerInfo_Keys>
<VerInfo_Keys>CompanyName=EM Systems;FileDescription=$(MSBuildProjectName);FileVersion=0.9.15.4;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=0.9.11;Comments=</VerInfo_Keys>
<VerInfo_MajorVer>0</VerInfo_MajorVer>
<VerInfo_MinorVer>9</VerInfo_MinorVer>
<VerInfo_Release>15</VerInfo_Release>
<VerInfo_Build>1</VerInfo_Build>
<VerInfo_Build>4</VerInfo_Build>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_1_Win64)'!=''">
<AppDPIAwarenessMode>PerMonitorV2</AppDPIAwarenessMode>
......@@ -209,6 +209,7 @@
<Form>fQB</Form>
<FormType>dfm</FormType>
</DCCReference>
<DCCReference Include="Source\Common.Ini.pas"/>
<BuildConfiguration Include="Base">
<Key>Base</Key>
</BuildConfiguration>
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment