Random Complex Password Generator

'==========================================================================
'
' NAME: RandomPasswordGenerator.vbs
'
' AUTHOR: Mark D. MacLachlan , The Spider's Parlor
' URL: http://www.thespidersparlor.com
' DATE  : 7/29/2004
'
' COMMENT: Generates Random Passwords meeting "Complex" Requirements
'          By default will generate a 6 digit password.
'          Edit line passLen = 6 to change length
'==========================================================================
Option Explicit
'On Error Resume Next

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.
For x = 1 To pGenNum
	newpass = generatePassword(passLen)
	passList = passList & newpass & vbCrLf
Next

'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 < 5 create an uppercase 
   If Int( ( 10 - 2 + 1 ) * Rnd + 2 ) < 5 Then
    pwd = Int( ( UPPERBOUND - LOWERBOUND + 1 ) * Rnd + LOWERBOUND )
   ' if num is between 4 and 7 create a lowecase
   Elseif Int( ( 10 - 2 + 1 ) * Rnd + 2 ) > 3 And  Int( ( 10 - 2 + 1 ) * Rnd + 2 ) < 8 Then
    pwd = Int( ( UPPERBOUND1 - LOWERBOUND1 + 1 ) * Rnd + LOWERBOUND1 )
    ' if num is between 8 and 10 generate a symbol
   Else
   	pwd = Int( ( SYMUPPER - SYMLOWER + 1 ) * Rnd + SYMLOWER )
   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