Private Sub txtUsername_AfterUpdate()
'CHECK IF THE USERNAME EXISTS IN DATABASE AND ALSO IF THE USER IS ALREADY LOGGED IN ELSEWHERE.
'On Error GoTo Err_Handler:
'Format and Reset controls.
Me.lblOld.Caption = "PASSWORD"
Me.txtOldPWD = ""
Me.txtUsername = UCase(Me.txtUsername)
'1. TEST IF THE USERNAME EXISTS
'Pass the username to the string
Dim strCriteria As String
strCriteria = "UserName='" & Me.txtUsername & "' And LogoutEvent Is Null"
strUser = "Username='" & Me.txtUsername & "'"
'TEST IF THE USER EXISTS
Select Case Not DCount("*", "qryUserLogging", strUser) > 0
Case True
FormattedMsgBox "Username " & Me.txtUsername & " is not saved." & " " & _
"@Please review the information and try again. @", vbCritical, "USER NOT FOUND"
Case False
'2. CHECK IF USER LOGGED ELSEWHERE
'Search for the user on the table sessions.
If DCount("*", "tblLoginSessions", strCriteria) > 0 Then
'User is found, return the computer name he is logged.
If DLookup("ComputerName", "tblLoginSessions", strUser) <> GetComputerName Then
'Tell all about it to the user.
FormattedMsgBox "User " & Me.txtUsername & " is already logged in at workstation " & DLookup("ComputerName", "tblLoginSessions", strCriteria) & " " & _
"@User " & Me.txtUsername & " MUST logout from that computer before logging in again @", vbCritical, "Already logged in"
'disable the Login button
Me.cmdLogin.Enabled = False
'Empty the txtUsername
Me.txtUsername = ""
Exit Sub
Else
' If the user is not logged then end previous session for this user on current computer so a new session can be started
CurrentDb.Execute "UPDATE tblLoginSessions SET LogoutEvent = Now()" & _
" WHERE UserName=GetUserName() AND LogoutEvent Is Null AND ComputerName=GetComputerName();"
End If
End If
'3.GET USER INFO
If Trim(Me.txtUsername & "") <> "" Then
strUsername = Me.txtUsername
strComputerName = GetComputerName()
strPassword = RC4(DLookup("PWor", "qryUserLogging", strUser), "RC4_Key")
blnChangeOwnPassword = DLookup("ChangePWD", "qryUserLogging", strUser)
intPasswordExpireDays = DLookup("ExpireDays", "qryUserLogging", strUser)
intAccessLevel = DLookup("AccessLevel", "qryUserLogging", strUser)
lngPasswordDate = DLookup("PWDDate", "qryUserLogging", strUser)
End If
'4. CHECK IF THE USER HAS A CURRENT PASSWORD
If RC4(DLookup("PWor", "qryUserLogging", strUser), "RC4_Key") = "Not Set" Then
bFlag = False
FormattedMsgBox "You have not set a login password yet. " & _
"@You must setup a password before you can access the application. @", vbExclamation + vbOKOnly, "Setup Login Password"
Me.txtOldPWD.Visible = False
Me.txtNewPWD.Visible = True
Me.txtConPWD.Visible = True
Me.txtNewPWD.SetFocus
Me.lblNew.Caption = "NEW PASSWORD"
Me.lblCon.Caption = "CONFIRM PASSWORD"
Exit Sub
Else
bFlag = True
Me.txtOldPWD.Visible = True
Me.txtNewPWD.Visible = False
Me.txtConPWD.Visible = False
End If
'5. IF THE USER HAS A PASSWORD AND HE CAN CHANGE HIS OWN PASSWORD ONCE IT IS DUE TO EXPIRE.
'Calculate the expiration date of the password.
If bFlag = True And intPasswordExpireDays > 0 And blnChangeOwnPassword = True Then
Dim DaysLeft As Integer, DateExpire As Date
DateExpire = DateAdd("d", intPasswordExpireDays, lngPasswordDate)
DaysLeft = DateDiff("d", Date, DateExpire)
'Which option to choose
Select Case DaysLeft
' Mandatory change
Case Is < 0
FormattedMsgBox "Your password has expired and must be changed now. " & _
"@First enter your OLD password @", vbExclamation + vbOKOnly, "PASSWORD EXPIRED"
Me.txtOldPWD.Visible = True
Me.lblOld.Caption = "OLD PASSWORD"
Me.lblNew.Caption = "NEW PASSWORD"
Me.lblCon.Caption = "CONFIRM PASSWORD"
bReset = True
'Optional change
Case Is < 8
If FormattedMsgBox("Your password expires in " & DaysLeft & " day(s). " & _
"@Do you want to change it now? @", vbQuestion + vbYesNo, "PASSWORD ABOUT TO EXPIRE") = vbYes Then
'Change the controls on the form:
Me.txtOldPWD.Visible = True
Me.txtNewPWD.Visible = True
Me.txtConPWD.Visible = True
Me.lblOld.Caption = "OLD PASSWORD"
Me.lblNew.Caption = "NEW PASSWORD"
Me.lblCon.Caption = "CONFIRM PASSWORD"
bReset = True
End If
' Not applicable for change
Case Else
Me.lblOld.Caption = "PASSWORD"
bReset = False
End Select ' Finish Which option to choose
End If ' Finish calculation of the expiration date of the password.
End Select ' Finish testing if the user exists
'6. CHECK WHICH CONTROL TO GO
If bFlag = False Then
If Me.txtNewPWD.Visible = True Then
Me.txtNewPWD.SetFocus
End If
Else
If Me.txtOldPWD.Visible = True Then
Me.txtOldPWD.SetFocus
End If
End If
Exit_Handler:
Exit Sub
'----------------------------- ERROR HANDLER --------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
Err_Handler:
MsgBox "An error occurred, please contact the administrator and inform the details below:" & vbCrLf & vbCrLf & _
"Originated on form: " & Me.Name & ", procedure " & Application.VBE.ActiveCodePane.CodeModule.ProcOfLine(Application.VBE.ActiveCodePane.TopLine, 0) & ", error Line: " & Erl & vbCrLf & _
vbCrLf & "Error Description: " & Err.Number & " - " & Err.Description, vbExclamation, "APPLICATION ERROR"
Resume Exit_Handler
End Sub