Testing password complexity through VBA (1 Viewer)

PaulA

Registered User.
Local time
Today, 14:18
Joined
Jul 17, 2001
Messages
416
Hi, all -

I've been researching how to test password complexity for an A2010 application through VBA and haven't found much.

I would like a new password tested to assure it has at least 8 characters (pretty easy) and contains at least one capital letter and one number (not so easy).

Has anyone found a reasonable way to do this? My coding is not beginner but not that expert, either.

Thanks.
 

pbaldy

Wino Moderator
Staff member
Local time
Today, 07:18
Joined
Aug 30, 2003
Messages
36,118
You can loop the characters of the string, testing the ascii value of each character. That will let you differentiate between upper and lower case, numbers and symbols.
 

Frothingslosh

Premier Pale Stale Ale
Local time
Today, 10:18
Joined
Oct 17, 2012
Messages
3,276
If you get stumped, I have a procedure I threw together a couple years back that does exactly that.
 

jdraw

Super Moderator
Staff member
Local time
Today, 10:18
Joined
Jan 23, 2006
Messages
15,362
Paul,

I found this code on internet and have modified it per your post. (Note: It is set up for exactly 8 characters). I have included a test routine and the results presented. Suggest you check it out before using.
Good luck.

Code:
'---------------------------------------------------------------------------------------
' Procedure : ValidatePwd
' Author    : mellon
' Date      : 29/12/2015
' Purpose   : Routine found on internet, modified to validate a password that
'Contains
'8 characters AND
'at least 1 numeric AND
'at least 1 Uppercase alphabetic AND
'at least 1 lower case alphabetic
'---------------------------------------------------------------------------------------
'
Public Function ValidatePwd(varPassword As Variant) As Boolean
          Dim blnValid As Boolean
          Dim blnValidCriteria As Boolean
          Dim intChar As Integer

10       On Error GoTo ValidatePwd_Error
         'Adjust following line for different length of password******************
         ' blnValid = Len("" & varPassword) >= 8 And Len("" & varPassword) <= 12
20          blnValid = Len("" & varPassword) = 8 And Len("" & varPassword) = 8
30        If blnValid Then
40            blnValidCriteria = False
50            For intChar = 1 To Len("" & varPassword)
60                If InStr(1, "ABCDEFGHIJKLMNOPQRSTUVWXYZ", Mid(varPassword, intChar, 1), vbBinaryCompare) > 0 Then
70                    blnValidCriteria = True
80                    Exit For
90                End If
100           Next
110           blnValid = blnValidCriteria
120       End If
130       If blnValid Then
140           blnValidCriteria = False
150           For intChar = 1 To Len("" & varPassword)
160               If InStr(1, "abcdefghijklmnopqrstuvwxyz", Mid(varPassword, intChar, 1), vbBinaryCompare) > 0 Then
170                   blnValidCriteria = True
180                   Exit For
190               End If
200           Next
210           blnValid = blnValidCriteria
220       End If
230       If blnValid Then
240           blnValidCriteria = False
250           For intChar = 1 To Len("" & varPassword)
260               If InStr(1, "0123456789", Mid(varPassword, intChar, 1), vbBinaryCompare) > 0 Then
270                   blnValidCriteria = True
280                   Exit For
290               End If
300           Next
310           blnValid = blnValidCriteria
320       End If
330       ValidatePwd = blnValid

340      On Error GoTo 0
350      Exit Function

ValidatePwd_Error:

360       MsgBox "Error " & Err.Number & " On Line  " & Erl & " (" & Err.Description & ") in procedure ValidatePwd of Module UtterAccessRelated"
End Function

Test routine
Code:
'---------------------------------------------------------------------------------------
' Procedure : validatepassword
' Author    : mellon
' Date      : 29/12/2015
' Purpose   : check the validatepwd function against some sample passwords
'             and print result to immediate window.
'---------------------------------------------------------------------------------------
'
Sub validatepassword()
    Dim i As Integer
    Dim pwd(6) As Variant

10  On Error GoTo validatepassword_Error

20  pwd(0) = "123456zZ"
30  pwd(1) = "123Abcdef"
40  pwd(2) = " "
50  pwd(3) = Null
60  pwd(4) = "abcdefghi"
70  pwd(5) = "A23456Az"
80  pwd(6) = "Abcdef70"
90  For i = 0 To 6
100     Debug.Print pwd(i) & " is " & IIf(ValidatePwd(pwd(i)) = True, "Valid", "Invalid")
110 Next

120 On Error GoTo 0
130 Exit Sub

validatepassword_Error:

140 MsgBox "Error " & Err.Number & "  on line " & Erl & " (" & Err.Description & ") in procedure validatepassword of Module UtterAccessRelated"
End Sub

Results:
Code:
123456zZ is Valid
123Abcdef is Invalid
  is Invalid
 is Invalid
abcdefghi is Invalid
A23456Az is Valid
Abcdef70 is Valid
 
Last edited:

Frothingslosh

Premier Pale Stale Ale
Local time
Today, 10:18
Joined
Oct 17, 2012
Messages
3,276
Ah, well, I'll just post my version then. Mine allows for any minimum or max length, but those values WILL need to be supplied.

Mine is slightly more flexible than Jdraw's, as it returns a value telling what the issue is.

Code:
Public Function CheckPassword(ByVal PW As String, MinLength As Byte, MaxLength As Byte) As Byte
'0 - Uncaught/unhandled exception
'1 - Password too short
'2 - Password too long
'3 - No numbers
'4 - No capitals
'5 - Invalid character
'6 - No lower case
'255 - Good password

Dim CurChar As String
Dim HasNum As Boolean
Dim HasCaps As Boolean
Dim HasLower As Boolean
Dim x As Long

    If Len(PW) < MinLength Then
        CheckPassword = 1
    Else
        If Len(PW) > MaxLength Then
            CheckPassword = 2
        Else
            For x = 1 To Len(PW)
                CurChar = Mid(PW, x, 1)
                Select Case Asc(CurChar)
                    Case 48 To 57   'Numbers
                        HasNum = True
                    Case 65 To 90   'Capital letters
                        HasCaps = True
                    Case 97 To 122  'Lower case letters
                        HasLower = True
                    Case Else       'Invalid characters
                        CheckPassword = 5
                        Exit For
                End Select
            Next x
        End If
    End If
    
    If CheckPassword = 0 Then
        If Not HasNum Then
            CheckPassword = 3
        ElseIf Not HasCaps Then
            CheckPassword = 4
        ElseIf Not HasLower Then
            CheckPassword = 6
        Else
            CheckPassword = 255
        End If
    End If
    
End Function
 

pbaldy

Wino Moderator
Staff member
Local time
Today, 07:18
Joined
Aug 30, 2003
Messages
36,118
I'll get out of the way of those giving fish, but I was thinking along the lines of Froth's. A single loop with multiple variables.
 

PaulA

Registered User.
Local time
Today, 14:18
Joined
Jul 17, 2001
Messages
416
Thanks for all the responses. I'll check them out.

Have a great New Year!

Paul
 

PaulA

Registered User.
Local time
Today, 14:18
Joined
Jul 17, 2001
Messages
416
I went with Frohingslosh as it is the most flexible and it works great.

Thanks to you all for your input and suggestions.
 

Frothingslosh

Premier Pale Stale Ale
Local time
Today, 10:18
Joined
Oct 17, 2012
Messages
3,276
Out of curiosity, why the chain IF statement rather than Select Case?

And I'll freely admit that bitwise operators are a weakness of mine.

That said, if I still were doing anything that required password checking, I'd switch to your code over mine in a heartbeat. Mine was just something I threw together a few years back literally in a few minutes to make a deadline.
 

Galaxiom

Super Moderator
Staff member
Local time
Tomorrow, 01:18
Joined
Jan 20, 2009
Messages
12,849
Out of curiosity, why the chain IF statement rather than Select Case?

First thing I thought of at the time. ElseIf and Select Case are not much different really.

And I'll freely admit that bitwise operators are a weakness of mine.

That said, if I still were doing anything that required password checking, I'd switch to your code over mine in a heartbeat.

Since it couldn't be for functionality or performance reasons I expect it is because you don't understand it.

My function has significant advantages. Firstly at the programmer level, its character requirements are configurable. It uses enums to assist with that configuration.

It returns all the requirement deficits in a single pass. It also stops testing for a required character type as soon as the first one is found.

Your code tests every character for every requirement and only shows the first error it encounters. It continues the futile process of testing for the other problems even though they will not be notified.

Mine was just something I threw together a few years back literally in a few minutes to make a deadline.
Yes it shows.;)
 

Frothingslosh

Premier Pale Stale Ale
Local time
Today, 10:18
Joined
Oct 17, 2012
Messages
3,276
First thing I thought of at the time. ElseIf and Select Case are not much different really.

Since it couldn't be for functionality or performance reasons I expect it is because you don't understand it.

Less 'don't understand it' as much as 'have never really used it and thus always need reminders when I encounter it'. I blame it on me tending to stick with what I already know works. :)

My function has significant advantages. Firstly at the programmer level, its character requirements are configurable. It uses enums to assist with that configuration.

It returns all the requirement deficits in a single pass. It also stops testing for a required character type as soon as the first one is found.

Your code tests every character for every requirement and only shows the first error it encounters. It continues the futile process of testing for the other problems even though they will not be notified.

Well, if a straight-up invalid character is encountered, at least it aborts immediately and notifies the user! :D I did notice that yours doesn't filter out things like spaces, carriage returns, and non-printing characters, should they be submitted.

Still, I knew that the feedback was a weakness when I slapped it together, but as I said, I was in a time crunch and didn't have time to get fancy. (Otherwise, I'd have likely done a search, found your code, and thrown it in instead!)

Yes it shows.;)

 

Users who are viewing this thread

Top Bottom