• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 1123
  • Last Modified:

HTA Check Complex Password

I need a subroutine to include in a HTA that checks that a password is complex according to Microsoft Active Directory ie:
*at least 6 characters long
*does not contain 3 or more characters from the user accounts name
and contains 3 of the 5 following criteria:
*Uppercase letters (A-Z)
*Lowercase letters (a-z)
*Numbers (0-9)
*Non-alphanumeric (eg !, @, #, $, % etc)
*Unicode characters

Any help much appreciated :-)
0
churchlandsshs
Asked:
churchlandsshs
  • 2
  • 2
1 Solution
 
chandru_solCommented:
Try this script



Chandru
'==============================================================================
'
' VBScript Source File -- Created with SAPIEN Technologies PrimalScript 2007
'
' NAME: 
'
' AUTHORS: Mark F. Mahoney, NGIT and James P. Wrench, NGIT
' DATE  : 10/26/2007
'
' COMMENT: This component generates complex passwords with controlled
'   content requirements of a minimum of 2 upper case letters, 2 lower Case
'   letters, 2 numbers and 2 special characters. It uses ASCII conversions
'   because there is no need to build an array of all the characters needed,
'   they already exist in the ASCII Table retrieved from;
'       http://ascii-table.com ....
'
' The problem to solve is how to guarantee that a minimum of those characters
'   exist within the PW. So we controll it by randomizing the each ASCI table
'   range for Each catagory and build the PW. The following is the ASCII
'   table's decimal range;
'	 Upper Case   65-90
'	 Lower Case   97-122
'	 Special Char 33-47, 58-64, (91-96, 123-126 are not used)
'    Numbers 	 48-57
'  Once done, the wscript built in conversion of "Chr()" is used to do the
'  decimal to character convertion for the final PW.
'==============================================================================
Option Explicit
'==============================================================================
' Declaring all the variables....
'==============================================================================
Dim PWLen
Dim PWLen1
Dim PWLen2
Dim PWLen3
Dim PWLen4
Dim PWLen5
Dim NewPW
Dim TempPW
Dim FinalPW
Dim AddChr
Dim UCaseChrMin
Dim UCaseChrMax
Dim LCaseChrMin
Dim LCaseChrMax
Dim SpecialChrMin
Dim SpecialChrMax
Dim SpecialChr2Min
Dim SpecialChr2Max
Dim NumberMin
Dim NumberMax
Dim a()
Dim i
Dim PW
Dim Value, ValueString
 
'==============================================================================
' Initializing variable values...
'  The min-max are the ranges from which to randomize...
'==============================================================================
UCaseChrMin 	= 65
UCaseChrMax		= 90
LCaseChrMin		= 97
LCaseChrMax		= 122
SpecialChrMin	= 33
SpecialChrMax	= 47
SpecialChr2Min	= 58
SpecialChr2Max	= 64
NumberMin		= 48
NumberMax		= 57
 
PWLen			= 0
PWLen1			= 0
PWLen2			= 0
PWLen3			= 0
PWLen4			= 0
NewPW			= ""
FinalPW			= ""
 
'==============================================================================
' The following five (5) loops control the minimum content type of the PW...
' The problem that this introduces is a PW pattern from building it one Loop
'   after another...
'
' To fix the PW pattern problem the content is scrambled. This is done by
'  creating an array to store each character and rebuilding the PW...
'
' To view the progress of the PW generation unremark the Echo statements...
'
' The syntax for the Rnd() is a standard form that states that the intergers
' upper case max and upper case min is the range and increment starting 
' from the upper case min...
' 
'==============================================================================
Randomize
 
Do While PWLen < 3
 
	AddChr = Int((UCaseChrMax - UCaseChrMin + 1) * Rnd() + UCaseChrMin)
	NewPW = NewPW & Chr(AddChr)
	PWLen = PWLen + 1
 
	WScript.Echo AddChr
	WScript.Echo NewPW
		
Loop
 
Do While PWLen1 < 3
 
	AddChr = Int((LCaseChrMax - LCaseChrMin + 1) * Rnd() + LCaseChrMin)
	NewPW = NewPW & Chr(AddChr)
	PWLen1 = PWLen1 + 1
 
	WScript.Echo AddChr
	WScript.Echo NewPW
		
Loop
 
Do While PWLen2 < 4
 
	AddChr = Int((SpecialChrMax - SpecialChrMin + 1) * Rnd() + SpecialChrMin)
	NewPW = NewPW & Chr(AddChr)
	PWLen2 = PWLen2 + 1
 
	WScript.Echo AddChr
	WScript.Echo NewPW
		
Loop
 
Do While PWLen3 < 4
 
	AddChr = Int((NumberMax - NumberMin + 1) * Rnd() + NumberMin)
	NewPW = NewPW & Chr(AddChr)
	PWLen3 = PWLen3 + 1
 
	WScript.Echo AddChr
	WScript.Echo NewPW
		
Loop
 
Do While PWLen4 < 2
 
	AddChr = Int((SpecialChr2Max - SpecialChr2Min + 1) * Rnd() + SpecialChr2Min)
	NewPW = NewPW & Chr(AddChr)
	PWLen4 = PWLen4 + 1
 
	WScript.Echo AddChr
	WScript.Echo NewPW
		
Loop
 
'==============================================================================
'  The following takes the password and removes the pattern...
'    1. Initialize a variable with the value of the newly created PW...
'    2. Initialize a variable with its length...
'	 3. Read each character into the array a()...
'	 4. Do loop till all origional characters are selected randomly...
'	A seperator ":" was needed before and after each character to allow
'     for numbers above 9...
'	 
'==============================================================================
TempPW = NewPW
 
PWLen5 = Len(TempPW)
ReDim a(PWLen5 - 1)
 
For i = 0 To PWLen5 - 1
    a(i) = Left(TempPW,1)
    TempPW = Right(TempPW,Len(TempPW) - 1)
Next
 
		' Generate the new password by randomizing the 1st generation
		'  randomixed characters till 16 have been reached...
Do While len(FinalPW) < 16
 
	Value = Int((15 - 0 + 1) * Rnd + 0)
	
		' Has the character position been used, if so continue the selection...
		
	If InStr(ValueString, ":" & Value & ":") > 0 Then
			' Do nothing...
		'Wscript.Echo "String " & ValueString
		
	Else 	
 
		PW = a(Value)
		FinalPW = FinalPW + PW
 
			' Put the numeric value (position) in a string so that character does not get used a second time...
			' The ":" in front and in back of the value accomodate numbers > 9, IE 16...
		ValueString = ValueString & ":" & Value & ":"
 
	End If
 
Loop	
			' The variable "FinalPW" is now the PW and can be used as you see fit...
			' This will be used as a component in a larger script that will change all 
			' local administrator PWs every 59 days...
WScript.Echo(vbLf & "We start with the patterned PW of:              " &  NewPW)
WScript.Echo("    Notice the pattern of 3up,3low,4sp," & vbLf &_
"    4num,2sp characters that need to" & vbLf &_ 
"    be randomized...")
WScript.Echo("When we randomized w/o repeats the PW becomes:  " & FinalPW & vbLF)

Open in new window

0
 
churchlandsshsAuthor Commented:
Thanks for your response Chandru, but I need a script which checks the complexity of a password entered by the user, rather than generating a complex password.
0
 
chandru_solCommented:
Rather than checking the password enterted can't this be automated using the script so that there is no necessary to check complexity of the password


Chandru
0
 
churchlandsshsAuthor Commented:
I'd prefer that the initial password created for these users isn't totally random, as they are fairly young kids. But that is an option if i get no other responses.
0
 
rejoinderCommented:
This HTA will display the password requirements to the kids so they know what they have to meet.  Below that is a text box to enter a password.  At the moment the box uses the password stars to hide the password.  If the kids are little, the code needs to be changed so that they can see what they are typing.  Hit enter or click the button to test the password.
If the requirements are not met, then the results are displayed below.  If the password is good, they get a congratulations message.
At each point you can customize what is displayed.  If the kids are particularly young, I could modify the script so that the bullet list has check marks so they know they are meeting some of the requirements... A feature you might want later, lets see if this works for you right now.

<head>
<title>Test Your Password</title>
<HTA:APPLICATION 
     APPLICATIONNAME="Test-Your-Password"
     BORDER="thick"
     SCROLL="yes"
     SINGLEINSTANCE="yes"
     ID="oHTA"
>
<APPLICATION:HTA>
</head>
 
<script language="VBScript">
 
Sub Window_Onload
    strComputer = "."
    Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
    Set colItems = objWMIService.ExecQuery("Select * From Win32_DesktopMonitor")
    For Each objItem in colItems
        intHorizontal = objItem.ScreenWidth
        intVertical = objItem.ScreenHeight
    Next
    intHeight = 595
    intWidth = 465
    intLeft = (intHorizontal - intWidth) / 2
    intTop = (intVertical - intHeight) / 2
    window.resizeTo intWidth,intHeight
    window.moveTo intLeft, intTop
End Sub
 
Sub btn_test_onClick()
    'I need a subroutine to include in a HTA that checks that a password is complex according to Microsoft Active Directory ie:
    '*at least 6 characters long
    '*does not contain 3 or more characters from the user accounts name
    'and contains 3 of the 5 following criteria:
    '*Uppercase letters (A-Z)
    '*Lowercase letters (a-z)
    '*Numbers (0-9)
    '*Non-alphanumeric (eg !, @, #, $, % etc)
    '*Unicode characters
    
    
    Dim strPassword
    Dim intStrength : intStrength = 5
    Dim objRegEx    : Set objRegEx = CreateObject("VBScript.RegExp")
    Dim colMatches
    Dim strStrength
    Dim WshNetwork
    Dim strUsername
    Dim n
    Dim intLettersFound
    
    strPassword = trim(txt_Password.Value)
    
    txt_Results.Value = ""
    
    Set WshNetwork = CreateObject("WScript.Network")
    strUsername    = WshNetwork.UserName
    
    'Make sure that no more than 2 letters from the users name are in the password
    
    intLettersFound = 0
    for n = 1 to len(strPassword)
        if InStr(strUsername,mid(strPassword,n,1)) > 0 then
            intLettersFound = intLettersFound + 1
        end if
    next
    if intLettersFound > 2 then
        intStrength = intStrength - 5
        txt_Results.Value = txt_Results.Value & "There are too many letters from your login name." & vbCRLF
    end if
    
    ' Make sure that the password is at least 6 characters long but no more
    ' than 20 characters long
    
    if (len(strPassword) <= 6) OR (len(strPassword) => 20) then
        intStrength = intStrength - 5
        txt_Results.Value = txt_Results.Value & "Password should be at least 6 but no more than 20 characters long." & vbCRLF
    end if
    
    ' Make sure that the password includes at least one number (the digits 0 through 9)
    
    objRegEx.Pattern = "[0-9]"
    Set colMatches   = objRegEx.Execute(strPassword)  
    
    If colMatches.Count = 0 Then
        txt_Results.Value = txt_Results.Value & "No digits found." & vbCRLF
    End If
    
    ' Make sure that the password includes at least one uppercase letter
    
    objRegEx.Pattern = "[A-Z]"
    Set colMatches   = objRegEx.Execute(strPassword)  
    
    If colMatches.Count = 0 Then
        intStrength = intStrength - 1
        txt_Results.Value = txt_Results.Value & "No uppercase characters found." & vbCRLF
    End If
    
    ' Make sure that the password includes at least one lowercase letter
    
    objRegEx.Pattern = "[a-z]"
    Set colMatches   = objRegEx.Execute(strPassword)  
    
    If colMatches.Count = 0 Then
        intStrength = intStrength - 1
        txt_Results.Value = txt_Results.Value & "No lowercase characters found." & vbCRLF
    End If
    
    ' Make sure that the password includes at least one symbol
    
    objRegEx.Pattern = "[^a-zA-Z0-9]"
    Set colMatches   = objRegEx.Execute(strPassword)  
    
    If colMatches.Count = 0 Then
        intStrength = intStrength - 1
        txt_Results.Value = txt_Results.Value & "No symbols found." & vbCRLF
    End If
    
    ' Make sure that the password includes at least one Unicode character
    
    objRegEx.Pattern = "[\x00-\x09]|[\x0B-\x0C]|[\x0E-\x1F]|[\u007f-\uffff]"
    Set colMatches   = objRegEx.Execute(strPassword)  
    
    If colMatches.Count = 0 Then
        intStrength = intStrength - 1
        txt_Results.Value = txt_Results.Value & "No Unicode characters found." & vbCRLF
    End If
    
    if intStrength => 3 then
        txt_Results.Value = "Congratulations!" & vbCRLF & "The password you typed has met all the complexity requirements."
    else
        txt_Results.Value = txt_Results.Value & vbCRLF & "Your password did not meet the complexity requirments, listed above are reasons why."
    end if
End Sub
 
</script>
<body>
<h3>Password Requirements:</h3>
<p>Your password needs to be;
<ul>
	<li>at least 6 characters long,</li>
	<li>does not contain 3 or more characters from the user accounts name, </li>
	<li>and contains 3 of the 5 following criteria:</li>
	<ul>
		<li>Uppercase letters (A-Z)</li>
		<li>Lowercase letters (a-z)</li>
		<li>Numbers (0-9)</li>
		<li>Non-alphanumeric (eg !, @, #, $, % etc)</li>
		<li>Unicode characters</li>
	</ul>
</ul>
</p>
<table>
<tr>
<td><b>Test your password:</b> <input type="password" size="20" id="txt_Password" name="txt_Password">
<input type="Submit" id="btn_test" name="btn_test">
<br><br>
Results:<br>
<textarea rows="10" cols="48" id="txt_Results" name="txt_Results">
 
</textarea>
</body>
</html>

Open in new window

0

Featured Post

Prep for the ITIL® Foundation Certification Exam

December’s Course of the Month is now available! Enroll to learn ITIL® Foundation best practices for delivering IT services effectively and efficiently.

  • 2
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now