Password Must Contain Upper and Lowercase letter

WorkHardPlayHard · Aug 2, 2013

I am using vba to create a login/password system, but I want to make sure they use a good password, i.e. checking for upper and lower case when they enter their new password into the field. (This is all done in a form)

way2bord · Aug 2, 2013

WorkHardPlayHard said:
I am using vba to create a login/password system, but I want to make sure they use a good password, i.e. checking for upper and lower case when they enter their new password into the field. (This is all done in a form)

Try adding the following option to the top of your password module.
Option Compare Binary

edit: this will replace Option Compare Database.

nanscombe · Aug 2, 2013

The following code would give you the length of the password and a count of the number of lower-case characters, upper-case characters, numeric and other characters.

You could add some code based on the number and type of characters that had been entered.

Code:

Public Function passwordFingerprint(ByVal strPassword As String)
Dim intChar As Integer, strTemp As String
Dim intUpper As Integer, intLower As Integer, intNumber As Integer, intOther As Integer

  For intChar = 1 To Len(strPassword)
    strTemp = Mid(strPassword, intChar, 1)
    
    Select Case Asc(strTemp)
    Case Asc("A") To Asc("Z") ' UPPER - CASE CHARACTERS
      intUpper = intUpper + 1
    Case Asc("a") To Asc("z") ' lower - case characters
      intLower = intLower + 1
    Case Asc("0") To Asc("9") ' Numeric characters
      intNumber = intNumber + 1
    Case Else ' Any other character
      intOther = intOther + 1
    End Select

  Next intChar

  strTemp = ""
  strTemp = strTemp & "Ln" & Format(Len(strPassword), "00") ' Length of password
  strTemp = strTemp & "-Uc" & Format(intUpper, "00")  ' Number of upper-case characters
  strTemp = strTemp & "-Lc" & Format(intLower, "00")  ' Number of lower-case characters
  strTemp = strTemp & "-Nc" & Format(intNumber, "00")  ' Number of numeric characters
  strTemp = strTemp & "-Oc" & Format(intOther, "00")  ' Number of "other" characters
  
' Add any other code here ============================

' ====================================================
  
  passwordFingerprint = strTemp
End Function

It also produces a string output based on the password, eg Access-001 produces the string
Ln10-Uc01-Lc05-Nc03-Oc01

Ln10 - Length 10 characters
Uc01 - 1 upper case character
Lc05 - 5 lower case characters
Nc03 - 3 numeric characters
Oc01 - 1 other, ie none of the above, character

Some other examples:

Code:

access-001    Ln10-[COLOR="Red"]Uc00[/COLOR]-Lc06-Nc03-Oc01 (Uc00 - no upper case characters)
ACCESS-001    Ln10-Uc06-[COLOR="red"]Lc00[/COLOR]-Nc03-Oc01 (Lc00 - no lower case characters)
Access-       Ln07-Uc01-Lc05-[COLOR="red"]Nc00[/COLOR]-Oc01 (Nc00 - no numeric characters)

Mihail · Aug 2, 2013

Code:

If (UCase(Password) = Password) Or (LCase(Password) = Password) Then
        MsgBox "Incorrect password"
End If

nanscombe · Aug 2, 2013

I just can't resist writing a bit of code.

emad258 · Aug 31, 2016

hi
after deep thinking, I finally write the following code to request the user to enter password with upper and lower case letter plus one number at least

here is the code:
record goes to me

the following code should be pasted in txtbox after update case

Code:

Private Sub Password_AfterUpdate()
' written by EMAD

    If IsNull(Me.Password) Then
        Me.Password.Value = "password"
        MsgBox "password must contain at least 8 characters, password will be reset to password", vbOKOnly
    Exit Sub
    End If
On Error GoTo error





    If Len(Me.Password) < 8 Then
        Me.Password.Value = "password"
        MsgBox "password must contain at least 8 characters, password will be reset to password", vbOKOnly
    Exit Sub
    End If

Dim N0, N1, N2, N3, N4, N5, N6, N7, N8, N9 As String
N0 = InStr(Me.Password, "0")
N1 = InStr(Me.Password, "1")
N2 = InStr(Me.Password, "2")
N3 = InStr(Me.Password, "3")
N4 = InStr(Me.Password, "4")
N5 = InStr(Me.Password, "5")
N6 = InStr(Me.Password, "6")
N7 = InStr(Me.Password, "7")
N8 = InStr(Me.Password, "8")
N9 = InStr(Me.Password, "9")

If (N0 + N1 + N2 + N3 + N4 + N5 + N6 + N7 + N8 + N9) = 0 Then
        Me.Password.Value = "password"
        MsgBox "password must contain at least one numeric value, password will be reset to password", vbOKOnly
    Exit Sub
    End If
    
Dim CA, CB, CC, CD, CE, CF, CG, CH, CI, CJ, CK, CL, CM, CN, CO, CP, CQ, CR, CS, CT, CU, CV, CW, CX, CY, CZ As String

    CA = InStr(Me.Password, "A")
    CB = InStr(Me.Password, "B")
    CC = InStr(Me.Password, "C")
    CD = InStr(Me.Password, "D")
    CE = InStr(Me.Password, "E")
    CF = InStr(Me.Password, "F")
    CG = InStr(Me.Password, "G")
    CH = InStr(Me.Password, "H")
    CI = InStr(Me.Password, "I")
    CJ = InStr(Me.Password, "J")
    CK = InStr(Me.Password, "K")
    CL = InStr(Me.Password, "L")
    CM = InStr(Me.Password, "M")
    CN = InStr(Me.Password, "N")
    CO = InStr(Me.Password, "O")
    CP = InStr(Me.Password, "P")
    CQ = InStr(Me.Password, "Q")
    CR = InStr(Me.Password, "R")
    CS = InStr(Me.Password, "S")
    CT = InStr(Me.Password, "T")
    CU = InStr(Me.Password, "U")
    CV = InStr(Me.Password, "V")
    CW = InStr(Me.Password, "W")
    CX = InStr(Me.Password, "X")
    CY = InStr(Me.Password, "Y")
    CZ = InStr(Me.Password, "Z")

If (CA + CB + CC + CD + CE + CF + CG + CH + CI + CJ + CK + CL + CM + CN + CO + CP + CQ + CR + CS + CT + CU + CV + CW + CX + CY + CZ) = 0 Then
    Me.Password.Value = "password"
    MsgBox "Password must contain at least one upper letter,password reset to password", vbOKOnly
    Exit Sub
End If


Dim Sa, Sb, Sc, Sd, Se, Sf, Sg, Sh, Si, Sj, Sk, Sl, Sm, Sn, So, Sp, Sq, Sr, Ss, St, Su, Sv, Sw, Sx, Sy, Sz As String

    Sa = InStr(Me.Password, "a")
    Sb = InStr(Me.Password, "b")
    Sc = InStr(Me.Password, "c")
    Sd = InStr(Me.Password, "d")
    Se = InStr(Me.Password, "e")
    Sf = InStr(Me.Password, "f")
    Sg = InStr(Me.Password, "g")
    Sh = InStr(Me.Password, "h")
    Si = InStr(Me.Password, "i")
    Sj = InStr(Me.Password, "j")
    Sk = InStr(Me.Password, "k")
    Sl = InStr(Me.Password, "l")
    Sm = InStr(Me.Password, "m")
    Sn = InStr(Me.Password, "n")
    So = InStr(Me.Password, "o")
    Sp = InStr(Me.Password, "p")
    Sq = InStr(Me.Password, "q")
    Sr = InStr(Me.Password, "r")
    Ss = InStr(Me.Password, "s")
    St = InStr(Me.Password, "t")
    Su = InStr(Me.Password, "u")
    Sv = InStr(Me.Password, "v")
    Sw = InStr(Me.Password, "w")
    Sx = InStr(Me.Password, "x")
    Sy = InStr(Me.Password, "y")
    Sz = InStr(Me.Password, "z")

If (Sa + Sb + Sc + Sd + Se + Sf + Sg + Sh + Si + Sj + Sk + Sl + Sm + Sn + So + Sp + Sq + Sr + Ss + St + Su + Sv + Sw + Sx + Sy + Sz) = 0 Then
    Me.Password.Value = "password"
    MsgBox "Password must contain at least one lower letter,password reset to password", vbOKOnly
    Exit Sub
End If
error:



End Sub

pbaldy · Aug 31, 2016

You must not have tested that...code.

?InStr("ABC", "a")
1
?InStr("abc", "A")
1

No record for you! (Seinfeld take-off)

plog · Aug 31, 2016

Nor did he check dates on threads.

This is like the 3rd 3 year old post he revived with the exact same post:

http://www.access-programmers.co.uk/forums/showthread.php?t=241377

http://www.access-programmers.co.uk/forums/showthread.php?t=268643&page=2

Super confusing. It's like he's trying to run up a post count, but at the same time he's legitamitely posting germane content to the thread, but even still its not that great of code. Super weird, not reporting him, but keeping my eye on him.

emad258 · Aug 31, 2016

plog said:
Nor did he check dates on threads.

This is like the 3rd 3 year old post he revived with the exact same post:

Super confusing. It's like he's trying to run up a post count, but at the same time he's legitamitely posting germane content to the thread, but even still its not that great of code. Super weird, not reporting him, but keeping my eye on him.

why you keep your eye on me

here my story
I am search for a while to find a solution to this issue and didn't find any solution
I just find some uncompleted and not working code
so after I build the code I spread it through any article that I opened to help other people
I hope to use your knowledge next time to help other people rather than keep your eyes on people :banghead:
no other intention from my act, this my first and last post to this forum
thanks deer

emad258 · Aug 31, 2016

pbaldy said:
You must not have tested that...code.

?InStr("ABC", "a")
1
?InStr("abc", "A")
1

No record for you! (Seinfeld take-off)

you come tooo late

thnxx for the updated

Frothingslosh · Aug 31, 2016

Oy, that is a very...brute force, limited approach.

Much better would be Galaxiom's code HERE. Note that it was written in 2011 and thus, by emad258's own words, means emad258 came too late.

Code:

'---------------------------------------------------------------------------------------
' Module    : PasswordAnalysis
' Author    : Galaxiom
' Date      : 7/06/2011
' Updated   : 10/12/2014 to correct argument declaration to ByVal
' Purpose   : Testing complexity of string such as passwords
'---------------------------------------------------------------------------------------
Option Compare Database
Option Explicit
 
Enum pwRequired
    pwNum = 1      ' Require at least one numeric character
    pwAlpha = 2    ' Require at least one Alpha character
    pwMixCase = 4  ' Require at least one of each both upper and low case characters
    pwSpecial = 8  ' Require at least one special character
End Enum
 
'---------------------------------------------------------------------------------------
' Procedure : RequiredCharacters
' Author    : Galaxiom
' Date      : 7/06/2011
' Purpose   : Test a string for:
'             Minimum number of characters
'             Presence of at least one of each of the designated character groups
' Usage     : Enter the minimum number of characters as the MinLength Argument
'             Add together each type of pwRequired type to the ReqChars argument
'             (pwAlpha is not required with pwMixCase)
'             Optionally set UseDialog to True to pop up a message about missing requirements
' Example   : RequiredCharacters(YourString, 4, pwNum + pwMixCase + pwSpecial, True)
'---------------------------------------------------------------------------------------
'
Public Function RequiredCharacters(ByVal TestString As String, ByVal MinLength As Integer, ByVal ReqChars As pwRequired, _
                            Optional ByVal UseDialog As Boolean = False) As Integer
 
' RETURN CODES:
' Characters Accepted = 0
 
' SUMMED RETURN CODES:
' Numeral required = 1
' Alpha or Lowercase character required = 2
' UpperCase character required = 4
' Special character required = 8
' Insufficient Characters = 16
 
Dim StringLen As Integer
Dim Char As Integer '.... ASCII value of character
Dim i As Integer
 
' Load pwAlpha if pwMixCase                (effect: require lowercase)
' Otherwise render TestString to lowercase (effect: detect uppercase as lower)
    If ReqChars <> (ReqChars And Not pwMixCase) Then
        ReqChars = ReqChars Or pwAlpha
    Else
        TestString = LCase(TestString)
    End If
 
' Include all active pwRequired values and length code in function return
    RequiredCharacters = ReqChars Or 16
 
    StringLen = Len(TestString)
 
' Remove each found RequiredCode from function return
 
    If Not StringLen < MinLength Then: RequiredCharacters = RequiredCharacters And Not 16
 
    For i = 1 To StringLen
        Char = Asc(Mid(TestString, i, 1))
 
        If (Char > 46 And Char < 58) Then                              ' Numeric
            RequiredCharacters = RequiredCharacters And Not pwNum
        ElseIf (Char > 96 And Char < 123) Then                         ' LowerCase
            RequiredCharacters = RequiredCharacters And Not pwAlpha
        ElseIf (Char > 64 And Char < 91) Then                          ' UpperCase
            RequiredCharacters = RequiredCharacters And Not pwMixCase
        Else                                                           ' Special
            RequiredCharacters = RequiredCharacters And Not pwSpecial
        End If
    Next
 
    If UseDialog And RequiredCharacters Then: RequiredCharsDialog (RequiredCharacters)
 
End Function
 
=======================================
Public Function RequiredCharsDialog(RequiredCode As Integer)
 
' Note: When using pwAlpha the "missing requirement" will be "At least one lowercase character"
'       even though an uppercase character would be accepted.
 
Dim NotPresent As String
 
    If RequiredCode <> 0 Then
        NotPresent = "The string still requires:" & vbCrLf & vbCrLf
        If (RequiredCode And Not 15) = 16 Then: NotPresent = NotPresent & "Additional characters" & vbCrLf
        If (RequiredCode And Not 23) = 8 Then: NotPresent = NotPresent & "At least one special character" & vbCrLf
        If (RequiredCode And Not 27) = 4 Then: NotPresent = NotPresent & "At least one uppercase Character" & vbCrLf
        If (RequiredCode And Not 29) = 2 Then: NotPresent = NotPresent & "At least one lowercase Character" & vbCrLf
        If (RequiredCode And Not 30) = 1 Then: NotPresent = NotPresent & "At least one numeric character" & vbCrLf
 
        MsgBox NotPresent
 
    End If
 
End Function
 
================================= 
Private Sub TestRequiredCharacters()
    If RequiredCharacters("1aA!", 4, pwNum + pwMixCase + pwSpecial, True) = False Then
        MsgBox "Accepted"
    End If
 
End Sub
 
' =============   Notes   =================
' The functions make extensive use of the Bitwise Operators.
' Each pwRequired value uses a single bit to indicate its inclusion in ReqChar.
' (Hence the binary pattern in their decimal values)
' The bitwise operators allow the bits to be operated on independently.
' This makes them useful where multiple independent values are held as a single number.
 
' X Or Y adds the bits without "carrying" as in arithmetic addition.
 
' X And Not Y subtracts the bits in the second operand from the first.
' Effectively this is subtraction without "borrowing".
' ==========================================

emad258 · Aug 31, 2016

Frothingslosh said:

Oy, that is a very...brute force, limited approach.

Much better would be Galaxiom's code . Note that it was written in 2011 and thus, by emad258's own words, means emad258 came too late.

Code:

'---------------------------------------------------------------------------------------
' Module    : PasswordAnalysis
' Author    : Galaxiom
' Date      : 7/06/2011
' Updated   : 10/12/2014 to correct argument declaration to ByVal
' Purpose   : Testing complexity of string such as passwords
'---------------------------------------------------------------------------------------
Option Compare Database
Option Explicit
 
Enum pwRequired
    pwNum = 1      ' Require at least one numeric character
    pwAlpha = 2    ' Require at least one Alpha character
    pwMixCase = 4  ' Require at least one of each both upper and low case characters
    pwSpecial = 8  ' Require at least one special character
End Enum
 
'---------------------------------------------------------------------------------------
' Procedure : RequiredCharacters
' Author    : Galaxiom
' Date      : 7/06/2011
' Purpose   : Test a string for:
'             Minimum number of characters
'             Presence of at least one of each of the designated character groups
' Usage     : Enter the minimum number of characters as the MinLength Argument
'             Add together each type of pwRequired type to the ReqChars argument
'             (pwAlpha is not required with pwMixCase)
'             Optionally set UseDialog to True to pop up a message about missing requirements
' Example   : RequiredCharacters(YourString, 4, pwNum + pwMixCase + pwSpecial, True)
'---------------------------------------------------------------------------------------
'
Public Function RequiredCharacters(ByVal TestString As String, ByVal MinLength As Integer, ByVal ReqChars As pwRequired, _
                            Optional ByVal UseDialog As Boolean = False) As Integer
 
' RETURN CODES:
' Characters Accepted = 0
 
' SUMMED RETURN CODES:
' Numeral required = 1
' Alpha or Lowercase character required = 2
' UpperCase character required = 4
' Special character required = 8
' Insufficient Characters = 16
 
Dim StringLen As Integer
Dim Char As Integer '.... ASCII value of character
Dim i As Integer
 
' Load pwAlpha if pwMixCase                (effect: require lowercase)
' Otherwise render TestString to lowercase (effect: detect uppercase as lower)
    If ReqChars <> (ReqChars And Not pwMixCase) Then
        ReqChars = ReqChars Or pwAlpha
    Else
        TestString = LCase(TestString)
    End If
 
' Include all active pwRequired values and length code in function return
    RequiredCharacters = ReqChars Or 16
 
    StringLen = Len(TestString)
 
' Remove each found RequiredCode from function return
 
    If Not StringLen < MinLength Then: RequiredCharacters = RequiredCharacters And Not 16
 
    For i = 1 To StringLen
        Char = Asc(Mid(TestString, i, 1))
 
        If (Char > 46 And Char < 58) Then                              ' Numeric
            RequiredCharacters = RequiredCharacters And Not pwNum
        ElseIf (Char > 96 And Char < 123) Then                         ' LowerCase
            RequiredCharacters = RequiredCharacters And Not pwAlpha
        ElseIf (Char > 64 And Char < 91) Then                          ' UpperCase
            RequiredCharacters = RequiredCharacters And Not pwMixCase
        Else                                                           ' Special
            RequiredCharacters = RequiredCharacters And Not pwSpecial
        End If
    Next
 
    If UseDialog And RequiredCharacters Then: RequiredCharsDialog (RequiredCharacters)
 
End Function
 
=======================================
Public Function RequiredCharsDialog(RequiredCode As Integer)
 
' Note: When using pwAlpha the "missing requirement" will be "At least one lowercase character"
'       even though an uppercase character would be accepted.
 
Dim NotPresent As String
 
    If RequiredCode <> 0 Then
        NotPresent = "The string still requires:" & vbCrLf & vbCrLf
        If (RequiredCode And Not 15) = 16 Then: NotPresent = NotPresent & "Additional characters" & vbCrLf
        If (RequiredCode And Not 23) = 8 Then: NotPresent = NotPresent & "At least one special character" & vbCrLf
        If (RequiredCode And Not 27) = 4 Then: NotPresent = NotPresent & "At least one uppercase Character" & vbCrLf
        If (RequiredCode And Not 29) = 2 Then: NotPresent = NotPresent & "At least one lowercase Character" & vbCrLf
        If (RequiredCode And Not 30) = 1 Then: NotPresent = NotPresent & "At least one numeric character" & vbCrLf
 
        MsgBox NotPresent
 
    End If
 
End Function
 
================================= 
Private Sub TestRequiredCharacters()
    If RequiredCharacters("1aA!", 4, pwNum + pwMixCase + pwSpecial, True) = False Then
        MsgBox "Accepted"
    End If
 
End Sub
 
' =============   Notes   =================
' The functions make extensive use of the Bitwise Operators.
' Each pwRequired value uses a single bit to indicate its inclusion in ReqChar.
' (Hence the binary pattern in their decimal values)
' The bitwise operators allow the bits to be operated on independently.
' This makes them useful where multiple independent values are held as a single number.
 
' X Or Y adds the bits without "carrying" as in arithmetic addition.
 
' X And Not Y subtracts the bits in the second operand from the first.
' Effectively this is subtraction without "borrowing".
' ==========================================

it is too different, I don't know how to use public function

Password Must Contain Upper and Lowercase letter

WorkHardPlayHard

New member

way2bord

Registered User.

nanscombe

Registered User.

Mihail

Registered User.

nanscombe

Registered User.

emad258

New member

pbaldy

Wino Moderator

plog

Banishment Pending

emad258

New member

emad258

New member

Frothingslosh

Premier Pale Stale Ale

emad258

New member

Similar threads

Users who are viewing this thread