Password complexity and locking

[nishant.dhruve]

Hi,
I have already created a login form and the code which i m using for it shown below.
i want to add two more steps in here and i need help now.



i want to create a Password complexity and want my program to check whether it match complexity like password should be compose of at least one Upper case letter and it should be 8 Character long with with one digit.
Also i would like the program to check that if user enter wrong password more than 12 times, then it should lock the user until it has been resumed by background user.

Here is the code that i m using

Private Sub cmdlogin_Click()
Dim rs As Recordset
Dim stDocName As String

Set rs = CurrentDb.OpenRecordset("Query1", dbOpenSnapshot, dbReadOnly)
 rs.FindFirst "username = '" & Me.txtusername & "'"
 
 If rs.NoMatch = True Then
  Me.lblwrongusername.Visible = True
  Me.txtusername.SetFocus
  Exit Sub
  
  End If
   Me.lblwrongusername.Visible = False
  
  TempVars("username").Value = Me.txtusername.Value
  
If rs!Password <> (Me.txtpassword) Then
 Me.lblwrongpassword.Visible = True
 Me.txtpassword.SetFocus
 Exit Sub
  End If
  
   Me.lblwrongpassword.Visible = False
   
 If Me.txtpassword = "Password1" Then
 MsgBox "This is the first time using the database or your passowrd has been reset.You must change your password before you can enter the database.", vbOKOnly + vbExclamation
 DoCmd.OpenForm "frmpswdchange"
 
Else


 
    TempVars("username").Value = Me.txtusername.Value
    
    
   
   If rs![Acess type] = 1 Then
  
   DoCmd.OpenForm "frmhomeadmin"
    'DoCmd.close acForm, Me.Name
    Me.Visible = False
    
   
      
     End If
     
     If rs![Acess type] = 2 Then
      DoCmd.OpenForm "frmHomePROD"
      ' DoCmd.close acForm, Me.Name
       Me.Visible = False
End If

 If rs![Acess type] = 3 Then
      DoCmd.OpenForm "frmHomeQA/QC"
      ' DoCmd.close acForm, Me.Name
       Me.Visible = False
End If

 If rs![Acess type] = 4 Then
      DoCmd.OpenForm "frmHomeHR"
      ' DoCmd.close acForm, Me.Name
       Me.Visible = False
End If

If rs![Acess type] = 5 Then
      DoCmd.OpenForm "frmHomePRODadmin"
      ' DoCmd.close acForm, Me.Name
       Me.Visible = False
End If

If rs![Acess type] = 6 Then
      DoCmd.OpenForm "frmHomeQA/QCadmin"
      ' DoCmd.close acForm, Me.Name
       Me.Visible = False
End If

   If rs![Days] = 55 Then
   
    MsgBox (" Your Password will Expire in 5 days"), vbCritical + vbOKOnly, " Warning Password Expiring."
     End If
     
      If rs![Days] = 56 Then
   
    MsgBox (" Your Password will Expire in 4 days"), vbCritical + vbOKOnly, " Warning Password Expiring."
     End If
     
      If rs![Days] = 57 Then
   
    MsgBox (" Your Password will Expire in 3 days"), vbCritical + vbOKOnly, " Warning Password Expiring."
     End If
     
      If rs![Days] = 58 Then
   
    MsgBox (" Your Password will Expire in 2 days"), vbCritical + vbOKOnly, " Warning Password Expiring."
     End If
     
      If rs![Days] = 59 Then
   
    MsgBox (" Your Password will Expire in 1 days"), vbCritical + vbOKOnly, " Warning Password Expiring."
     End If
     
    If rs![Days] >= 60 Then
 
 MsgBox (" your Password has expired.Please Contact Admin"), vbCritical + vbOKOnly, "Password Expired."

DoCmd.Quit
End If
 
 activity.loggin "Logon"
 
 End If
 
   End Sub

[andy49]

something like:

function testpassword (txtpassword as string) as Boolean

dim ok4caps as Boolean
dim ok4integers
testpassword = false
For I = 1 to len (txtpassword)
if mid(txtpassword,i,1) = ucase(mid(txtpassword,i,1)) then ok4caps = true
if isnumeric(mid(txtpassword,i,1)) = true then ok4integers = true
Next I

If ok4caps and ok4integer = true then
testpassword = true
end if

end function

call the function from within the routine you have with the line

if testpassword (txtpassword) = false then do something to say somethings wrong

else: Let them carry on

End if

not tested

[CJ_London]

you need to loop through the text character by character and count each character type - numeric, upper case, lower case, non alpha numeric, characters not to be used (such as single quote)

basic code would be

dim I as integer
dim numcount as integer
dim uppercount as integer
....

for I=1 to len(newpassword)
    select case asc(mid(newpassword,i,1)
        case 48 to 57 'numbers
            numcount=numcount+1
        case 65 to 90 'uppercase
            uppercount=uppercount+1
        case else 'non compliant characters
        ....
        ....
    end select
next I

then code here to analyse the count values to see if there are the number of each type of character

EDIT: link to ascii table http://www.asciitable.com/