Password validation

aman · Aug 15, 2017

Hi Guys

I have a developed a password form so that everybody has to have a password in order to use the system. At the moment I have just put the validation that the password will only be greater than or equal to 8 characters. how can I add other validation like first capital letter,1 numeric and special character etc??

Code:

Private Sub txtPass_Exit(Cancel As Integer)
If Len(txtPass) < 8 Or IsNull(Me.txtPass) Then
Me.lblCross.Visible = True
Me.lblCross.Caption = "Passkey must be greater than or equal to 8 characters in length"
Me.txtPass.BorderColor = vbRed
Cancel = True

Any help will be much appreciated.

Thanks

static · Aug 15, 2017

Using Like on string allows wildcards

Code:

Private Function PWOk(pw As String) As Boolean
On Error Resume Next
    If Len(pw) < 8 Then Err.Raise vbObjectError, , "not long enough"
    If Not pw Like "[A-Z]*" Then Err.Raise vbObjectError, , "first char must be upper"
    If Not pw Like "*#*" Then Err.Raise vbObjectError, , "must contain number"
    If Not pw Like "*[!A-Z][!#]*" Then Err.Raise vbObjectError, , "must contain non alphanumeric"
    
    Select Case Err.Number
    Case 0: PWOk = True
    Case Else: MsgBox Err.Description
    End Select
End Function

Code:

Sub ie()
    If PWOk("S0ggyBiscuit-1982") Then MsgBox "Password is OK"
End Sub

Anakardian · Aug 15, 2017

You might want to consider this article before making everything complicated:
https://www.gizmodo.com.au/2017/08/...password-rules-now-regrets-wasting-your-time/

Frothingslosh · Aug 15, 2017

You may be interested in post #6 from this thread, too:

https://access-programmers.co.uk/forums/showthread.php?t=210795

It includes a nice password validation routine that checks for upper case, lower case, numbers, special characters, and password length. You can, if you'd like, add a check for the first letter not being capitalized if that's really one of your requirements.

arnelgp · Aug 15, 2017

here is a sample password validator.

Code:

Private Sub txtPass_Exit(Cancel As Integer)
    If Trim(Me.txtPass & "") = "" Then
        Me.Undo
        MsgBox "PASSWORD REQUIRED?"
        Cancel = True
    Else
        If Len(Me.txtPass) < 8 Then
            MsgBox "Minimum length of password must be 8 characters."
            Cancel = True
        Else
            If IsUpper(Me.txtPass) = False Then
                MsgBox "Password must start with Capital letter."
                Cancel = True
            Else
                If OneDigitOnly(Right(Me.txtPass, Len(Me.txtPass) - 1)) = False Then
                    MsgBox "Only 1 numeric allowed and with no special characters"
                    Cancel = True
                End If
            End If
        End If
    End If
End Sub

Private Function IsUpper(strString As String) As Boolean
    IsUpper = (InStr(1, "QWERTYUIOPASDFGHJKLZXCVBNM", Left(strString, 1), vbBinaryCompare) <> 0)
End Function

Private Function OneDigitOnly(strString As String) As Boolean
    Dim bolBad As Boolean
    Dim intCounter As Integer
    Dim i As Integer
    Const strValidator As String = "0123456789"
    Const strSpecialChar As String = ",.<>/?;:'[{]}\|`~!@#$%^&*()-_=+" & """"
    For i = 1 To Len(strString)
        If InStr(1, strValidator, Mid(strString, i, 1)) <> 0 Then intCounter = intCounter + 1
        If Not bolBad Then
            bolBad = InStr(1, strSpecialChar, Mid(strString, i, 1)) <> 0
        End If
    Next
    OneDigitOnly = (intCounter = 1) And (bolBad = False)
End Function

aman · Aug 15, 2017

thanks guys, Actually I want the following validations:

1. Minimum 8 characters length.
2. At least one capital letter anywhere in the password (not only the first letter)
3. ANy number of numeric characters.
4. Special characters should be allowed as well.

Any help will be much appreciated . Thanks

Frothingslosh · Aug 15, 2017

Check out the function I linked in my post. It has all that covered.

arnelgp · Aug 15, 2017

revised my previous attempt.

Code:

Private Sub txtPass_Exit(Cancel As Integer)
    If Trim(Me.txtPass & "") = "" Then
        Me.Undo
        MsgBox "PASSWORD REQUIRED?"
        Cancel = True
    Else
        If Len(Me.txtPass) < 8 Then
            MsgBox "Minimum length of password must be 8 characters."
            Cancel = True
        Else
            If IsOneUpperOnly(Me.txtPass) = False Then
                MsgBox "Password must have at most one (1) Capital letter."
                Cancel = True
            End If
        End If
    End If
End Sub

Private Function IsOneUpperOnly(strString As String) As Boolean
    Dim intLength As Integer
    Dim i As Integer
    Dim nPos As Integer
    intLength = Len(strString)
    nPos = InStr(1, "QWERTYUIOPASDFGHJKLZXCVBNM", Left(strString, 1), vbBinaryCompare)
    While nPos <> 0
        i = i + 1
        nPos = InStr(nPos + 1, "QWERTYUIOPASDFGHJKLZXCVBNM", Left(strString, 1), vbBinaryCompare)
    Wend
    IsOneUpperOnly = (i = 1)
End Function

Frothingslosh · Aug 15, 2017

You do realize, right, that Galaxiom's code that I linked does all that faster and more elegantly? And unlike yours (and unlike my first attempt way back when), reports all issues encountered in a single pass?

arnelgp · Aug 15, 2017

only trying to be helpful.
and i am offering it to the OP not to You.
we have different approach on solving the same problem.

Frothingslosh · Aug 15, 2017

And I was simply trying to help keep you from reinventing the wheel while trying to help the OP.

My own initial contribution to a similar thread two years back was pretty much what you did, but I suggest Galaxiom's version now because it's so much better than aborting after the first error message each time.

arnelgp · Aug 15, 2017

i don't think there is reinvention here.
my code has different approach.
if you feel that Mr.Galaxiom's solution is better then so be it.
that's your opinion.
but i have no time to peek at it.

if there is reinvention of solution, then there must also be
a reinvention of post.
since everyday this site is receiving same request from
different people.

aman · Aug 30, 2017

Hi Guys, I am back again . The following code doesn't check the upper case letters in the password:

Code:

Private Sub txtPass_Exit(Cancel As Integer)
Dim InputLen As Integer
Dim Char As Integer
Dim i As Integer
Dim AlphaCount As Integer
Dim SpecialCount As Integer
Dim NumCount As Integer
 
InputLen = Len(Me.txtPass)
 
If InputLen >= 8 Then
 
      For i = 1 To InputLen
          Char = Asc(Mid(Me.txtPass, i, 1))
 
          If (Char > 64 And Char < 91) Or (Char > 96 And Char < 123) Then
              AlphaCount = AlphaCount + 1
          ElseIf (Char > 46 And Char < 58) Then
              NumCount = NumCount + 1
          Else
              SpecialCount = SpecialCount + 1
          End If
 
          If NumCount > 0 And AlphaCount > 0 And SpecialCount > 0 Then
              Me.ImgTick.Visible = True
              Me.ImgTick.Top = Me.ImgTick.Top - 200
              Me.ImgCross.Visible = False
              Me.lblCross.Visible = False
              Me.txtPass.BorderColor = vbBlack
              Me.txtConfirmPass.SetFocus
              Exit For
           Else
              Me.ImgTick.Visible = False
              Me.ImgCross.Visible = True
              Me.ImgCross.Top = Me.ImgTick.Top - 200
              Me.lblCross.Visible = True
              Me.lblCross.Top = Me.ImgTick.Top - 200
              Me.lblCross.Caption = "At least 8 characters, 1 capital letter, 1 number and 1 special character"
              Me.txtPass.BorderColor = vbRed
              Cancel = True
           End If
 
      Next
    
Else
        Me.ImgTick.Visible = False
        Me.ImgCross.Visible = True
        Me.ImgCross.Top = Me.ImgTick.Top - 200
        Me.lblCross.Visible = True
        Me.lblCross.Top = Me.ImgTick.Top - 200
        Me.lblCross.Caption = "At least 8 characters, 1 capital letter, 1 number and 1 special character" 
        Me.txtPass.BorderColor = vbRed
        Cancel = True
End If
 
 
End Sub

Minty · Aug 30, 2017

Did you try Galaxiom's code? It definitely does everything you need it to do.

Galaxiom · Aug 30, 2017

I really would encourage you to look at the function I wrote at Frothy's link. It is quite slick in the way it uses dynamic settings in the call.

Definitely also worth a look for anyone interested in writing functions with additive enumerated parameters.

aman · Sep 1, 2017

that's great , it worked for me.

Password validation

aman

Registered User.

static

Registered User.

Anakardian

Registered User.

Frothingslosh

Premier Pale Stale Ale

arnelgp

..forever waiting... waiting for jellybean!

aman

Registered User.

Frothingslosh

Premier Pale Stale Ale

arnelgp

..forever waiting... waiting for jellybean!

Frothingslosh

Premier Pale Stale Ale

arnelgp

..forever waiting... waiting for jellybean!

Frothingslosh

Premier Pale Stale Ale

arnelgp

..forever waiting... waiting for jellybean!

aman

Registered User.

Minty

AWF VIP

Galaxiom

Super Moderator

aman

Registered User.

Similar threads

Users who are viewing this thread