×
INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Contact US

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

VBScript FAQ

Scripting for the Enterprise

Random Complex Password Generator by markdmac
Posted: 30 Jul 04 (Edited 13 Jun 12)

Ever had to come up with a list of complex passwords for a deployment?

There are some sites on the Internet that will do this for you, but I wasn't happy with having to copy and paste from a web page so I made my own generator that will store the passwords into a text file for me.

Enjoy.

CODE


'==========================================================================
'
' NAME: RandomPasswordGenerator.vbs
'
' AUTHOR: Mark D. MacLachlan , The Spider's Parlor
' URL: http://www.thespidersparlor.com
' DATE : 7/29/2004
' MODIFICATIONS:
' 9/2/2008 Added dictionary object to ensure
' uniqueness of passwords
'
' COMMENT: Generates Random Passwords meeting "Complex" Requirements
' By default will generate a 6 digit password.
' Edit line passLen = 6 to change length
'==========================================================================

Option Explicit

Dim pGenNum, newpass, passList, inFlag, pgLength, x, fso, ts, passLen
Const ForWriting = 2
passLen = 6

'Give inFlag (input Flag) an initial value to ensure we run once

inFlag = "Seed"

Do While inFlag <> pGenNum
pGenNum = InputBox("How many passwords would you like to create?" & vbCrLf & _
"Enter a Numeric Value" & vbCrLf & _
"Blank Entry Will Cancel Script","Enter Number of Passwords to Create")

'Quit if no entry

If pGenNum = "" Then WScript.Quit

'Now clear inFlag so we can compare it to the pGenInput going forward

inFlag = ""
pgLength = Len(pGenNum)
'Enumerate each character to ensure we only have numbers

For x = 1 To pgLength
If Asc(Mid(pGenNum,x,1)) < 48 Or Asc(Mid(pGenNum,x,1)) > 57 Then
inFlag = ""
Else
'Build inFlag one character at a time if it is a number.
inFlag = inFlag & Mid(pGenNum,x,1)
End If
Next
'We made it through each character. If not equal prompt for a number.

If inFlag <> pGenNum Then inFlag = ""
Loop

'Generate the number of required passwords.
'Use a dictionary object to ensure uniqueness.

Dim objDict
Set objDict = CreateObject("Scripting.Dictionary")
Do Until objDict.Count = CInt(pGenNum)
newpass = generatePassword(passLen)
If Not objDict.Exists(newpass) Then
objDict.Add newpass, "Unique Password"
passList = passList & newpass & vbCrLf
End If
Loop

'Now save it all to a text file.

Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.CreateTextFile ("PasswordList.txt", ForWriting)
ts.write passList
MsgBox "Passwords saved to PasswordList.txt",,"Passwords Generated"
set ts = nothing
set fso = nothing



Function generatePassword(PASSWORD_LENGTH)

Dim NUMLOWER, NUMUPPER, LOWERBOUND, UPPERBOUND, LOWERBOUND1, UPPERBOUND1, SYMLOWER, SYMUPPER
Dim newPassword, count, pwd
Dim pCheckComplex, pCheckComplexUp, pCheckComplexLow, pCheckComplexNum, pCheckComplexSym, pCheckAnswer


NUMLOWER = 48 ' 48 = 0
NUMUPPER = 57 ' 57 = 9
LOWERBOUND = 65 ' 65 = A
UPPERBOUND = 90 ' 90 = Z
LOWERBOUND1 = 97 ' 97 = a
UPPERBOUND1 = 122 ' 122 = z
SYMLOWER = 33 ' 33 = !
SYMUPPER = 46 ' 46 = .
pCheckComplexUp = 0 ' used later to check number of character types in password
pCheckComplexLow = 0 ' used later to check number of character types in password
pCheckComplexNum = 0 ' used later to check number of character types in password
pCheckComplexSym = 0 ' used later to check number of character types in password


' initialize the random number generator

Randomize()

newPassword = ""
count = 0
DO UNTIL count = PASSWORD_LENGTH
' generate a num between 2 and 10

' if num <= 2 create a symbol
If Int( ( 10 - 2 + 1 ) * Rnd + 2 ) <= 2 Then
pwd = Int( ( SYMUPPER - SYMLOWER + 1 ) * Rnd + SYMLOWER )

' if num is between 3 and 5 create a lowercase
Elseif Int( ( 10 - 2 + 1 ) * Rnd + 2 ) > 2 And Int( ( 10 - 2 + 1 ) * Rnd + 2 ) <= 5 Then
pwd = Int( ( UPPERBOUND1 - LOWERBOUND1 + 1 ) * Rnd + LOWERBOUND1 )

' if num is 6 or 7 generate an uppercase
Elseif Int( ( 10 - 2 + 1 ) * Rnd + 2 ) > 5 And Int( ( 10 - 2 + 1 ) * Rnd + 2 ) <= 7 Then
pwd = Int( ( UPPERBOUND - LOWERBOUND + 1 ) * Rnd + LOWERBOUND )

Else
pwd = Int( ( NUMUPPER - NUMLOWER + 1 ) * Rnd + NUMLOWER )
End If

newPassword = newPassword + Chr( pwd )

count = count + 1

'Check to make sure that a proper mix of characters has been created. If not discard the password.

If count = (PASSWORD_LENGTH) Then
For pCheckComplex = 1 To PASSWORD_LENGTH
'Check for uppercase
If Asc(Mid(newPassword,pCheckComplex,1)) >64 And Asc(Mid(newPassword,pCheckComplex,1))< 90 Then
pCheckComplexUp = 1
'Check for lowercase
ElseIf Asc(Mid(newPassword,pCheckComplex,1)) >96 And Asc(Mid(newPassword,pCheckComplex,1))< 123 Then
pCheckComplexLow = 1
'Check for numbers
ElseIf Asc(Mid(newPassword,pCheckComplex,1)) >47 And Asc(Mid(newPassword,pCheckComplex,1))< 58 Then
pCheckComplexNum = 1
'Check for symbols
ElseIf Asc(Mid(newPassword,pCheckComplex,1)) >32 And Asc(Mid(newPassword,pCheckComplex,1))< 47 Then
pCheckComplexSym = 1
End If
Next

'Add up the number of character sets. We require 3 or 4 for a complex password.

pCheckAnswer = pCheckComplexUp+pCheckComplexLow+pCheckComplexNum+pCheckComplexSym

If pCheckAnswer < 3 Then
newPassword = ""
count = 0
End If
End If
Loop
'The password is good so return it

generatePassword = newPassword
End Function

Back to VBScript FAQ Index
Back to VBScript Forum

My Archive

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close