Topic: [SOLVED] Weird application error messages at login
I have made some minor alterations to a program that runs.
1. added a new form and code for that form.
2. added code to an existing method that reads and deletes an entry in the database.
Application compiles with no errors, and I can log on to the program using my login and one of the other users. However out of 12 users in the database only my login and one other now works.
If I try to log in as the other users I get the following two message boxes and two instances per user attempted login of the application appear in Task Manager with a CPU usage of 100%.
Error message 1:
Exception EListError in module workshopPartsDB.exe at 000BC592. List index out of bounds (7). when I click OK, the second message pops up
Error message 2:
Access violation at address 00E3A5C8 in module 'workshopPartsDB.exe'. Read of address 00000000
Does anyone have any idea what list index the application is suddenly having a problem with?
It is really weird that the only two users that can log in are the first two in the database, user_ID 3 to 12 cause this problem.
The added code which is now commented out:
procedure frmMain_tgLogged_OnCellDoubleClick (Sender: TObject; ACol, ARow: Integer);
var
logName : string;
begin
logName := SQLExecute('SELECT username FROM user_log WHERE username ="' + Application.User.Username + '"');
showmessage(logName);
{ if Application.User.Username = logName then
MessageBox('You cannot FORCE your own logout ' + #13#10#13#10 + 'Please select another user or close the program normally.','Logout Problem ' + Application.User.Username,MB_OK+MB_ICONERROR)
else
begin
SqlExecute('Delete FROM user_log WHERE id = "' + frmMain.tgLogged.sqlValue + '"');
frmMain.tgLogged.dbUpdate;
end;}
end;The code for the new form:
procedure frmChangePartNumber_btnNewPartNo_OnClick (Sender: TObject; var Cancel: boolean);
begin
sqlexecute('UPDATE products SET LineNumber = "'+frmChangePartNumber.edtNewPartNo.text+'" WHERE id = '+IntToStr(frmEditPart.grdEditPart.dbItemID));
frmEditPart.grdEditPart.dbUpdate;
//showMessage('After update '+ frmEditPart.grdEditPart.Cells[0,rowSelect]);
frmEditPart.lbLineNo.Caption := frmChangePartNumber.lbCurrentPartNo.Caption;
frmChangePartNumber.Close;
end;
procedure frmChangePartNumber_edtNewPartNo_OnExit(Sender: TObject);
var
buttonSelected: integer;
lngth : integer;
begin
lngth := Length(frmChangePartNumber.edtNewPartNo.text); //check how many digits have been entered
if (frmChangePartNumber.edtNewPartNo.Text = '') or (frmChangePartNumber.lbCurrentPartNo.Caption = frmChangePartNumber.edtNewPartNo.Text) then
begin
MessageBox('No Changes have been made','INFORMATION',0);
frmChangePartNumber.edtNewPartNo.SetFocus;
end
else {entry must be a seven digit number}
if lngth <> 7 then
begin
messageDlg('Part Number must be 7 digits long',mtError, mbCancel, 0);
frmChangePartNumber.edtNewPartNo.SetFocus;
end;
if frmMain.edtInternalNumber.text = sqlexecute('SELECT lineNumber FROM products WHERE lineNumber = "'+frmChangePartNumber.edtNewPartNo.text+'"') then
begin
buttonSelected := messageDlg('WARNING Part Number already exists',mtWarning, mbOK+mbRetry, 0);
if buttonSelected = mrRetry then
//frmMain.edtInternalNumber.Clear
frmChangePartNumber.edtNewPartNo.SetFocus
else
exit;
end;
end;
procedure frmChangePartNumber_OnShow (Sender: TObject; Action: string);
begin
frmChangePartNumber.edtNewPartNo.Clear;
frmChangePartNumber.lbCurrentPartNo.Caption := frmEditPart.lbLineNo.Caption;
frmChangePartNumber.edtNewPartNo.SetFocus;
end;
procedure frmEditPart_lbLineNo_OnDoubleClick (Sender: TObject);
begin
if frmEditPart.lbLineNo.Caption <> 'LineNo' then
frmChangePartNumber.Show;
end;
dbEntries.PNG