Auto Password script

Hi,
I'm looking to create an automatic way that will create a password using a script to output it in a message box and copy it to the clipboard.

The password must:
"Be at least 8 positions in length but up to 10.
"Contain at least one English letter and one digit character
"Should not contain a digit character in the first and last position!(0-9)
"Should not contain identical consecutive characters (aa, ##, 88.)
"Should not contain consecutive keyboard characters (qwer)

For Example:

Correct password will be  C0mputer
(8 letters, starts and ends with an English letter)

Incorrect password - Monitor1
(ends with a digit character)

Incorrect password - monitor
(there is no digit character, less than 8 positions in length.)
johnnyjonathanAsked:
Who is Participating?
 
RobSampsonCommented:
>>  it must start and end with a letter as well.

This will happen anyway if we restrict the random characters to digts and lowercase letters only.

This should work.

Regards,

Rob.
' Basis from here:
'http://www.microsoft.com/technet/scriptcenter/funzone/games/solutions08/avbsol05.mspx
' Question link:
'http://www.experts-exchange.com/Programming/Languages/Visual_Basic/VB_Script/Q_24276924.html
'
' Password rules:
' The password must: 
' "Be at least 8 positions in length but up to 10.
' "Contain at least one English letter and one digit character
' "Should not contain a digit character in the first and last position!(0-9)
' "No special characters - lower case letters and digits only
' "Must begin and end with a letter
' OMITTED: "Should not contain identical consecutive characters (aa, ##, 88.)
' The last rule was omitted due to the complexity of it.
 
Const MinLength = 8
Const MaxLength = 10
 
While ValidatePassword(strPassword) = False
	strPassword = GeneratePassword
Wend
MsgBox strPassword
 
Function GeneratePassword()
 
	strRndPwd = ""
	
	If MinLength = "" Or MaxLength = "" Then
		WScript.Echo "Min and max lengths are not defined. Please set MinLength and MaxLength globally."
		Exit Function
	End If
	
	Randomize
	intLength = Int((MaxLength - MinLength + 1) * Rnd + MinLength)
 
	Const AsciiLower = 32
	Const AsciiUpper = 126
 
	While Len(strRndPwd) <= intLength
		'Randomize
		strChr = Chr(Int((AsciiUpper - AsciiLower + 1) * Rnd + AsciiLower))
		If (Asc(strChr) >= 48 And Asc(strChr) <= 57) Or (Asc(strChr) >= 97 And Asc(strChr) <= 122) Then strRndPwd = strRndPwd & strChr
	Wend
 
	GeneratePassword = strRndPwd
End Function
 
Function ValidatePassword(strValPwd)
	Set objRegEx = CreateObject("VBScript.RegExp")
	boolValid = True
	' Check the length requirement
	If Len(strValPwd) < MinLength Or Len(strValPwd) > MaxLength Then boolValid = False
	' Look for an english character
	If boolValid = True Then
		objRegEx.Pattern = "[a-z]"
		Set colMatches = objRegEx.Execute(strValPwd)  
		If colMatches.Count = 0 Then boolValid = False
	End If
	' Look for a digit
	If boolValid = True Then
		objRegEx.Pattern = "[0-9]"
		Set colMatches = objRegEx.Execute(strValPwd)  
		If colMatches.Count = 0 Then boolValid = False
	End If
	' Look for a digit in the first or last position
	If boolValid = True Then
		strFirstChr = Left(strValPwd, 1)
		strLastChr = Right(strValPwd, 1)
		If IsNumeric(strFirstChr) Or IsNumeric(strLastChr) Then boolValid = False
	End If
	ValidatePassword = boolValid
End Function

Open in new window

0
 
johnnyjonathanAuthor Commented:
Forgot, also it cannot containt the word "help" or "desk"
0
 
RobSampsonCommented:
>> "Should not contain consecutive keyboard characters (qwer)

This one's going to be just about impossible.  If that were a strict rule,
C0mputer

would not valid either because e and r are consecutive on the keyboard.

Check this article out for validating a password:
http://www.microsoft.com/technet/scriptcenter/funzone/games/solutions08/avbsol05.mspx

Regards,

Rob.
0
Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

 
johnnyjonathanAuthor Commented:
your right, maybe i'm getting too strict :)
anyway without this rule ?
0
 
RobSampsonCommented:
Yeah, the rest should be doable.....do you want to validate a user-inputted password, or do want a password automatically created?  The latter will be more difficult, but I have an idea of how to do it....

Regards,

Rob.
0
 
johnnyjonathanAuthor Commented:
I'm looking for the latter, just a one click script that can auto generate the password according to the rules mentioned before.
0
 
RobSampsonCommented:
OK, finally got there.

Give this a shot.

Regards,

Rob.
' Basis from here:
'http://www.microsoft.com/technet/scriptcenter/funzone/games/solutions08/avbsol05.mspx
' Question link:
'http://www.experts-exchange.com/Programming/Languages/Visual_Basic/VB_Script/Q_24276924.html
'
' Password rules:
' The password must: 
' "Be at least 8 positions in length but up to 10.
' "Contain at least one English letter and one digit character
' "Should not contain a digit character in the first and last position!(0-9)
' OMITTED: "Should not contain identical consecutive characters (aa, ##, 88.)
' The last rule was omitted due to the complexity of it.
 
Const MinLength = 8
Const MaxLength = 10
 
While ValidatePassword(strPassword) = False
	strPassword = GeneratePassword
Wend
MsgBox strPassword
 
Function GeneratePassword()
 
	strRndPwd = ""
	
	If MinLength = "" Or MaxLength = "" Then
		WScript.Echo "Min and max lengths are not defined. Please set MinLength and MaxLength globally."
		Exit Function
	End If
	
	Randomize
	intLength = Int((MaxLength - MinLength + 1) * Rnd + MinLength)
 
	Const AsciiLower = 32
	Const AsciiUpper = 126
 
	While Len(strRndPwd) <= intLength
		'Randomize
		strChr = Chr(Int((AsciiUpper - AsciiLower + 1) * Rnd + AsciiLower))
		strRndPwd = strRndPwd & strChr
	Wend
 
	GeneratePassword = strRndPwd
End Function
 
Function ValidatePassword(strValPwd)
	Set objRegEx = CreateObject("VBScript.RegExp")
	boolValid = True
	' Check the length requirement
	If Len(strValPwd) < MinLength Or Len(strValPwd) > MaxLength Then boolValid = False
	' Look for an english character
	If boolValid = True Then
		objRegEx.Pattern = "[a-z][A-Z]"
		Set colMatches = objRegEx.Execute(strValPwd)  
		If colMatches.Count = 0 Then boolValid = False
	End If
	' Look for a digit
	If boolValid = True Then
		objRegEx.Pattern = "[0-9]"
		Set colMatches = objRegEx.Execute(strValPwd)  
		If colMatches.Count = 0 Then boolValid = False
	End If
	' Look for a digit in the first or last position
	If boolValid = True Then
		strFirstChr = Left(strValPwd, 1)
		strLastChr = Right(strValPwd, 1)
		If IsNumeric(strFirstChr) Or IsNumeric(strLastChr) Then boolValid = False
	End If
	ValidatePassword = boolValid
End Function

Open in new window

0
 
johnnyjonathanAuthor Commented:
it works great.
one note though, can you please let me know how i can turn off the special characters addition, and the CAPS letters in ABC, to make sure it will stay coordinated with future policy?
0
 
johnnyjonathanAuthor Commented:
Also, sorry i forgot this, but it must start and end with a letter is there an option to set it?
0
 
RobSampsonCommented:
OK, so by omitting special characters, do you basically want only lowercase letters, and digits available for use?  The ASCII table can be found here:
http://asciitable.com/

I can make the password only include characters from decimal codes 48 through 57 for digits, and 97 through 122 for lowercase letters.

Regards,

Rob.
0
 
johnnyjonathanAuthor Commented:
That's correct, however like i said, it must start and end with a letter as well.
0
 
johnnyjonathanAuthor Commented:
Works great! thank you
0
 
johnnyjonathanAuthor Commented:
Works like a charm, tell me please, for the future, is there an option i can block specific words from appearing even by random?
 
0
 
RobSampsonCommented:
Yeah sure, if you make your Validate_Password like this, it will invalidate any passwords that match words in the array.

Regards,

Rob.
Function ValidatePassword(strValPwd)
	Set objRegEx = CreateObject("VBScript.RegExp")
	boolValid = True
	' Check the length requirement
	If Len(strValPwd) < MinLength Or Len(strValPwd) > MaxLength Then boolValid = False
	' Look for an english character
	If boolValid = True Then
		objRegEx.Pattern = "[a-z]"
		Set colMatches = objRegEx.Execute(strValPwd)  
		If colMatches.Count = 0 Then boolValid = False
	End If
	' Look for a digit
	If boolValid = True Then
		objRegEx.Pattern = "[0-9]"
		Set colMatches = objRegEx.Execute(strValPwd)  
		If colMatches.Count = 0 Then boolValid = False
	End If
	' Look for a digit in the first or last position
	If boolValid = True Then
		strFirstChr = Left(strValPwd, 1)
		strLastChr = Right(strValPwd, 1)
		If IsNumeric(strFirstChr) Or IsNumeric(strLastChr) Then boolValid = False
	End If
	' Prevent specific words from being the password
	Set objDict = CreateObject("Scripting.Dictionary")
	objDict.Add "password", 0
	objDict.Add "workman", 0
	objDict.Add "hospital", 0
	If objDict.Exists(strValPwd) = True the boolValid = False
	' Return the valid code
	ValidatePassword = boolValid
End Function

Open in new window

0
 
johnnyjonathanAuthor Commented:
great, understood.
0
 
RobSampsonCommented:
Although.....that won't actually stop passwords like
hospital1a

so, I've now changed it to an InStr match, so the word can *not* be anywhere in the whole password.

Regards,

Rob.
Function ValidatePassword(strValPwd)
	Set objRegEx = CreateObject("VBScript.RegExp")
	boolValid = True
	' Check the length requirement
	If Len(strValPwd) < MinLength Or Len(strValPwd) > MaxLength Then boolValid = False
	' Look for an english character
	If boolValid = True Then
		objRegEx.Pattern = "[a-z]"
		Set colMatches = objRegEx.Execute(strValPwd)  
		If colMatches.Count = 0 Then boolValid = False
	End If
	' Look for a digit
	If boolValid = True Then
		objRegEx.Pattern = "[0-9]"
		Set colMatches = objRegEx.Execute(strValPwd)  
		If colMatches.Count = 0 Then boolValid = False
	End If
	' Look for a digit in the first or last position
	If boolValid = True Then
		strFirstChr = Left(strValPwd, 1)
		strLastChr = Right(strValPwd, 1)
		If IsNumeric(strFirstChr) Or IsNumeric(strLastChr) Then boolValid = False
	End If
	' Prevent specific words from being the password
	arrWords = Array( _
		"help", _
		"desk", _
		"hospital" _
	)
	For Each strWord In arrWords
		If InStr(strValPwd, strWord) > 0 Then boolValid = False
	Next
	' Return the valid code
	ValidatePassword = boolValid
End Function

Open in new window

0
 
johnnyjonathanAuthor Commented:
Thank you Rob,
any way i can export the password to the clipbrd as well ?
0
 
RobSampsonCommented:
Yeah sure, this should work.

Regards,

Rob.
' Basis from here:
'http://www.microsoft.com/technet/scriptcenter/funzone/games/solutions08/avbsol05.mspx
' Question link:
'http://www.experts-exchange.com/Programming/Languages/Visual_Basic/VB_Script/Q_24276924.html
'
' Password rules:
' The password must: 
' "Be at least 8 positions in length but up to 10.
' "Contain at least one English letter and one digit character
' "Should not contain a digit character in the first and last position!(0-9)
' "No special characters - lower case letters and digits only
' "Must begin and end with a letter
' OMITTED: "Should not contain identical consecutive characters (aa, ##, 88.)
' The last rule was omitted due to the complexity of it.
 
Const MinLength = 8
Const MaxLength = 10
 
While ValidatePassword(strPassword) = False
	strPassword = GeneratePassword
Wend
 
CopyToClipboard strPassword
 
MsgBox strPassword & " has been copied to the clipboard."
 
Function GeneratePassword()
 
	strRndPwd = ""
	
	If MinLength = "" Or MaxLength = "" Then
		WScript.Echo "Min and max lengths are not defined. Please set MinLength and MaxLength globally."
		Exit Function
	End If
	
	Randomize
	intLength = Int((MaxLength - MinLength + 1) * Rnd + MinLength)
 
	Const AsciiLower = 32
	Const AsciiUpper = 126
 
	While Len(strRndPwd) <= intLength
		'Randomize
		strChr = Chr(Int((AsciiUpper - AsciiLower + 1) * Rnd + AsciiLower))
		If (Asc(strChr) >= 48 And Asc(strChr) <= 57) Or (Asc(strChr) >= 97 And Asc(strChr) <= 122) Then strRndPwd = strRndPwd & strChr
	Wend
 
	GeneratePassword = strRndPwd
End Function
 
Function ValidatePassword(strValPwd)
	Set objRegEx = CreateObject("VBScript.RegExp")
	boolValid = True
	' Check the length requirement
	If Len(strValPwd) < MinLength Or Len(strValPwd) > MaxLength Then boolValid = False
	' Look for an english character
	If boolValid = True Then
		objRegEx.Pattern = "[a-z]"
		Set colMatches = objRegEx.Execute(strValPwd)  
		If colMatches.Count = 0 Then boolValid = False
	End If
	' Look for a digit
	If boolValid = True Then
		objRegEx.Pattern = "[0-9]"
		Set colMatches = objRegEx.Execute(strValPwd)  
		If colMatches.Count = 0 Then boolValid = False
	End If
	' Look for a digit in the first or last position
	If boolValid = True Then
		strFirstChr = Left(strValPwd, 1)
		strLastChr = Right(strValPwd, 1)
		If IsNumeric(strFirstChr) Or IsNumeric(strLastChr) Then boolValid = False
	End If
	' Prevent specific words from being the password
	arrWords = Array( _
		"help", _
		"desk", _
		"hospital" _
	)
	For Each strWord In arrWords
		If InStr(strValPwd, strWord) > 0 Then boolValid = False
	Next
	' Return the valid code
	ValidatePassword = boolValid
End Function
 
Sub CopyToClipboard(strTextForClipboard)
	Set objIE = CreateObject("InternetExplorer.Application")
	objIE.Navigate("about:blank")
	objIE.document.parentwindow.clipboardData.SetData "text", strTextForClipboard
	objIE.Quit
End Sub

Open in new window

0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.