Dear Expert
Can any one help to resolve this issue which display a message at login form and the code is as below:
Code:
Private Sub CmdLogin_Click()
On Error GoTo Err_Handler
'First thing needed is to decide which option to take
'If there is an entry in the txtOldPwd field this is an existing password
'If there is an entry in the txtConPwd field this is a new password setup
'If there is an entry in all three then the user has reset their password
'1. If password has been reset then all the validation has taken place
'so can open the main menu straight away
If bReset = True Then
DoLogin
Exit Sub
End If
'2. check a password has been entered
If Trim(Me.txtOldPWD & "") <> "" Then
'does it match the users password
' If Trim(Me.TxtOldPWD & "") <> DecryptKey(Me.cboUser.Column(2)) Then
If Trim(Me.txtOldPWD & "") <> RC4(Me.cboUser.Column(2), "RC4_Key") Then
'No Match - 3 attempts allowed
Attempts = Attempts + 1
Select Case Attempts
Case 1
FormattedMsgBox "Invalid Password " & _
"@Please try again @", vbInformation + vbOKOnly, "Password Error"
Me.txtOldPWD = ""
Case 2
FormattedMsgBox "You have entered an incorrect password TWICE " & _
"@You have ONE more attempt left @", vbExclamation + vbOKOnly, "Password Error"
Me.txtOldPWD = ""
Case 3
FormattedMsgBox "You have entered an incorrect password THREE times " & _
"@The application will now close @", vbCritical + vbOKOnly, "Password entry failed"
Application.Quit
Exit Sub
End Select
End If
'Create a login event for this user
DoLogin
Else
'Has the user got a password
' If DecryptKey(Me.cboUser.Column(2)) <> "Not Set" Then
If RC4(Me.cboUser.Column(2), "RC4_Key") <> "Not Set" Then
'allow 3 attempts
Attempts = Attempts + 1
Select Case Attempts
Case 1
FormattedMsgBox "You must enter your password first " & _
"@Please try again @", vbExclamation + vbOKOnly, "Password REQUIRED"
Me.txtOldPWD = ""
Case 2
FormattedMsgBox "You must enter your password first " & _
"@You have ONE more attempt left @", vbExclamation + vbOKOnly, "Password REQUIRED"
Me.txtOldPWD = ""
Case 3
FormattedMsgBox "Maximum number of attempts has been reached" & _
"@The application will now close @", vbExclamation + vbOKOnly, "Login aborted"
Application.Quit
Exit Sub
End Select
End If
'3. New password setup
'Compare both both entries as matching
'Is there an entry in either of the text boxes
If Trim(Me.txtNewPWD & "") = "" Then
FormattedMsgBox "You must enter a new password. " & _
"@Cannot be left blank. @", vbExclamation + vbOKOnly, "Invalid Password"
Exit Sub
End If
If Trim(Me.txtConPWD & "") = "" Then
FormattedMsgBox "You must confirm the new password. " & _
"@Cannot be left blank. @", vbExclamation + vbOKOnly, "Invalid Password Confirmation"
Exit Sub
End If
'do they match
If Trim(Me.txtNewPWD & "") <> Trim(Me.txtConPWD & "") Then
FormattedMsgBox "Error " & _
"@Passwords do not match. @", vbExclamation + vbOKOnly, "Invalid Password Confirmation"
Me.txtConPWD.SetFocus
Exit Sub
Else
'they both match so we can update the users record with the new password
strPassword = Me.txtConPWD
' CurrentDb.Execute "UPDATE tblUsers SET PWD = EncryptKey(strPassword), PWDDate = Date()" & _
" WHERE UserName = '" & GetUserName() & "';"
CurrentDb.Execute "UPDATE tblUsers SET PWD = RC4(strPassword,'RC4_Key'), PWDDate = Date()" & _
" WHERE UserName = '" & GetUserName() & "';"
FormattedMsgBox "Your password has been updated" & _
"@Click Login to continue @", vbInformation + vbOKOnly, "Password Updated"
'Create a login event for this user
DoLogin
End If
End If
Exit_Handler:
Exit Sub
Err_Handler:
MsgBox "Error " & Err.Number & " in cmdLogin_Click procedure: " & Err.Description
Resume Exit_Handler
End Sub