Password validation (1 Viewer)

aman

Registered User.
Local time
Today, 08:18
Joined
Oct 16, 2008
Messages
1,250
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

Registered User.
Local time
Today, 16:18
Joined
Nov 2, 2015
Messages
823
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
 

Frothingslosh

Premier Pale Stale Ale
Local time
Today, 11:18
Joined
Oct 17, 2012
Messages
3,276
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

..forever waiting... waiting for jellybean!
Local time
Today, 23:18
Joined
May 7, 2009
Messages
19,231
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

Registered User.
Local time
Today, 08:18
Joined
Oct 16, 2008
Messages
1,250
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

Premier Pale Stale Ale
Local time
Today, 11:18
Joined
Oct 17, 2012
Messages
3,276
Check out the function I linked in my post. It has all that covered.
 

arnelgp

..forever waiting... waiting for jellybean!
Local time
Today, 23:18
Joined
May 7, 2009
Messages
19,231
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

Premier Pale Stale Ale
Local time
Today, 11:18
Joined
Oct 17, 2012
Messages
3,276
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

..forever waiting... waiting for jellybean!
Local time
Today, 23:18
Joined
May 7, 2009
Messages
19,231
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

Premier Pale Stale Ale
Local time
Today, 11:18
Joined
Oct 17, 2012
Messages
3,276
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

..forever waiting... waiting for jellybean!
Local time
Today, 23:18
Joined
May 7, 2009
Messages
19,231
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

Registered User.
Local time
Today, 08:18
Joined
Oct 16, 2008
Messages
1,250
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

AWF VIP
Local time
Today, 16:18
Joined
Jul 26, 2013
Messages
10,366
Did you try Galaxiom's code? It definitely does everything you need it to do.
 

Galaxiom

Super Moderator
Staff member
Local time
Tomorrow, 01:18
Joined
Jan 20, 2009
Messages
12,851
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

Registered User.
Local time
Today, 08:18
Joined
Oct 16, 2008
Messages
1,250
that's great , it worked for me. :)
 

Users who are viewing this thread

Top Bottom