Skip to content

K
kgOrders
Commit 9824e397 by Cam Hayes
Options

Changed EditUser form, fixed memory leak issues, and fixed issue with database… 

Changed EditUser form, fixed memory leak issues, and fixed issue with database files crashing on create
parent 59c3c0cc
Showing with 95 additions and 180 deletions
kgOrdersClient/View.EditUser.dfm
......@@ -3,8 +3,8 @@ object FViewEditUser: TFViewEditUser
Height = 480
OnShow = WebFormCreate
object WebLabel2: TWebLabel
Left = 16
Top = 8
Left = 33
Top = 33
Width = 57
Height = 15
Caption = 'Full Name:'
......@@ -14,8 +14,8 @@ object FViewEditUser: TFViewEditUser
WidthPercent = 100.000000000000000000
end
object WebLabel3: TWebLabel
Left = 14
Top = 37
Left = 283
Top = 8
Width = 53
Height = 15
Caption = 'Password:'
......@@ -25,7 +25,7 @@ object FViewEditUser: TFViewEditUser
WidthPercent = 100.000000000000000000
end
object WebLabel5: TWebLabel
Left = 280
Left = 34
Top = 8
Width = 56
Height = 15
......@@ -35,19 +35,8 @@ object FViewEditUser: TFViewEditUser
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
end
object WebLabel6: TWebLabel
Left = 236
Top = 37
Width = 100
Height = 15
Caption = 'Confirm Password:'
Color = clBtnFace
ElementID = 'lblconfirm'
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
end
object WebLabel7: TWebLabel
Left = 35
Left = 58
Top = 62
Width = 32
Height = 15
......@@ -58,8 +47,8 @@ object FViewEditUser: TFViewEditUser
WidthPercent = 100.000000000000000000
end
object lblactive: TWebLabel
Left = 45
Top = 163
Left = 298
Top = 36
Width = 38
Height = 15
Caption = 'Active?'
......@@ -99,17 +88,6 @@ object FViewEditUser: TFViewEditUser
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
end
object edtConfirmPassword: TWebEdit
Left = 346
Top = 34
Width = 121
Height = 22
ChildOrder = 7
ElementID = 'edtconfirmpassword'
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
OnChange = edtConfirmPasswordChange
end
object edtEmail: TWebEdit
Left = 96
Top = 62
......@@ -129,7 +107,6 @@ object FViewEditUser: TFViewEditUser
ElementID = 'edtpassword'
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
OnChange = edtPasswordChange
end
object btnConfirm: TWebButton
Left = 96
......@@ -151,8 +128,8 @@ object FViewEditUser: TFViewEditUser
OnClick = btnConfirmClick
end
object edtFullname: TWebEdit
Left = 96
Top = 4
Left = 346
Top = 5
Width = 121
Height = 22
ChildOrder = 14
......@@ -161,8 +138,8 @@ object FViewEditUser: TFViewEditUser
WidthPercent = 100.000000000000000000
end
object edtUsername: TWebEdit
Left = 346
Top = 4
Left = 96
Top = 6
Width = 121
Height = 22
ChildOrder = 14
......@@ -190,8 +167,8 @@ object FViewEditUser: TFViewEditUser
OnClick = btnCancelClick
end
object cbStatus: TWebCheckBox
Left = 96
Top = 162
Left = 346
Top = 33
Width = 107
Height = 20
Caption = 'Active?'
......
kgOrdersClient/View.EditUser.html
......@@ -6,12 +6,6 @@
<form id="edituserform" class="row g-3 needs-validation" novalidate>
<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>
<input id="edtusername" class="form-control" required>
<div class="invalid-feedback">Username is required.</div>
......@@ -20,19 +14,26 @@
<div class="col-md-6">
<label id="lblpassword" for="edtpassword" class="form-label">Password</label>
<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 class="col-md-6">
<label id="lblconfirm" for="edtconfirmpassword" class="form-label">Confirm&nbsp;Password</label>
<input id="edtconfirmpassword" type="password" class="form-control" required disabled>
<div class="invalid-feedback">Passwords must match.</div>
<label id="lblactive" for="cbstatus" class="form-label">Active</label>
<div class="form-check mt-1">
<input id="cbstatus" class="form-check-input" type="checkbox" style="width: 1.5em; height: 1.5em;">
</div>
</div>
<div class="col-md-6">
<label id="lblemail" for="edtemail" class="form-label">Email&nbsp;Address</label>
<input id="edtemail" type="email" class="form-control" required>
<div class="invalid-feedback">Valid email is required.</div>
<input id="edtemail" type="email" class="form-control">
</div>
<div class="col-md-6">
......@@ -47,19 +48,8 @@
<div class="col-md-6">
<label id="lblaccess" for="cbaccess" class="form-label">Access&nbsp;Type</label>
<select id="cbaccess" class="form-select" required>
<option selected disabled value="">Choose...</option>
<option value="ALL">All</option>
<option value="LIMITED">Limited</option>
<select id="cbaccess" class="form-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 class="d-flex gap-2 mt-4">
......
kgOrdersClient/View.EditUser.pas
......@@ -15,9 +15,7 @@ type
WebLabel2: TWebLabel;
WebLabel3: TWebLabel;
WebLabel5: TWebLabel;
WebLabel6: TWebLabel;
WebLabel7: TWebLabel;
edtConfirmPassword: TWebEdit;
edtEmail: TWebEdit;
edtPassword: TWebEdit;
btnConfirm: TWebButton;
......@@ -38,8 +36,6 @@ type
procedure btnConfirmClick(Sender: TObject);
procedure btnCancelClick(Sender: TObject);
procedure WebTimer1Timer(Sender: TObject);
procedure edtPasswordChange(Sender: TObject);
procedure edtConfirmPasswordChange(Sender: TObject);
private
{ Private declarations }
FMessage: string;
......@@ -54,7 +50,6 @@ type
QB: string;
[async] procedure EditUser();
[async] function AddUser(): string;
procedure ValidatePasswords;
public
{ Public declarations }
Info: string;
......@@ -138,16 +133,6 @@ begin
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,
Access, Rights, QB: string): TWebForm;
// Autofills known information about a user on create
......@@ -180,7 +165,6 @@ begin
if Mode = 'Edit' then
begin
edtPassword.Text := 'hidden';
edtConfirmPassword.Text := 'hidden';
end;
edtEmail.Text := Email;
cbAccess.Text := Access;
......@@ -226,52 +210,4 @@ begin
WebTimer1.Enabled := True;
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.
kgOrdersServer/Source/Api.Database.dfm
......@@ -6,8 +6,6 @@ object ApiDatabase: TApiDatabase
ProviderName = 'MySQL'
Database = 'kg_order_entry'
Username = 'root'
Server = '192.168.159.10'
Connected = True
LoginPrompt = False
Left = 75
Top = 65
......
kgOrdersServer/Source/Auth.ServiceImpl.pas
......@@ -55,7 +55,15 @@ uses
procedure TAuthService.AfterConstruction;
begin
inherited;
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;
procedure TAuthService.BeforeDestruction;
......@@ -130,8 +138,10 @@ begin
logger.Log(2, 'Login Error: User does not exist!');
end
else if userState = 2 then
begin
raise EXDataHttpUnauthorized.Create('User not active!');
logger.Log(2, 'Login Error: User not active!');
end;
iniFile := TIniFile.Create(ChangeFileExt(ParamStr(0), '.ini'));
......
kgOrdersServer/Source/Lookup.ServiceImpl.pas
......@@ -339,13 +339,22 @@ begin
restClient.Free;
restRequest.Free;
restResponse.Free;
estimateJSON.Free;
end;
end;
procedure TLookupService.AfterConstruction;
begin
inherited;
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;
procedure TLookupService.BeforeDestruction;
......@@ -400,6 +409,7 @@ var
begin
logger.Log(3, 'TLookupService.GetCustomers');
params := TStringList.Create;
try
params.StrictDelimiter := true;
params.Delimiter := '&';
params.DelimitedText := customerInfo;
......@@ -457,6 +467,9 @@ begin
raise EXDataHttpException.Create(500, 'Unable to retrieve customer list: A KG Orders Database issue has occurred!');
end;
end;
finally
params.Free;
end;
end;
......@@ -554,9 +567,9 @@ var
begin
logger.Log(3, 'TLookupService.GenerateOrderListPDF');
rptOrderList := TrptOrderList.Create(nil);
params := TStringList.Create;
try
try
params := TStringList.Create;
params.StrictDelimiter := true;
params.Delimiter := '&';
params.DelimitedText := searchOptions;
......@@ -591,6 +604,7 @@ begin
end;
finally
rptOrderList.Free;
params.Free;
end;
end;
......@@ -615,6 +629,7 @@ begin
logger.Log(3, 'TLookupSerivce.AddShippingAddress');
result := TJSONObject.Create;
JSONData := TJSONObject.ParseJSONValue(AddressInfo) as TJSONObject;
try
if JSONData = nil then
raise Exception.Create('Invalid JSON format'); // If parsing fails, raise an exception
mode := JSONData.GetValue<string>('mode');
......@@ -690,6 +705,9 @@ begin
Result.AddPair('error', E.Message);
end
end;
finally
//JSONData.Free;
end;
end;
function TLookupService.AddCustomer(customerInfo: string): TJSONObject;
......@@ -710,6 +728,7 @@ begin
DateFormat.ShortDateFormat := 'yyyy-mm-dd';
DateFormat.DateSeparator := '-';
JSONData := TJSONObject.ParseJSONValue(customerInfo) as TJSONObject;
try
if JSONData = nil then
raise Exception.Create('Invalid JSON format'); // If parsing fails, raise an exception
mode := JSONData.GetValue<string>('mode');
......@@ -804,6 +823,9 @@ begin
end
else
Result := TJSONObject.Create.AddPair('status', 'Failure: Company Account Name Must Be Unique');
finally
//JSONData.Free;
end;
end;
function TLookupService.GenerateOrderCorrugatedPDF(orderID: string): string;
......@@ -894,8 +916,6 @@ begin
end;
end;
function TLookupService.generateSubQuery(currStatus: string): string;
// 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
......@@ -1035,6 +1055,8 @@ var
begin
result := TSQLQuery.Create;
params := TStringList.Create;
try
params.StrictDelimiter := true;
params.Delimiter := '&';
params.DelimitedText := searchOptions;
......@@ -1111,6 +1133,9 @@ begin
result.SQL := SQL;
result.whereSQL := whereSQL;
finally
params.Free;
end;
end;
function TLookupService.getColorCount(colors: string): string;
......@@ -1241,7 +1266,6 @@ var
orderID: string;
SQL: string;
table: string;
ADDRESS: TAddressItem;
begin
logger.Log(3,'TLookupService.GetCorrugatedOrder');
orderID := orderInfo;
......@@ -1351,7 +1375,6 @@ var
orderType: string;
orderID: string;
SQL: string;
ADDRESS: TAddressItem;
begin
logger.Log(3, 'TLookupService.GetWebOrder');
try
......@@ -1479,7 +1502,6 @@ var
orderType: string;
orderID: string;
SQL: string;
ADDRESS: TAddressItem;
begin
logger.Log(3, 'TLookupService.GetCuttingDieOrder');
try
......@@ -1540,8 +1562,9 @@ var
item: TItemItem;
begin
logger.Log(3, 'TLookupService.GetItems');
try
params := TStringList.Create;
try
try
params.StrictDelimiter := true;
// parse the searchOptions
params.Delimiter := '&';
......@@ -1591,6 +1614,9 @@ begin
raise EXDataHttpException.Create(500, 'Unable to retrieve item list:A KG Orders database issue has occurred!');
end;
end;
finally
params.Free;
end;
end;
function TLookupService.GetUsers(searchOptions: string): TUserList;
......@@ -1683,6 +1709,7 @@ var
begin
logger.log(3, 'TLookupService.EditUser');
params := TStringList.Create;
try
params.Delimiter := '&';
params.StrictDelimiter := true;
params.DelimitedText := editOptions;
......@@ -1706,8 +1733,6 @@ begin
begin
ordersDB.UniQuery1.Edit;
//user.password := ordersDB.UniQuery1.FieldByName('PASSWORD').AsString;
if not newUser.IsEmpty then
ordersDB.UniQuery1.FieldByName('USER_NAME').AsString := newUser;
......@@ -1748,6 +1773,9 @@ begin
Result := 'Success: User Successfully Edited';
end;
ordersDB.UniQuery1.Close;
finally
params.Free;
end;
end;
procedure TLookupService.AddToOrdersTable(mode, ORDER_TYPE: string; JSONData: TJSONObject);
......@@ -1771,12 +1799,7 @@ begin
ordersDB.UniQuery1.FieldByName('ORDER_TYPE').AsString := ORDER_TYPE;
if mode = 'ADD' then
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;
ordersDB.UniQuery1.FieldByName('ORDER_DATE').AsDateTime := Now;
if JSONData.GetValue<string>('staff_fields_price') = '' then
ordersDB.UniQuery1.FieldByName('PRICE').AsString := '0'
......@@ -1812,6 +1835,7 @@ begin
DateFormat.ShortDateFormat := 'yyyy-mm-dd';
DateFormat.DateSeparator := '-';
JSONData := TJSONObject.ParseJSONValue(orderInfo) as TJSONObject;
try
if JSONData = nil then
raise Exception.Create('Invalid JSON format'); // If parsing fails, raise an exception
mode := JSONData.GetValue<string>('mode');
......@@ -1888,6 +1912,9 @@ begin
raise EXDataHttpException.Create(500, 'Unable to add or edit web order: A KG Orders database issue has occurred!');
end
end;
finally
//JSONData.Free;
end;
end;
......@@ -1959,7 +1986,7 @@ begin
logger.Log(3, 'TLookupService.SetStatus');
StatusInfo := TJSONObject.ParseJSONValue(statusOptions) as TJSONObject;
params := TStringList.Create;
// parse the statusOptions
try
params.Delimiter := '&';
params.StrictDelimiter := true;
params.DelimitedText := statusOptions;
......@@ -1969,27 +1996,6 @@ begin
UserID := StatusInfo.GetValue<string>('USER_ID');
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);
SQL := 'select * from orders_status where ORDER_ID = ' + IntToStr(ORDER_ID) + ' AND ' +
......@@ -2032,18 +2038,6 @@ begin
begin
order := TJSONObject.Create;
try
{ SQL := 'select * from orders_status_schedule where ORDER_ID = ' + IntToStr(ORDER_ID) + ' AND ' +
'ORDER_STATUS = ' + quotedStr(NextStatus);
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'
......@@ -2077,6 +2071,9 @@ begin
on E: Exception do
logger.Log(2, 'An error occurred when setting status: ' + E.Message);
end;
finally
params.Free;
end;
end;
......@@ -2099,8 +2096,9 @@ var
params: TStringList;
begin
logger.Log(3, 'TLookupService.AddUser');
try
params := TStringList.Create;
try
try
params.StrictDelimiter := True;
params.Delimiter := '&';
params.DelimitedText := userInfo;
......@@ -2157,6 +2155,9 @@ begin
raise EXDataHttpException.Create(500, 'Unable to Add User: A KG Orders database issue has occurred!');
end;
end;
finally
params.Free;
end;
end;
......@@ -2177,6 +2178,7 @@ begin
logger.Log(3, 'TLookupService.AddItem');
result := TJSONObject.Create;
JSONData := TJSONObject.ParseJSONValue(itemInfo) as TJSONObject;
try
if JSONData = nil then
raise Exception.Create('Invalid JSON format'); // If parsing fails, raise an exception
mode := JSONData.GetValue<string>('mode');
......@@ -2233,6 +2235,9 @@ begin
on E: Exception do
logger.Log(2, 'An error occurred when adding an item: ' + E.Message);
end;
finally
//JSONData.Free;
end;
end;
......@@ -2241,8 +2246,7 @@ function TLookupService.DelUser(username: string): string;
// deleting users prematurely.
// username: username to be deleted.
var
SQL: string;
params: TStringList;
SQL: string;
begin
logger.Log(3, 'TLookupService.DelUser');
SQL := 'select * from users where username = ' + QuotedStr(username.toLower);
......
kgOrdersServer/bin/kgOrdersServer.ini
......@@ -2,7 +2,7 @@
MemoLogLevel=4
FileLogLevel=4
webClientVersion=1.0.0
LogFileNum=141
LogFileNum=157
[Database]
--Server=192.168.116.138
......
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