StrongPwd Object

StrongPwd Object

--------------------------------------------------------------------------------

Description : The StrongPwd Object exposes properties and methods to create and test passwords
to ensure that they meet or exceed strong password standards.

Create Method
syntax:
string = object.Create()
description:
Creates a strong password. The mechanism used to create
passwords is pseudo-random so it is not entirely guaranteed that
the password created will be strong. To guarantee a strong
password, Call the CreateEx Method instead.
arguments:
None
returns:
string.

CreateEx Method
syntax:
string = object.CreateEx()
description:
CreateEx creates a password that is guaranteed to pass the
requirements specified in the Check method. CreateEx ensures
a strong password by calling Create over and over again and
testing the returned password against the Check method. Once
the Create method returns a strong password that passes all
tests, that password is returned by CreateEx.
arguments:
None
returns:
string.

FailurePoint Property
syntax:
string = object.FailurePoint
description:
The FailurePoint property contains valid data if the Check
method returns false. In other words, when you test a password
using the Check method and the check method returns false,
the FailurePoint property will tell you why the Check method
considers the password not strong.
returns:
string. read-only.

Check Method
syntax:
boolean = object.Check(usrname, password)
description:
The Check method checks a password to ensure that is
strong. It checks the following criteria:
1.) password must have at least 6 characters
2.) password must not contain the user name
3.) password must contain at least 3 character
classes:
- English Upper Case Letters
- English Lower Case Letters
- Westernized Arabic Numbers
- Non-Alphanumeric (Special Characters)
arguments:
1.) usrname. string. The user name that this password is
being used with.
2.) password. string. The password to check.
returns:
boolean.

<%
Class StrongPwd
Private AllChars, sFailure

Private Sub Class_Initialize()
Dim s

s = ""
s = s & "A>=a{Bn0@Cb;D[o1<Ecp~F2qG}rH/d%3(st^IJ]eu"
s = s & "$4K:Lf5&M*v-gN`6?OhP+|7w)iQ""R8jS.xT9_kUy'VW,lXm!#YzZ"
AllChars = s
End Sub

Public Function Create()
Dim hPwdLen, i, sOut, sNewOut, hBeg, hEnd

hBeg = 0
hEnd = 0
hPwdLen = 0
i = 0
sOut = ""
sNewOut = ""

Randomize
hPwdLen = Int((Rnd * 10) + 7)
For i = 1 To hPwdLen
Randomize
sOut = sOut & Mid(AllChars, Int(Rnd * Len(AllChars)) + 1, 1)
Next
hEnd = Len(sOut) - 1
Do until (hBeg = hEnd) Or (hEnd - 1 = hBeg)
sNewOut = sNewOut & Mid(sOut, hBeg + 1, 1) & Mid(sOut, hEnd + 1, 1)
If hBeg = hEnd Or hEnd - 1 = hBeg Then Exit Do
hEnd = Abs(hEnd - 1)
hBeg = Abs(hBeg + 1)
Loop
If hPwdLen Mod 2 = 0 Then
sNewOut = sNewOut & Mid(sOut, hBeg + 1, 1) & Mid(sOut, hEnd + 1, 1)
Else
sNewOut = sNewOut & Mid(sOut, hBeg + 1, 1)
End If
Create = StrReverse(sNewOut)
End Function

Public Function CreateEx()
Dim sPwd

sPwd = create
Do until check("anonymous", sPwd)
sPwd = create
Loop
CreateEx = sPwd
End Function

Public Property Get FailurePoint
FailurePoint = sFailure
End Property

Public Function Check(ByVal sUsrName, ByVal sPassword)
'http://support.microsoft.com/support/kb/articles/q161/9/90.asp
Dim re, passCt

sFailure = ""
Check = False
passCt = 0

'Passwords must be at least six (6) characters long
If Len(sPassword) < 6 Then
sFailure = "minimum length requirement not satisfied"
Exit Function
End If

'Passwords may not contain your user name
If InStr(LCase(sPassword), LCase(sUsrName)) <> 0 Then
sFailure = "password contains user name"
Exit Function
End If

'Passwords must contain characters from at least three (3)
'of four (4) character classes
Set re = New regexp
With re
.ignorecase = False
.global = True
.multiline = False
.pattern = "[A-Z_]"
If .test(sPassword) Then
passCt = passCt + 1
Else
sFailure = "Missing character class: " & _
"English upper case letters" & vbCrLf
End If
.pattern = "[a-z_]"
If .test(sPassword) Then
passCt = passCt + 1
Else
sFailure = sFailure & "Missing character class: " & _
"English lower case letters" & vbCrLf
End If
.pattern = "[0-9]"
If .test(sPassword) Then
passCt = passCt + 1
Else
sFailure = sFailure & "Missing character class: " & _
"Westernized arabic numbers" & vbCrLf
End If
.pattern = "[W]"
If .test(sPassword) Then
passCt = passCt + 1
Else
sFailure = sFailure & "Missing character class: " & _
"Non-alphanumeric (""special characters"")" & vbCrLf
End If
End With
Set re = Nothing
If passCt < 3 Then Exit Function
sFailure = ""
Check = True
End Function
End Class
%>