password policy

I am currently generating a random password with the code below. We are implementing a password policy and I need to change the script that generates the password to match this password policy.

This is the current script:

Function generatePassword( passwordLength )
    Dim sDefaultChars
    Dim iCounter
    Dim sMyPassword
    Dim iPickedChar
    Dim iDefaultCharactersLength
    Dim iPasswordLength

    sDefaultChars="abcdefghijklmnopqrstuvxyzABCDEFGHIJKLMNOPQRSTUVXYZ0123456789"
    iPasswordLength=passwordLength
    iDefaultCharactersLength = Len(sDefaultChars) 

    Randomize 'initialize the random number generator

    For iCounter = 1 To iPasswordLength
        'Next pick a number from 1 to length of character set 
        iPickedChar = Int((iDefaultCharactersLength * Rnd) + 1) 

        'Next pick a character from the character set using the random number iPickedChar and Mid function
        sMyPassword = sMyPassword & Mid(sDefaultChars,iPickedChar,1)
    Next 

    generatePassword = sMyPassword
End Function

Open in new window


Password policy:

Mininum:

- 1 Upper case Alphabet
- 3 lower case alphabet
- 2 numbers
- 1 special character    ~!@#$%^+-
LVL 1
AleksAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Member_2_1001466Commented:
the easiest way is to use the generator as normal and validate the PW, if it fails, generate a new one, until the validation succeeds.
From you initial set, it seems that only upper and lowercase characters are possible. Add numbers and special characters as well to the string.
AleksAuthor Commented:
I rather have a script that generates the 10 digit code with the validation above.
Member_2_1001466Commented:
A lot of scripts do it the way I described earlier, as the position of special characters, numbers, upper and lower case is also random.
But you can put the validation into your generator:
Check, that it contains at least 1 upper case, at least 3 lower case, 2 numbers and 1 special char after you generated a random 10 char code. If it does not validate, start from scratch.
Become a Microsoft Certified Solutions Expert

This course teaches how to install and configure Windows Server 2012 R2.  It is the first step on your path to becoming a Microsoft Certified Solutions Expert (MCSE).

Member_2_1001466Commented:
To get a higher chance of generating it with the correct parts, generate a first random number between 0 and 1. If it is below 0.3, take a lower case, if it is between 0.3 and 0.4 take an upper case, between 0.4 and 0.5 take special char, between 0.5 and 0.7 a number and in the remaining case take any char from all possible chars.
AleksAuthor Commented:
Yeah .. I was asking for help with the actual script. I don't know VBscript  :$  and unfortunately learning will take time I don't have at the moment.
aikimarkCommented:
Please try this.
Function generatePassword(passwordLength)
    Dim sDefaultChars
    Dim iCounter
    Dim sMyPassword
    Dim iPickedChar
    Dim iDefaultCharactersLength
    Dim iPasswordLength
    Dim UC_Count, LC_Count, Num_Count, Special_Count
    Dim TempPWD
    Dim boolAddit
    Static oRE
    Dim oMatches
    
    If passwordLength < 7 Then  '7 is min pwd length
        Error 5000
        Exit Function
    End If
    
    If IsEmpty(oRE) Then
        ReDim oRE(3)
        Set oRE(0) = CreateObject("vbscript.regexp")
        oRE(0).Global = True
        oRE(0).Pattern = "[A-Z]"
        Set oRE(1) = CreateObject("vbscript.regexp")
        oRE(1).Global = True
        oRE(1).Pattern = "[a-z]"
        Set oRE(2) = CreateObject("vbscript.regexp")
        oRE(2).Global = True
        oRE(2).Pattern = "[0-9]"
        Set oRE(3) = CreateObject("vbscript.regexp")
        oRE(3).Global = True
        oRE(3).Pattern = "[~!@#$%^+-]"
    End If

    sDefaultChars = "abcdefghijklmnopqrstuvxyzABCDEFGHIJKLMNOPQRSTUVXYZ0123456789~!@#$%^+-"
    iPasswordLength = passwordLength
    iDefaultCharactersLength = Len(sDefaultChars)

    Randomize 'initialize the random number generator

    Do
        'Next pick a character from the candidate list
        iPickedChar = Int((iDefaultCharactersLength * Rnd) + 1)
        TempPWD = sMyPassword & Mid(sDefaultChars, iPickedChar, 1)
        Set oMatches = oRE(0).Execute(TempPWD)
        UC_Count = oMatches.Count
        Set oMatches = oRE(1).Execute(TempPWD)
        LC_Count = oMatches.Count
        Set oMatches = oRE(2).Execute(TempPWD)
        Num_Count = oMatches.Count
        Set oMatches = oRE(3).Execute(TempPWD)
        Special_Count = oMatches.Count
        
        boolAddit = ((UC_Count <= 1) And (LC_Count <= 3) And (Num_Count <= 2) And (Special_Count <= 1))
        
        If Len(sMyPassword) < 7 Then
            If boolAddit Then
                sMyPassword = TempPWD
            End If
        Else
            sMyPassword = TempPWD
        End If
        
    Loop Until Len(sMyPassword) = iPasswordLength

    generatePassword = sMyPassword
End Function

Open in new window

Note: There are some weaknesses in the VB PRNG that I outlined in this article.
http://www.experts-exchange.com/articles/11114/An-Examination-of-Visual-Basic's-Random-Number-Generation.html

=================
The above solution probably isn't the most efficient, but I started with your code.  If starting from scratch, I probably would select random elements from each of the categories until I reached each of the category (min character) limit, continuing to pick random items until the desired password length had been met.  Then I would shuffle the items into the new password string.
aikimarkCommented:
I added the PickNFromList() function to help illustrate the algorithm.
Function generatePassword2(passwordLength)
    Dim sDefaultChars
    Dim sUC_Chars, sLC_Chars, sNum_Chars, sSpecial_Chars
    Dim iCounter
    Dim sMyPassword
    Dim iPickedChar
    Dim iDefaultCharactersLength
    Dim iPasswordLength
    Dim UC_Count, LC_Count, Num_Count, Special_Count
    Dim TempPWD
    Dim boolAddit
    
    If passwordLength < 7 Then  '7 is min pwd length
        Error 5000
        Exit Function
    End If
    

    sDefaultChars = "abcdefghijklmnopqrstuvxyzABCDEFGHIJKLMNOPQRSTUVXYZ0123456789~!@#$%^+-"
    sUC_Chars = "ABCDEFGHIJKLMNOPQRSTUVXYZ"
    sLC_Chars = "abcdefghijklmnopqrstuvxyz"
    sNum_Chars = "0123456789"
    sSpecial_Chars = "~!@#$%^+-"
    iPasswordLength = passwordLength
    iDefaultCharactersLength = Len(sDefaultChars)

    Randomize 'initialize the random number generator
    
    'get min number from each category
    TempPWD = PickNFromList(1, sUC_Chars)
    TempPWD = TempPWD & PickNFromList(3, sLC_Chars)
    TempPWD = TempPWD & PickNFromList(2, sNum_Chars)
    TempPWD = TempPWD & PickNFromList(1, sSpecial_Chars)
    
    'pad with any character
    Do Until Len(TempPWD) = iPasswordLength
        'Next pick a character from the big candidate list
        iPickedChar = Int((iDefaultCharactersLength * Rnd) + 1)
        TempPWD = TempPWD & Mid(sDefaultChars, iPickedChar, 1)
    Loop
    
    Do  'shuffle select the TempPWD characters
        'pick a character from the TempPWD string
        iPickedChar = Int((Len(TempPWD) * Rnd) + 1)
        sMyPassword = sMyPassword & Mid(TempPWD, iPickedChar, 1)
        
        'remove that character from TempPWD
        TempPWD = Left(TempPWD, iPickedChar - 1) & Mid(TempPWD, iPickedChar + 1)
    Loop Until Len(sMyPassword) = passwordLength

    generatePassword2 = sMyPassword
End Function

Function PickNFromList(parmN, parmList)
    Dim lngPosn
    Dim lngLoop
    For lngLoop = 1 To parmN
        lngPosn = Int((Len(parmList) * Rnd) + 1)
        PickNFromList = PickNFromList & Mid(parmList, lngPosn, 1)
    Next
End Function

Open in new window


Although the shuffle select isn't required, it does help increase the pseudo-random nature of the returned string.

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
AleksAuthor Commented:
:)
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
ASP

From novice to tech pro — start learning today.