Solved

HTA for resetting account password

Posted on 2009-03-30
22
2,250 Views
Last Modified: 2012-05-06
Hi,

I have a script which will enabled the account, reset the password and display the password and disable the account

can this be integrated into a good looking HTA?

The password is generated by a random script and i would like the password to be displayed in the HTA in a text box so that they copy and use it

1. HTA should have runas option to run the script with a different account
2. HTA should have the text box to display the random password in the text box
3. HTA should run the script on particular domain controller when the script is run
4. HTA should give status of account enabled, password reset
0
Comment
Question by:chandru_sol
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 14
  • 7
22 Comments
 
LVL 14

Expert Comment

by:rejoinder
ID: 24042658
To get the ball rolling, can you post the code you are using to create the password, reset accounts etc.  Those can be reused in the HTA.

Thank you.
0
 
LVL 12

Author Comment

by:chandru_sol
ID: 24045385
Here is the code...
'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 < 1
 
	AddChr = Int((UCaseChrMax - UCaseChrMin + 1) * Rnd() + UCaseChrMin)
	NewPW = NewPW & Chr(AddChr)
	PWLen = PWLen + 1
 
	'WScript.Echo AddChr
	'WScript.Echo NewPW
		
Loop
 
Do While PWLen1 < 6
 
	AddChr = Int((LCaseChrMax - LCaseChrMin + 1) * Rnd() + LCaseChrMin)
	NewPW = NewPW & Chr(AddChr)
	PWLen1 = PWLen1 + 1
 
	'WScript.Echo AddChr
	'WScript.Echo NewPW
		
Loop
 
Do While PWLen2 < 0
 
	AddChr = Int((SpecialChrMax - SpecialChrMin + 1) * Rnd() + SpecialChrMin)
	NewPW = NewPW & Chr(AddChr)
	PWLen2 = PWLen2 + 1
 
	'WScript.Echo AddChr
	'WScript.Echo NewPW
		
Loop
 
Do While PWLen3 < 2
 
	AddChr = Int((NumberMax - NumberMin + 1) * Rnd() + NumberMin)
	NewPW = NewPW & Chr(AddChr)
	PWLen3 = PWLen3 + 1
 
	'WScript.Echo AddChr
	'WScript.Echo NewPW
		
Loop
 
Do While PWLen4 < 0
 
	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) < 9
 
	Value = Int((8 - 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)
WScript.Echo "Final Password is           " & FinalPW
 
Dim retval
 
retval = MsgBox("Username" & " legacyexchangeDN is this: " & FinalPW & VbCrLf & VbCrLf &_
"Send Password to the clipboard?",vbYesNo+vbInformation+vbDefaultButton2,"OU Name")
 
If retval = vbYes Then	'Use IE for clipboard
	Dim objIE
	Set objIE = CreateObject("InternetExplorer.Application")
	objIE.Navigate("about:blank")
	'Note : intead of CRLF to save space
	Do Until objIE.ReadyState=4: WScript.Sleep 1: Loop
	objIE.Document.ParentWindow.ClipboardData.SetData "Text", FinalPW
	objIE.Quit
End If 
 
' ResetPassword.vbs
Dim objRootDSE, strDNSDomain, objTrans, strNetBIOSDomain
Dim strUserDN, objUser, strPassword, strUserNTName
 
' Constants for the NameTranslate object.
Const ADS_NAME_INITTYPE_GC = 3
Const ADS_NAME_TYPE_NT4 = 3
Const ADS_NAME_TYPE_1779 = 1
 
'User details
strUserNTName = "Username"
strPassword = FinalPW
 
' Determine DNS domain name from RootDSE object.
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("defaultNamingContext")
 
' Use the NameTranslate object to find the NetBIOS domain name from the
' DNS domain name.
Set objTrans = CreateObject("NameTranslate")
objTrans.Init ADS_NAME_INITTYPE_GC, ""
objTrans.Set ADS_NAME_TYPE_1779, strDNSDomain
strNetBIOSDomain = objTrans.Get(ADS_NAME_TYPE_NT4)
' Remove trailing backslash.
strNetBIOSDomain = Left(strNetBIOSDomain, Len(strNetBIOSDomain) - 1)
 
' Use the NameTranslate object to convert the NT user name to the
' Distinguished Name required for the LDAP provider.
On Error Resume Next
objTrans.Set ADS_NAME_TYPE_NT4, strNetBIOSDomain & "\" & strUserNTName
If (Err.Number <> 0) Then
    On Error GoTo 0
    Wscript.Echo "User " & strUserNTName _
        & " not found in Active Directory"
    Wscript.Echo "Program aborted"
    Wscript.Quit
End If
strUserDN = objTrans.Get(ADS_NAME_TYPE_1779)
' Escape any forward slash characters, "/", with the backslash
' escape character. All other characters that should be escaped are.
strUserDN = Replace(strUserDN, "/", "\/")
 
' Bind to the user object in Active Directory with the LDAP provider.
On Error Resume Next
Set objUser = GetObject("LDAP://" & strUserDN)
If (Err.Number <> 0) Then
    On Error GoTo 0
    Wscript.Echo "User " & strUserNTName _
        & " not found in Active Directory"
    Wscript.Echo "Program aborted"
    Wscript.Quit
End If
objUser.SetPassword strPassword
'wscript.echo err.Number
If (Err.Number <> 0) Then
    On Error GoTo 0
    Wscript.Echo "Password NOT reset for " &vbCrLf & strUserNTName
    Wscript.Echo "Password " & strPassword & " may not be allowed, or"
    Wscript.Echo "this client may not support a SSL connection."
    Wscript.Echo "Program aborted"
    Wscript.Quit
Else
    objUser.AccountDisabled = False
    objUser.Put "pwdLastSet", 0
    Err.Clear
    objUser.SetInfo
    If (Err.Number <> 0) Then
        On Error GoTo 0
        Wscript.Echo "Password reset for " & strUserNTName
        Wscript.Echo "But, unable to enable account or expire password"
        Wscript.Quit
    End If
End If
On Error GoTo 0
 
Wscript.Echo "Password reset, account enabled,"
Wscript.Echo "and password expired for user " & strUserNTName
 
Wscript.sleep (1800000)
 
'Disable the account after 30 minutes
'On Error Resume Next
Const ADS_SCOPE_SUBTREE = 2
 
'Determine DNS domain name from RootDSE object.
Set objRootDSE = GetObject("LDAP://RootDSE")
strDomain = objRootDSE.Get("defaultNamingContext")
 
Wscript.echo StrDomain
 
        strAccount = "Username"
                Set objConnection = CreateObject("ADODB.Connection")
                Set objCommand =   CreateObject("ADODB.Command")
                objConnection.Provider = "ADsDSOObject"
                objConnection.Open "Active Directory Provider"
                Set objCommand.ActiveConnection = objConnection
 
                objCommand.Properties("Page Size") = 1000
                objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE 
 
                objCommand.CommandText = "SELECT AdsPath FROM 'LDAP://" & strDomain & _
                        "' WHERE objectCategory='user' AND samaccountname='" & strAccount & "'"  
 
                Set objRecordSet = objCommand.Execute
 
                objRecordSet.MoveFirst
 
                Do Until objRecordSet.EOF
                        strUserPath = objRecordSet.Fields("AdsPath").Value
                        Set objUser = GetObject(strUserPath)
                        objUser.StreetAddress = "Account Disabled--Not Validated."
                        objUser.AccountDisabled = True
                        objUser.SetInfo
                        objRecordSet.MoveNext
                Loop
 
' Clean up.
Set objRootDSE = Nothing
Set objTrans = Nothing
Set objUser = Nothing
 
'Quit
wscript.echo "completed"
Wscript.quit

Open in new window

0
 
LVL 65

Expert Comment

by:RobSampson
ID: 24045649
Hi Chandru, see how you go with this HTA.

All you should need to change is this line:
strPSExecPath = "\\server\share\psexec_194.exe"

if you want the alternate credentials part to work.

Regards,

Rob.
<Html>
<Head>
<Title>Create Universal Distribution Group</Title>
 
<HTA:Application
Caption = Yes
Border = Thick
ShowInTaskBar = Yes
SingleInstance = Yes
MaximizeButton = Yes
MinimizeButton = Yes>
 
<script Language = VBScript>
 
	Dim strHTAPath
 
	Sub Window_OnLoad
		intWidth = 800
		intHeight = 600
		Me.ResizeTo intWidth, intHeight
		Me.MoveTo ((Screen.Width / 2) - (intWidth / 2)),((Screen.Height / 2) - (intHeight / 2))
 
		'Check if this HTA is running under the correct account
		Set wshNetwork = CreateObject("WScript.Network")
		strComputer = wshNetwork.ComputerName
		strCurrentDomain = wshNetwork.UserDomain
		strCurrentUser = wshNetwork.UserName
		strRequiredDomain = "REQUIREDDOMAIN"
		strRequiredUser = "Administrator"
		txt_username.Value = strRequiredDomain & "\" & strRequiredUser
		span_username2.InnerHTML = txt_username.Value
		span_currentuser.InnerHTML = strCurrentDomain & "\" & strCurrentUser
	    If Mid(document.location, 6, 3) = "///" Then
	    	strHTAPath = Mid(Replace(Replace(document.location, "%20", " "), "/", "\"), 9)
	    Else
	    	strHTAPath = Mid(Replace(Replace(document.location, "%20", " "), "/", "\"), 6)
	    End If
		Set objFSO = CreateObject("Scripting.FileSystemObject")
		'If LCase(strRequiredDomain & "\" & strRequiredUser) <> LCase(strCurrentDomain & "\" & strCurrentUser) Then
			'Disable_Controls
		'Else
			'Enable_Controls
		'End If
 	End Sub
 
	Sub Update_UserName2
		span_username2.InnerHTML = txt_username.Value
	End Sub
 
	Sub Disable_Controls
		txt_password.disabled = False
		btn_reload.disabled = False
	End Sub
 
	Sub Enable_Controls
		txt_password.disabled = True
		btn_reload.disabled = True
	End Sub
 
	Sub Reload_HTA
		Set objFSO = CreateObject("Scripting.FileSystemObject")
		Set objShell = CreateObject("WScript.Shell")
		Set wshNetwork = CreateObject("WScript.Network")
		If txt_username.Value <> "" And txt_password.Value <> "" Then
			strComputer = wshNetwork.ComputerName
			strPSExecPath = "\\server\share\psexec_194.exe"
			strCommand = "cmd /c " & objFSO.GetFile(strPSExecPath).ShortPath & " -accepteula \\" & strComputer & " -i -d -u " & txt_username.Value & " -p " & txt_password.Value & " mshta.exe " & objFSO.GetFile(strHTAPath).ShortPath
			'InputBox "Prompt", "Title", strCommand
			objShell.Run strCommand, 0, False
			Window.Close
		Else
			MsgBox "Please enter an alternate username and password to run the HTA as."
		End If
	End Sub
 
	Sub Exit_HTA
		Window.Close
	End Sub
 
	Sub Find_User
		strDisplayName = Get_LDAP_User_Properties("user", "samAccountName", txt_samaccountname.Value, "displayName,adspath")
		If strDisplayName = "," Then
			MsgBox "Could find display name for " & txt_samaccountname.Value
			span_founduser.InnerHTML = " "
			span_useradspath.InnerHTML = " "
		Else
			span_founduser.InnerHTML = Split(strDisplayName, VbCrLf)(0)
			span_useradspath.InnerHTML = Split(strDisplayName, VbCrLf)(1)
		End If
	End Sub
 
	Sub Generate_Password
		'==============================================================================
		' 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 < 1
		 
			AddChr = Int((UCaseChrMax - UCaseChrMin + 1) * Rnd() + UCaseChrMin)
			NewPW = NewPW & Chr(AddChr)
			PWLen = PWLen + 1
		 
			'WScript.Echo AddChr
			'WScript.Echo NewPW
				
		Loop
		 
		Do While PWLen1 < 6
		 
			AddChr = Int((LCaseChrMax - LCaseChrMin + 1) * Rnd() + LCaseChrMin)
			NewPW = NewPW & Chr(AddChr)
			PWLen1 = PWLen1 + 1
		 
			'WScript.Echo AddChr
			'WScript.Echo NewPW
				
		Loop
		 
		Do While PWLen2 < 0
		 
			AddChr = Int((SpecialChrMax - SpecialChrMin + 1) * Rnd() + SpecialChrMin)
			NewPW = NewPW & Chr(AddChr)
			PWLen2 = PWLen2 + 1
		 
			'WScript.Echo AddChr
			'WScript.Echo NewPW
				
		Loop
		 
		Do While PWLen3 < 2
		 
			AddChr = Int((NumberMax - NumberMin + 1) * Rnd() + NumberMin)
			NewPW = NewPW & Chr(AddChr)
			PWLen3 = PWLen3 + 1
		 
			'WScript.Echo AddChr
			'WScript.Echo NewPW
				
		Loop
		 
		Do While PWLen4 < 0
		 
			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) < 9
		 
			Value = Int((8 - 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)
		'WScript.Echo "Final Password is           " & FinalPW
		txt_newpassword.Value = FinalPW
		Dim retval
		 
		retval = MsgBox("Username" & " legacyexchangeDN is this: " & FinalPW & VbCrLf & VbCrLf &_
		"Send Password to the clipboard?",vbYesNo+vbInformation+vbDefaultButton2,"OU Name")
		 
		If retval = vbYes Then	'Use IE for clipboard
			Dim objIE
			Set objIE = CreateObject("InternetExplorer.Application")
			objIE.Navigate("about:blank")
			'Note : intead of CRLF to save space
			Do Until objIE.ReadyState=4: WScript.Sleep 1: Loop
			objIE.Document.ParentWindow.ClipboardData.SetData "Text", FinalPW
			objIE.Quit
		End If 
	End Sub
 
	Sub Reset_User_Password
		' ResetPassword.vbs
		Dim objRootDSE, strDNSDomain, objTrans, strNetBIOSDomain
		Dim strUserDN, objUser, strPassword, strUserNTName
		 
		' Constants for the NameTranslate object.
		Const ADS_NAME_INITTYPE_GC = 3
		Const ADS_NAME_TYPE_NT4 = 3
		Const ADS_NAME_TYPE_1779 = 1
		 
		'User details
		strUserADSPath = span_useradspath.InnerHTML
		strPassword = txt_newpassword.Value
		
		If Trim(strUserADSPath) <> "" And Trim(strPassword) <> "" Then
			' Bind to the user object in Active Directory with the LDAP provider.
			Set objUser = GetObject(strUserADSPath)
			objUser.SetPassword strPassword
			'wscript.echo err.Number
			If (Err.Number <> 0) Then
			    On Error GoTo 0
			    MsgBox "Password NOT reset for " & VbCrLf & span_founduser.InnerHTML & VbCrLf & _
			    	"Password " & strPassword & " may not be allowed, or" & VbCrLf & _
			    	"this client may not support a SSL connection."
			Else
			    objUser.AccountDisabled = False
			    objUser.Put "pwdLastSet", 0
			    objUser.SetInfo
			    If (Err.Number <> 0) Then
			        On Error GoTo 0
			        MsgBox "Password has been reset for " & span_founduser.InnerHTML & VbCrLf & _
			        	"but the accound could not be enabled."
			    End If
			End If
			On Error GoTo 0
			 
			MsgBox "Password reset and account enabled for user " & span_founduser.InnerHTML
		Else
			MsgBox "Password or username incorrect."
		End If
	End Sub
	
	Function Get_LDAP_User_Properties(strObjectType, strSearchField, strObjectToGet, strCommaDelimProps)
	      
	      ' This is a custom function that connects to the Active Directory, and returns the specific
	      ' Active Directory attribute value, of a specific Object.
	      ' strObjectType: usually "User" or "Computer"
	      ' strSearchField: the field by which to seach the AD by. This acts like an SQL Query's WHERE clause.
	      '				It filters the results by the value of strObjectToGet
	      ' strObjectToGet: the value by which the results are filtered by, according the strSearchField.
	      '				For example, if you are searching based on the user account name, strSearchField
	      '				would be "samAccountName", and strObjectToGet would be that speicific account name,
	      '				such as "jsmith".  This equates to "WHERE 'samAccountName' = 'jsmith'"
	      '	strCommaDelimProps: the field from the object to actually return.  For example, if you wanted
	      '				the home folder path, as defined by the AD, for a specific user, this would be
	      '				"homeDirectory".  If you want to return the ADsPath so that you can bind to that
	      '				user and get your own parameters from them, then use "ADsPath" as a return string,
	      '				then bind to the user: Set objUser = GetObject("LDAP://" & strReturnADsPath)
	      
	      ' Now we're checking if the user account passed may have a domain already specified,
	      ' in which case we connect to that domain in AD, instead of the default one.
	      If InStr(strObjectToGet, "\") > 0 Then
	            arrGroupBits = Split(strObjectToGet, "\")
	            strDC = arrGroupBits(0)
	            strDNSDomain = strDC & "/" & "DC=" & Replace(Mid(strDC, InStr(strDC, ".") + 1), ".", ",DC=")
	            strObjectToGet = arrGroupBits(1)
	      Else
	      ' Otherwise we just connect to the default domain
	            Set objRootDSE = GetObject("LDAP://RootDSE")
	            strDNSDomain = objRootDSE.Get("defaultNamingContext")
	      End If
	 
	      strBase = "<LDAP://" & strDNSDomain & ">"
	      ' Setup ADO objects.
	      Set adoCommand = CreateObject("ADODB.Command")
	      Set adoConnection = CreateObject("ADODB.Connection")
	      adoConnection.Provider = "ADsDSOObject"
	      adoConnection.Open "Active Directory Provider"
	      adoCommand.ActiveConnection = adoConnection
	 
	 
	      ' Filter on user objects.
	      'strFilter = "(&(objectCategory=person)(objectClass=user))"
	      strFilter = "(&(objectClass=" & strObjectType & ")(" & strSearchField & "=" & strObjectToGet & "))"
	 
	      ' Comma delimited list of attribute values to retrieve.
	      strAttributes = strCommaDelimProps
	      arrProperties = Split(strCommaDelimProps, ",")
	 
	      ' Construct the LDAP syntax query.
	      strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
	      adoCommand.CommandText = strQuery
	      ' Define the maximum records to return
	      adoCommand.Properties("Page Size") = 100
	      adoCommand.Properties("Timeout") = 30
	      adoCommand.Properties("Cache Results") = False
	 
	      ' Run the query.
	      Set adoRecordset = adoCommand.Execute
	      ' Enumerate the resulting recordset.
	      strReturnVal = ""
	      Do Until adoRecordset.EOF
	          ' Retrieve values and display.    
	          For intCount = LBound(arrProperties) To UBound(arrProperties)
	                If strReturnVal = "" Then
	                      strReturnVal = adoRecordset.Fields(intCount).Value
	                Else
	                      strReturnVal = strReturnVal & VbCrLf & adoRecordset.Fields(intCount).Value
	                End If
	          Next
	          ' Move to the next record in the recordset.
	          adoRecordset.MoveNext
	      Loop
	 
	      ' Clean up.
	      adoRecordset.Close
	      adoConnection.Close
	      Get_LDAP_User_Properties = strReturnVal
	 
	End Function
</script>
<body style="background-color:#B0C4DE;">
	<table width= "90%" border="0" align="center">
		<tr>
			<td align="center" colspan="2">
				<h2>Create Universal Distribution Group</h2>
			</td>
		</tr>
		<tr>
			<td align="left" valign="top">
				<img name="img_logo" id="img_logo" height="100px" width="100px" src="c:\MyLogo.jpg">
			</td>
			<td>
				Script is currently being run as <span id="span_currentuser"></span><br><br>
				Alternate credentials to run as: <input type="text" id="txt_username" name="txt_username" size="50" onkeyup="vbs:Update_username2"><br>
				Enter the password for <span id="span_username2"> </span><br>
				Password: <input type="password" id="txt_password" name="txt_password" size="20">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
				<button name="btn_reload" id="btn_reload" accessKey="l" onclick="vbs:Reload_HTA">Re<u>l</u>oad</button>
				<br><br>
			</td>
		</tr>
		<tr>
			<td colspan="2">
				Enter user login name to find: <input type="text" id="txt_samaccountname" name="txt_samaccountname" size="50">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
				<button name="btn_finduser" id="btn_finduser" accessKey="f" onclick="vbs:Find_User"><u>F</u>ind User</button><br><br>
				User display name found:&nbsp;<span id="span_founduser"> </span><br><br>
			</td>
		</tr>
		<tr>
			<td colspan="2">
				<button name="btn_generatepassword" id="btn_generatepassword" accessKey="g" onclick="vbs:Generate_Password"><u>G</u>enerate Password</button>
				&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<input readonly type="text" id="txt_newpassword" name="txt_newpassword" size="50">
			</td>
		</tr>
		<tr>
			<td colspan="2" align="center">
				<br><br>
				<button name="btn_resetpassword" id="btn_resetpassword" onclick="vbs:Reset_User_Password">Reset User Password</button>
			</td>
		</tr>
	</table>
	<table width= "90%" border="0" align="center">
		<tr align="center">
			<td>
				<button name="btn_exit" id="btn_exit" accessKey="x" onclick="vbs:Exit_HTA">E<u>x</u>it</button><br>
				<font color="#B0C4DE"><span id="span_useradspath"> </span></font>
			</td>
		</tr>
	</table>
</body>
</head>
</html>

Open in new window

0
Online Training Solution

Drastically shorten your training time with WalkMe's advanced online training solution that Guides your trainees to action. Forget about retraining and skyrocket knowledge retention rates.

 
LVL 65

Expert Comment

by:RobSampson
ID: 24045652
Oh, I didn't add the code to run it on a specific domain controller....do you really need that?  Would you want a list to select from, or just hard code one domain controller?

Regards,

Rob.
0
 
LVL 12

Author Comment

by:chandru_sol
ID: 24046155
Can you get a list of domain controllers or if it is not easy a specific domain controllers will be fine

regards
Chandru
0
 
LVL 12

Author Comment

by:chandru_sol
ID: 24046170

Script needs to disable the account after 30 minutes aswell

regards
Chandru
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 24046242
OK, try this.

Regards,

Rob.
<Html>
<Head>
<Title>Reset User Password</Title>
 
<HTA:Application
Caption = Yes
Border = Thick
ShowInTaskBar = Yes
SingleInstance = Yes
MaximizeButton = Yes
MinimizeButton = Yes>
 
<script Language = VBScript>
 
	Dim strHTAPath
 
	Sub Window_OnLoad
		intWidth = 800
		intHeight = 600
		Me.ResizeTo intWidth, intHeight
		Me.MoveTo ((Screen.Width / 2) - (intWidth / 2)),((Screen.Height / 2) - (intHeight / 2))
 
		'Check if this HTA is running under the correct account
		Set wshNetwork = CreateObject("WScript.Network")
		strComputer = wshNetwork.ComputerName
		strCurrentDomain = wshNetwork.UserDomain
		strCurrentUser = wshNetwork.UserName
		strRequiredDomain = "REQUIREDDOMAIN"
		strRequiredUser = "Administrator"
		txt_username.Value = strRequiredDomain & "\" & strRequiredUser
		span_username2.InnerHTML = txt_username.Value
		span_currentuser.InnerHTML = strCurrentDomain & "\" & strCurrentUser
	    If Mid(document.location, 6, 3) = "///" Then
	    	strHTAPath = Mid(Replace(Replace(document.location, "%20", " "), "/", "\"), 9)
	    Else
	    	strHTAPath = Mid(Replace(Replace(document.location, "%20", " "), "/", "\"), 6)
	    End If
		Set objFSO = CreateObject("Scripting.FileSystemObject")
		'If LCase(strRequiredDomain & "\" & strRequiredUser) <> LCase(strCurrentDomain & "\" & strCurrentUser) Then
			'Disable_Controls
		'Else
			'Enable_Controls
		'End If
		Load_Domain_Controller_List
 	End Sub
 
	Sub Load_Domain_Controller_List
		' Use ADO to search Active Directory for ObjectClass nTDSDSA.
		' This will identify all Domain Controllers.
		Set objRootDSE = GetObject("LDAP://RootDSE")
		strConfig = objRootDSE.Get("configurationNamingContext")
		Set adoCommand = CreateObject("ADODB.Command")
		Set adoConnection = CreateObject("ADODB.Connection")
		adoConnection.Provider = "ADsDSOObject"
		adoConnection.Open "Active Directory Provider"
		adoCommand.ActiveConnection = adoConnection
		
		strBase = "<LDAP://" & strConfig & ">"
		strFilter = "(objectClass=nTDSDSA)"
		strAttributes = "AdsPath"
		strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
		
		adoCommand.CommandText = strQuery
		adoCommand.Properties("Page Size") = 100
		adoCommand.Properties("Timeout") = 60
		adoCommand.Properties("Cache Results") = False
		
		Set adoRecordset = adoCommand.Execute
		
		' Enumerate parent objects of class nTDSDSA. Save Domain Controller
		' AdsPaths in dynamic array arrstrDCs.
		
		Dim strDetails
		
		Do Until adoRecordset.EOF
		    Set objDC = GetObject(GetObject(adoRecordset.Fields("AdsPath").Value).Parent)
			Set objActiveOption = Document.CreateElement("OPTION")
			objActiveOption.Text = objDC.DNSHostName
		    objActiveOption.Value = objDC.DNSHostName
		    lst_domaincontrollers.Add objActiveOption
		    adoRecordset.MoveNext
		Loop
		adoRecordset.Close
	End Sub
 
	Sub Update_UserName2
		span_username2.InnerHTML = txt_username.Value
	End Sub
 
	Sub Disable_Controls
		txt_password.disabled = False
		btn_reload.disabled = False
	End Sub
 
	Sub Enable_Controls
		txt_password.disabled = True
		btn_reload.disabled = True
	End Sub
 
	Sub Reload_HTA
		Set objFSO = CreateObject("Scripting.FileSystemObject")
		Set objShell = CreateObject("WScript.Shell")
		Set wshNetwork = CreateObject("WScript.Network")
		If txt_username.Value <> "" And txt_password.Value <> "" Then
			strComputer = wshNetwork.ComputerName
			strPSExecPath = "\\server\share\psexec_194.exe"
			strCommand = "cmd /c " & objFSO.GetFile(strPSExecPath).ShortPath & " -accepteula \\" & strComputer & " -i -d -u " & txt_username.Value & " -p " & txt_password.Value & " mshta.exe " & objFSO.GetFile(strHTAPath).ShortPath
			'InputBox "Prompt", "Title", strCommand
			objShell.Run strCommand, 0, False
			Window.Close
		Else
			MsgBox "Please enter an alternate username and password to run the HTA as."
		End If
	End Sub
 
	Sub Exit_HTA
		Window.Close
	End Sub
 
	Sub Find_User
		strDisplayName = Get_LDAP_User_Properties("user", "samAccountName", txt_samaccountname.Value, "displayName,distinguishedName")
		If strDisplayName = "," Then
			MsgBox "Could find display name for " & txt_samaccountname.Value
			span_founduser.InnerHTML = " "
			span_userdn.InnerHTML = " "
		Else
			span_founduser.InnerHTML = Split(strDisplayName, VbCrLf)(0)
			span_userdn.InnerHTML = Split(strDisplayName, VbCrLf)(1)
		End If
	End Sub
 
	Sub Generate_Password
		'==============================================================================
		' 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 < 1
		 
			AddChr = Int((UCaseChrMax - UCaseChrMin + 1) * Rnd() + UCaseChrMin)
			NewPW = NewPW & Chr(AddChr)
			PWLen = PWLen + 1
		 
			'WScript.Echo AddChr
			'WScript.Echo NewPW
				
		Loop
		 
		Do While PWLen1 < 6
		 
			AddChr = Int((LCaseChrMax - LCaseChrMin + 1) * Rnd() + LCaseChrMin)
			NewPW = NewPW & Chr(AddChr)
			PWLen1 = PWLen1 + 1
		 
			'WScript.Echo AddChr
			'WScript.Echo NewPW
				
		Loop
		 
		Do While PWLen2 < 0
		 
			AddChr = Int((SpecialChrMax - SpecialChrMin + 1) * Rnd() + SpecialChrMin)
			NewPW = NewPW & Chr(AddChr)
			PWLen2 = PWLen2 + 1
		 
			'WScript.Echo AddChr
			'WScript.Echo NewPW
				
		Loop
		 
		Do While PWLen3 < 2
		 
			AddChr = Int((NumberMax - NumberMin + 1) * Rnd() + NumberMin)
			NewPW = NewPW & Chr(AddChr)
			PWLen3 = PWLen3 + 1
		 
			'WScript.Echo AddChr
			'WScript.Echo NewPW
				
		Loop
		 
		Do While PWLen4 < 0
		 
			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) < 9
		 
			Value = Int((8 - 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)
		'WScript.Echo "Final Password is           " & FinalPW
		txt_newpassword.Value = FinalPW
		Dim retval
		 
		retval = MsgBox("Username" & " legacyexchangeDN is this: " & FinalPW & VbCrLf & VbCrLf &_
		"Send Password to the clipboard?",vbYesNo+vbInformation+vbDefaultButton2,"OU Name")
		 
		If retval = vbYes Then	'Use IE for clipboard
			Dim objIE
			Set objIE = CreateObject("InternetExplorer.Application")
			objIE.Navigate("about:blank")
			'Note : intead of CRLF to save space
			Do Until objIE.ReadyState=4: WScript.Sleep 1: Loop
			objIE.Document.ParentWindow.ClipboardData.SetData "Text", FinalPW
			objIE.Quit
		End If 
	End Sub
 
	Sub Reset_User_Password
		' ResetPassword.vbs
		Dim objRootDSE, strDNSDomain, objTrans, strNetBIOSDomain
		Dim strUserDN, objUser, strPassword, strUserNTName
		 
		' Constants for the NameTranslate object.
		Const ADS_NAME_INITTYPE_GC = 3
		Const ADS_NAME_TYPE_NT4 = 3
		Const ADS_NAME_TYPE_1779 = 1
		 
		'User details
		strUserDN= span_userdn.InnerHTML
		strPassword = txt_newpassword.Value
		
		If Trim(strUserDN) <> "" And Trim(strPassword) <> "" Then
			' Bind to the user object in Active Directory with the LDAP provider.
			Set objUser = GetObject("LDAP://" & lst_domaincontrollers.value & "/" & strUserDN)
			objUser.SetPassword strPassword
			'wscript.echo err.Number
			If (Err.Number <> 0) Then
			    On Error GoTo 0
			    MsgBox "Password NOT reset for " & VbCrLf & span_founduser.InnerHTML & VbCrLf & _
			    	"Password " & strPassword & " may not be allowed, or" & VbCrLf & _
			    	"this client may not support a SSL connection."
			Else
			    objUser.AccountDisabled = False
			    objUser.Put "pwdLastSet", 0
			    objUser.SetInfo
			    If (Err.Number <> 0) Then
			        On Error GoTo 0
			        MsgBox "Password has been reset for " & span_founduser.InnerHTML & VbCrLf & _
			        	"but the accound could not be enabled."
			    End If
			End If
			On Error GoTo 0
			 
			MsgBox "Password reset and account enabled for user " & span_founduser.InnerHTML
		Else
			MsgBox "Password or username incorrect."
		End If
 
		HTASleep 1800
		 
		'Disable the account after 30 minutes
		'On Error Resume Next
		Set objUser = GetObject("LDAP://" & lst_domaincontrollers.value & "/" & strUserDN)
		objUser.StreetAddress = "Account Disabled--Not Validated."
		objUser.AccountDisabled = True
		objUser.SetInfo
		
		MsgBox strUserDN & " has now been disabled."
	End Sub
 
	Sub HTASleep(intSeconds)
		Set objShell = CreateObject("WScript.Shell")
		objShell.Run "ping 127.0.0.1 -n " & intSeconds + 1, 0, True
	End Sub
 
	Function Get_LDAP_User_Properties(strObjectType, strSearchField, strObjectToGet, strCommaDelimProps)
	      
	      ' This is a custom function that connects to the Active Directory, and returns the specific
	      ' Active Directory attribute value, of a specific Object.
	      ' strObjectType: usually "User" or "Computer"
	      ' strSearchField: the field by which to seach the AD by. This acts like an SQL Query's WHERE clause.
	      '				It filters the results by the value of strObjectToGet
	      ' strObjectToGet: the value by which the results are filtered by, according the strSearchField.
	      '				For example, if you are searching based on the user account name, strSearchField
	      '				would be "samAccountName", and strObjectToGet would be that speicific account name,
	      '				such as "jsmith".  This equates to "WHERE 'samAccountName' = 'jsmith'"
	      '	strCommaDelimProps: the field from the object to actually return.  For example, if you wanted
	      '				the home folder path, as defined by the AD, for a specific user, this would be
	      '				"homeDirectory".  If you want to return the ADsPath so that you can bind to that
	      '				user and get your own parameters from them, then use "ADsPath" as a return string,
	      '				then bind to the user: Set objUser = GetObject("LDAP://" & strReturnADsPath)
	      
	      ' Now we're checking if the user account passed may have a domain already specified,
	      ' in which case we connect to that domain in AD, instead of the default one.
	      If InStr(strObjectToGet, "\") > 0 Then
	            arrGroupBits = Split(strObjectToGet, "\")
	            strDC = arrGroupBits(0)
	            strDNSDomain = strDC & "/" & "DC=" & Replace(Mid(strDC, InStr(strDC, ".") + 1), ".", ",DC=")
	            strObjectToGet = arrGroupBits(1)
	      Else
	      ' Otherwise we just connect to the default domain
	            Set objRootDSE = GetObject("LDAP://RootDSE")
	            strDNSDomain = objRootDSE.Get("defaultNamingContext")
	      End If
	 
	      strBase = "<LDAP://" & strDNSDomain & ">"
	      ' Setup ADO objects.
	      Set adoCommand = CreateObject("ADODB.Command")
	      Set adoConnection = CreateObject("ADODB.Connection")
	      adoConnection.Provider = "ADsDSOObject"
	      adoConnection.Open "Active Directory Provider"
	      adoCommand.ActiveConnection = adoConnection
	 
	 
	      ' Filter on user objects.
	      'strFilter = "(&(objectCategory=person)(objectClass=user))"
	      strFilter = "(&(objectClass=" & strObjectType & ")(" & strSearchField & "=" & strObjectToGet & "))"
	 
	      ' Comma delimited list of attribute values to retrieve.
	      strAttributes = strCommaDelimProps
	      arrProperties = Split(strCommaDelimProps, ",")
	 
	      ' Construct the LDAP syntax query.
	      strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
	      adoCommand.CommandText = strQuery
	      ' Define the maximum records to return
	      adoCommand.Properties("Page Size") = 100
	      adoCommand.Properties("Timeout") = 30
	      adoCommand.Properties("Cache Results") = False
	 
	      ' Run the query.
	      Set adoRecordset = adoCommand.Execute
	      ' Enumerate the resulting recordset.
	      strReturnVal = ""
	      Do Until adoRecordset.EOF
	          ' Retrieve values and display.    
	          For intCount = LBound(arrProperties) To UBound(arrProperties)
	                If strReturnVal = "" Then
	                      strReturnVal = adoRecordset.Fields(intCount).Value
	                Else
	                      strReturnVal = strReturnVal & VbCrLf & adoRecordset.Fields(intCount).Value
	                End If
	          Next
	          ' Move to the next record in the recordset.
	          adoRecordset.MoveNext
	      Loop
	 
	      ' Clean up.
	      adoRecordset.Close
	      adoConnection.Close
	      Get_LDAP_User_Properties = strReturnVal
	 
	End Function
</script>
<body style="background-color:#B0C4DE;">
	<table width= "90%" border="0" align="center">
		<tr>
			<td align="center" colspan="2">
				<h2>Reset User Password</h2>
			</td>
		</tr>
		<tr>
			<td align="left" valign="top">
				<img name="img_logo" id="img_logo" height="100px" width="100px" src="c:\MyLogo.jpg">
			</td>
			<td>
				Script is currently being run as <span id="span_currentuser"></span><br><br>
				Alternate credentials to run as: <input type="text" id="txt_username" name="txt_username" size="50" onkeyup="vbs:Update_username2"><br>
				Enter the password for <span id="span_username2"> </span><br>
				Password: <input type="password" id="txt_password" name="txt_password" size="20">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
				<button name="btn_reload" id="btn_reload" accessKey="l" onclick="vbs:Reload_HTA">Re<u>l</u>oad</button>
				<br><br>
			</td>
		</tr>
		<tr>
			<td colspan="2">
				Enter user login name to find: <input type="text" id="txt_samaccountname" name="txt_samaccountname" size="50">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
				<button name="btn_finduser" id="btn_finduser" accessKey="f" onclick="vbs:Find_User"><u>F</u>ind User</button><br><br>
				User display name found:&nbsp;<span id="span_founduser"> </span><br><br>
			</td>
		</tr>
		<tr>
			<td colspan="2">
				<button name="btn_generatepassword" id="btn_generatepassword" accessKey="g" onclick="vbs:Generate_Password"><u>G</u>enerate Password</button>
				&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<input readonly type="text" id="txt_newpassword" name="txt_newpassword" size="50">
			</td>
		</tr>
		<tr>
			<td colspan="2">
				Domain controller to reset password on:&nbsp;<select size='1' name='lst_domaincontrollers'></select>
			</td>
		</tr>
		<tr>
			<td colspan="2" align="center">
				<br><br>
				<button name="btn_resetpassword" id="btn_resetpassword" onclick="vbs:Reset_User_Password">Reset User Password</button>
			</td>
		</tr>
	</table>
	<table width= "90%" border="0" align="center">
		<tr align="center">
			<td>
				<button name="btn_exit" id="btn_exit" accessKey="x" onclick="vbs:Exit_HTA">E<u>x</u>it</button><br>
				<font color="#B0C4DE"><span id="span_userdn"> </span></font>
			</td>
		</tr>
	</table>
</body>
</head>
</html>

Open in new window

0
 
LVL 12

Author Comment

by:chandru_sol
ID: 24046326
Thanks Rob!! That worked really well

Domain controller part can you modify to have a single hardcoded one and disabled the list box and if we want we can enable it at a later stage

regards
chandru
0
 
LVL 12

Author Comment

by:chandru_sol
ID: 24046427
Do we need to keep the HTA open for the account to disable after 30 minutes?

regards
Chandru
0
 
LVL 65

Accepted Solution

by:
RobSampson earned 500 total points
ID: 24046633
Hi, the domain has now been hard coded.  You can change this line:
            strSpecificDC = "mymaindc.domain.com"

to point to a specific DC, and any time you want to change it back to the list, just change
            boolDCHardCoded = True

to
            boolDCHardCoded = False

>> Do we need to keep the HTA open for the account to disable after 30 minutes?
You probably do, but I think if you put

            Window.Close

above this line

            HTASleep 1800

It might close the window, but leave MSHTA.exe running in the background. If it does leave it running in the background, then that process will continue to run the rest of the code, and wait half an hour before disabling the account again.

Regards,

Rob.
<Html>
<Head>
<Title>Reset User Password</Title>
 
<HTA:Application
Caption = Yes
Border = Thick
ShowInTaskBar = Yes
SingleInstance = Yes
MaximizeButton = Yes
MinimizeButton = Yes>
 
<script Language = VBScript>
 
	Dim strHTAPath, boolDCHardCoded, strSpecificDC
 
	Sub Window_OnLoad
		intWidth = 800
		intHeight = 600
		Me.ResizeTo intWidth, intHeight
		Me.MoveTo ((Screen.Width / 2) - (intWidth / 2)),((Screen.Height / 2) - (intHeight / 2))
 
		'Check if this HTA is running under the correct account
		Set wshNetwork = CreateObject("WScript.Network")
		strComputer = wshNetwork.ComputerName
		strCurrentDomain = wshNetwork.UserDomain
		strCurrentUser = wshNetwork.UserName
		strRequiredDomain = "REQUIREDDOMAIN"
		strRequiredUser = "Administrator"
		txt_username.Value = strRequiredDomain & "\" & strRequiredUser
		span_username2.InnerHTML = txt_username.Value
		span_currentuser.InnerHTML = strCurrentDomain & "\" & strCurrentUser
	    If Mid(document.location, 6, 3) = "///" Then
	    	strHTAPath = Mid(Replace(Replace(document.location, "%20", " "), "/", "\"), 9)
	    Else
	    	strHTAPath = Mid(Replace(Replace(document.location, "%20", " "), "/", "\"), 6)
	    End If
		Set objFSO = CreateObject("Scripting.FileSystemObject")
		'If LCase(strRequiredDomain & "\" & strRequiredUser) <> LCase(strCurrentDomain & "\" & strCurrentUser) Then
			'Disable_Controls
		'Else
			'Enable_Controls
		'End If
		boolDCHardCoded = True
		strSpecificDC = "mymaindc.domain.com"
		If boolDCHardCoded = False Then
			Load_Domain_Controller_List
		Else
			lst_domaincontrollers.Style.Visibility = "Hidden"
			span_domaincontroller.InnerHTML = strSpecificDC
		End If
 	End Sub
 
	Sub Load_Domain_Controller_List
		' Use ADO to search Active Directory for ObjectClass nTDSDSA.
		' This will identify all Domain Controllers.
		Set objRootDSE = GetObject("LDAP://RootDSE")
		strConfig = objRootDSE.Get("configurationNamingContext")
		Set adoCommand = CreateObject("ADODB.Command")
		Set adoConnection = CreateObject("ADODB.Connection")
		adoConnection.Provider = "ADsDSOObject"
		adoConnection.Open "Active Directory Provider"
		adoCommand.ActiveConnection = adoConnection
		
		strBase = "<LDAP://" & strConfig & ">"
		strFilter = "(objectClass=nTDSDSA)"
		strAttributes = "AdsPath"
		strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
		
		adoCommand.CommandText = strQuery
		adoCommand.Properties("Page Size") = 100
		adoCommand.Properties("Timeout") = 60
		adoCommand.Properties("Cache Results") = False
		
		Set adoRecordset = adoCommand.Execute
		
		' Enumerate parent objects of class nTDSDSA. Save Domain Controller
		' AdsPaths in dynamic array arrstrDCs.
		
		Dim strDetails
		
		Do Until adoRecordset.EOF
		    Set objDC = GetObject(GetObject(adoRecordset.Fields("AdsPath").Value).Parent)
			Set objActiveOption = Document.CreateElement("OPTION")
			objActiveOption.Text = objDC.DNSHostName
		    objActiveOption.Value = objDC.DNSHostName
		    lst_domaincontrollers.Add objActiveOption
		    adoRecordset.MoveNext
		Loop
		adoRecordset.Close
	End Sub
 
	Sub Update_UserName2
		span_username2.InnerHTML = txt_username.Value
	End Sub
 
	Sub Disable_Controls
		txt_password.disabled = False
		btn_reload.disabled = False
	End Sub
 
	Sub Enable_Controls
		txt_password.disabled = True
		btn_reload.disabled = True
	End Sub
 
	Sub Reload_HTA
		Set objFSO = CreateObject("Scripting.FileSystemObject")
		Set objShell = CreateObject("WScript.Shell")
		Set wshNetwork = CreateObject("WScript.Network")
		If txt_username.Value <> "" And txt_password.Value <> "" Then
			strComputer = wshNetwork.ComputerName
			strPSExecPath = "\\server\share\psexec_194.exe"
			strCommand = "cmd /c " & objFSO.GetFile(strPSExecPath).ShortPath & " -accepteula \\" & strComputer & " -i -d -u " & txt_username.Value & " -p " & txt_password.Value & " mshta.exe " & objFSO.GetFile(strHTAPath).ShortPath
			'InputBox "Prompt", "Title", strCommand
			objShell.Run strCommand, 0, False
			Window.Close
		Else
			MsgBox "Please enter an alternate username and password to run the HTA as."
		End If
	End Sub
 
	Sub Exit_HTA
		Window.Close
	End Sub
 
	Sub Find_User
		strDisplayName = Get_LDAP_User_Properties("user", "samAccountName", txt_samaccountname.Value, "displayName,distinguishedName")
		If strDisplayName = "," Then
			MsgBox "Could find display name for " & txt_samaccountname.Value
			span_founduser.InnerHTML = " "
			span_userdn.InnerHTML = " "
		Else
			span_founduser.InnerHTML = Split(strDisplayName, VbCrLf)(0)
			span_userdn.InnerHTML = Split(strDisplayName, VbCrLf)(1)
		End If
	End Sub
 
	Sub Generate_Password
		'==============================================================================
		' 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 < 1
		 
			AddChr = Int((UCaseChrMax - UCaseChrMin + 1) * Rnd() + UCaseChrMin)
			NewPW = NewPW & Chr(AddChr)
			PWLen = PWLen + 1
		 
			'WScript.Echo AddChr
			'WScript.Echo NewPW
				
		Loop
		 
		Do While PWLen1 < 6
		 
			AddChr = Int((LCaseChrMax - LCaseChrMin + 1) * Rnd() + LCaseChrMin)
			NewPW = NewPW & Chr(AddChr)
			PWLen1 = PWLen1 + 1
		 
			'WScript.Echo AddChr
			'WScript.Echo NewPW
				
		Loop
		 
		Do While PWLen2 < 0
		 
			AddChr = Int((SpecialChrMax - SpecialChrMin + 1) * Rnd() + SpecialChrMin)
			NewPW = NewPW & Chr(AddChr)
			PWLen2 = PWLen2 + 1
		 
			'WScript.Echo AddChr
			'WScript.Echo NewPW
				
		Loop
		 
		Do While PWLen3 < 2
		 
			AddChr = Int((NumberMax - NumberMin + 1) * Rnd() + NumberMin)
			NewPW = NewPW & Chr(AddChr)
			PWLen3 = PWLen3 + 1
		 
			'WScript.Echo AddChr
			'WScript.Echo NewPW
				
		Loop
		 
		Do While PWLen4 < 0
		 
			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) < 9
		 
			Value = Int((8 - 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)
		'WScript.Echo "Final Password is           " & FinalPW
		txt_newpassword.Value = FinalPW
		Dim retval
		 
		retval = MsgBox("Username" & " legacyexchangeDN is this: " & FinalPW & VbCrLf & VbCrLf &_
		"Send Password to the clipboard?",vbYesNo+vbInformation+vbDefaultButton2,"OU Name")
		 
		If retval = vbYes Then	'Use IE for clipboard
			Dim objIE
			Set objIE = CreateObject("InternetExplorer.Application")
			objIE.Navigate("about:blank")
			'Note : intead of CRLF to save space
			Do Until objIE.ReadyState=4: WScript.Sleep 1: Loop
			objIE.Document.ParentWindow.ClipboardData.SetData "Text", FinalPW
			objIE.Quit
		End If 
	End Sub
 
	Sub Reset_User_Password
		' ResetPassword.vbs
		Dim objRootDSE, strDNSDomain, objTrans, strNetBIOSDomain
		Dim strUserDN, objUser, strPassword, strUserNTName
		 
		' Constants for the NameTranslate object.
		Const ADS_NAME_INITTYPE_GC = 3
		Const ADS_NAME_TYPE_NT4 = 3
		Const ADS_NAME_TYPE_1779 = 1
		 
		'User details
		strUserDN= span_userdn.InnerHTML
		strPassword = txt_newpassword.Value
		
		If Trim(strUserDN) <> "" And Trim(strPassword) <> "" Then
			' Bind to the user object in Active Directory with the LDAP provider.
			If boolDCHardCoded = True Then
				Set objUser = GetObject("LDAP://" & strSpecificDC & "/" & strUserDN)
			Else
				Set objUser = GetObject("LDAP://" & lst_domaincontrollers.value & "/" & strUserDN)
			End If
			objUser.SetPassword strPassword
			'wscript.echo err.Number
			If (Err.Number <> 0) Then
			    On Error GoTo 0
			    MsgBox "Password NOT reset for " & VbCrLf & span_founduser.InnerHTML & VbCrLf & _
			    	"Password " & strPassword & " may not be allowed, or" & VbCrLf & _
			    	"this client may not support a SSL connection."
			Else
			    objUser.AccountDisabled = False
			    objUser.Put "pwdLastSet", 0
			    objUser.SetInfo
			    If (Err.Number <> 0) Then
			        On Error GoTo 0
			        MsgBox "Password has been reset for " & span_founduser.InnerHTML & VbCrLf & _
			        	"but the accound could not be enabled."
			    End If
			End If
			On Error GoTo 0
			 
			MsgBox "Password reset and account enabled for user " & span_founduser.InnerHTML
		Else
			MsgBox "Password or username incorrect."
		End If
 
		HTASleep 1800
		 
		'Disable the account after 30 minutes
		'On Error Resume Next
		If boolDCHardCoded = True Then
			Set objUser = GetObject("LDAP://" & strSpecificDC & "/" & strUserDN)
		Else
			Set objUser = GetObject("LDAP://" & lst_domaincontrollers.value & "/" & strUserDN)
		End If
		objUser.StreetAddress = "Account Disabled--Not Validated."
		objUser.AccountDisabled = True
		objUser.SetInfo
		
		MsgBox strUserDN & " has now been disabled."
	End Sub
 
	Sub HTASleep(intSeconds)
		Set objShell = CreateObject("WScript.Shell")
		objShell.Run "ping 127.0.0.1 -n " & intSeconds + 1, 0, True
	End Sub
 
	Function Get_LDAP_User_Properties(strObjectType, strSearchField, strObjectToGet, strCommaDelimProps)
	      
	      ' This is a custom function that connects to the Active Directory, and returns the specific
	      ' Active Directory attribute value, of a specific Object.
	      ' strObjectType: usually "User" or "Computer"
	      ' strSearchField: the field by which to seach the AD by. This acts like an SQL Query's WHERE clause.
	      '				It filters the results by the value of strObjectToGet
	      ' strObjectToGet: the value by which the results are filtered by, according the strSearchField.
	      '				For example, if you are searching based on the user account name, strSearchField
	      '				would be "samAccountName", and strObjectToGet would be that speicific account name,
	      '				such as "jsmith".  This equates to "WHERE 'samAccountName' = 'jsmith'"
	      '	strCommaDelimProps: the field from the object to actually return.  For example, if you wanted
	      '				the home folder path, as defined by the AD, for a specific user, this would be
	      '				"homeDirectory".  If you want to return the ADsPath so that you can bind to that
	      '				user and get your own parameters from them, then use "ADsPath" as a return string,
	      '				then bind to the user: Set objUser = GetObject("LDAP://" & strReturnADsPath)
	      
	      ' Now we're checking if the user account passed may have a domain already specified,
	      ' in which case we connect to that domain in AD, instead of the default one.
	      If InStr(strObjectToGet, "\") > 0 Then
	            arrGroupBits = Split(strObjectToGet, "\")
	            strDC = arrGroupBits(0)
	            strDNSDomain = strDC & "/" & "DC=" & Replace(Mid(strDC, InStr(strDC, ".") + 1), ".", ",DC=")
	            strObjectToGet = arrGroupBits(1)
	      Else
	      ' Otherwise we just connect to the default domain
	            Set objRootDSE = GetObject("LDAP://RootDSE")
	            strDNSDomain = objRootDSE.Get("defaultNamingContext")
	      End If
	 
	      strBase = "<LDAP://" & strDNSDomain & ">"
	      ' Setup ADO objects.
	      Set adoCommand = CreateObject("ADODB.Command")
	      Set adoConnection = CreateObject("ADODB.Connection")
	      adoConnection.Provider = "ADsDSOObject"
	      adoConnection.Open "Active Directory Provider"
	      adoCommand.ActiveConnection = adoConnection
	 
	 
	      ' Filter on user objects.
	      'strFilter = "(&(objectCategory=person)(objectClass=user))"
	      strFilter = "(&(objectClass=" & strObjectType & ")(" & strSearchField & "=" & strObjectToGet & "))"
	 
	      ' Comma delimited list of attribute values to retrieve.
	      strAttributes = strCommaDelimProps
	      arrProperties = Split(strCommaDelimProps, ",")
	 
	      ' Construct the LDAP syntax query.
	      strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
	      adoCommand.CommandText = strQuery
	      ' Define the maximum records to return
	      adoCommand.Properties("Page Size") = 100
	      adoCommand.Properties("Timeout") = 30
	      adoCommand.Properties("Cache Results") = False
	 
	      ' Run the query.
	      Set adoRecordset = adoCommand.Execute
	      ' Enumerate the resulting recordset.
	      strReturnVal = ""
	      Do Until adoRecordset.EOF
	          ' Retrieve values and display.    
	          For intCount = LBound(arrProperties) To UBound(arrProperties)
	                If strReturnVal = "" Then
	                      strReturnVal = adoRecordset.Fields(intCount).Value
	                Else
	                      strReturnVal = strReturnVal & VbCrLf & adoRecordset.Fields(intCount).Value
	                End If
	          Next
	          ' Move to the next record in the recordset.
	          adoRecordset.MoveNext
	      Loop
	 
	      ' Clean up.
	      adoRecordset.Close
	      adoConnection.Close
	      Get_LDAP_User_Properties = strReturnVal
	 
	End Function
</script>
<body style="background-color:#B0C4DE;">
	<table width= "90%" border="0" align="center">
		<tr>
			<td align="center" colspan="2">
				<h2>Reset User Password</h2>
			</td>
		</tr>
		<tr>
			<td align="left" valign="top">
				<img name="img_logo" id="img_logo" height="100px" width="100px" src="c:\MyLogo.jpg">
			</td>
			<td>
				Script is currently being run as <span id="span_currentuser"></span><br><br>
				Alternate credentials to run as: <input type="text" id="txt_username" name="txt_username" size="50" onkeyup="vbs:Update_username2"><br>
				Enter the password for <span id="span_username2"> </span><br>
				Password: <input type="password" id="txt_password" name="txt_password" size="20">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
				<button name="btn_reload" id="btn_reload" accessKey="l" onclick="vbs:Reload_HTA">Re<u>l</u>oad</button>
				<br><br>
			</td>
		</tr>
		<tr>
			<td colspan="2">
				Enter user login name to find: <input type="text" id="txt_samaccountname" name="txt_samaccountname" size="50">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
				<button name="btn_finduser" id="btn_finduser" accessKey="f" onclick="vbs:Find_User"><u>F</u>ind User</button><br><br>
				User display name found:&nbsp;<span id="span_founduser"> </span><br><br>
			</td>
		</tr>
		<tr>
			<td colspan="2">
				<button name="btn_generatepassword" id="btn_generatepassword" accessKey="g" onclick="vbs:Generate_Password"><u>G</u>enerate Password</button>
				&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<input readonly type="text" id="txt_newpassword" name="txt_newpassword" size="50">
			</td>
		</tr>
		<tr>
			<td colspan="2">
				Domain controller to reset password on:&nbsp;<span id="span_domaincontroller"></span><select size='1' name='lst_domaincontrollers'></select>
			</td>
		</tr>
		<tr>
			<td colspan="2" align="center">
				<br><br>
				<button name="btn_resetpassword" id="btn_resetpassword" onclick="vbs:Reset_User_Password">Reset User Password</button>
			</td>
		</tr>
	</table>
	<table width= "90%" border="0" align="center">
		<tr align="center">
			<td>
				<button name="btn_exit" id="btn_exit" accessKey="x" onclick="vbs:Exit_HTA">E<u>x</u>it</button><br>
				<font color="#B0C4DE"><span id="span_userdn"> </span></font>
			</td>
		</tr>
	</table>
</body>
</head>
</html>

Open in new window

0
 
LVL 12

Author Comment

by:chandru_sol
ID: 24046736
Thanks Rob!!

You helped me again

regards
Chandru
0
 
LVL 12

Author Closing Comment

by:chandru_sol
ID: 31564632
Thanks again!!
0
 
LVL 12

Author Comment

by:chandru_sol
ID: 24046798
Rob,

When i use window.close the MSHTA.exe is not running on the background

is there anyother way that the HTA is closed by the account is disabled after 30 minutes?


regards
Chandru
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 24046827
Only if were to write a VBScript that would have to run in the background. The HTA could then close, and the VBScript would "pause" for half an hour before doing anything....

If you would like it to do that, I can write that in tomorrow, but if the process is killed (or the computer is logged off or shut down) the account would not get disabled.

Regards,

Rob.
0
 
LVL 12

Author Comment

by:chandru_sol
ID: 24051850
Can you help me with this way of script?

I would like to hardcode the user aswell and have the existing feature aswell available in case if we need to change it at a later stage

regards
Chandru
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 24055883
OK, this should do it.  You will now see a WScript.exe process running after you reset the password.  That script will disable the account after 30 minutes.  The user can also be hardcoded with

            boolHardCodedUser = True
            strSpecificUser = "testuser"

Regards,

Rob.
<Html>
<Head>
<Title>Reset User Password</Title>
 
<HTA:Application
Caption = Yes
Border = Thick
ShowInTaskBar = Yes
SingleInstance = Yes
MaximizeButton = Yes
MinimizeButton = Yes>
 
<script Language = VBScript>
 
	Dim strHTAPath, boolDCHardCodedDC, boolHardCodedUser, strSpecificDC
 
	Sub Window_OnLoad
		intWidth = 800
		intHeight = 600
		Me.ResizeTo intWidth, intHeight
		Me.MoveTo ((Screen.Width / 2) - (intWidth / 2)),((Screen.Height / 2) - (intHeight / 2))
 
		'Check if this HTA is running under the correct account
		Set wshNetwork = CreateObject("WScript.Network")
		strComputer = wshNetwork.ComputerName
		strCurrentDomain = wshNetwork.UserDomain
		strCurrentUser = wshNetwork.UserName
		strRequiredDomain = "REQUIREDDOMAIN"
		strRequiredUser = "Administrator"
		txt_username.Value = strRequiredDomain & "\" & strRequiredUser
		span_username2.InnerHTML = txt_username.Value
		span_currentuser.InnerHTML = strCurrentDomain & "\" & strCurrentUser
	    If Mid(document.location, 6, 3) = "///" Then
	    	strHTAPath = Mid(Replace(Replace(document.location, "%20", " "), "/", "\"), 9)
	    Else
	    	strHTAPath = Mid(Replace(Replace(document.location, "%20", " "), "/", "\"), 6)
	    End If
		Set objFSO = CreateObject("Scripting.FileSystemObject")
		'If LCase(strRequiredDomain & "\" & strRequiredUser) <> LCase(strCurrentDomain & "\" & strCurrentUser) Then
			'Disable_Controls
		'Else
			'Enable_Controls
		'End If
		boolDCHardCodedDC = True
		strSpecificDC = "mymaindc.domain.com"
		boolHardCodedUser = True
		strSpecificUser = "testuser"
		If boolDCHardCodedDC = False Then
			Load_Domain_Controller_List
		Else
			lst_domaincontrollers.Style.Visibility = "Hidden"
			span_domaincontroller.InnerHTML = strSpecificDC
		End If
		If boolHardCodedUser = True Then
			txt_samaccountname.Value = strSpecificUser
			btn_finduser.Click
		End If
 	End Sub
 
	Sub Load_Domain_Controller_List
		' Use ADO to search Active Directory for ObjectClass nTDSDSA.
		' This will identify all Domain Controllers.
		Set objRootDSE = GetObject("LDAP://RootDSE")
		strConfig = objRootDSE.Get("configurationNamingContext")
		Set adoCommand = CreateObject("ADODB.Command")
		Set adoConnection = CreateObject("ADODB.Connection")
		adoConnection.Provider = "ADsDSOObject"
		adoConnection.Open "Active Directory Provider"
		adoCommand.ActiveConnection = adoConnection
		
		strBase = "<LDAP://" & strConfig & ">"
		strFilter = "(objectClass=nTDSDSA)"
		strAttributes = "AdsPath"
		strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
		
		adoCommand.CommandText = strQuery
		adoCommand.Properties("Page Size") = 100
		adoCommand.Properties("Timeout") = 60
		adoCommand.Properties("Cache Results") = False
		
		Set adoRecordset = adoCommand.Execute
		
		' Enumerate parent objects of class nTDSDSA. Save Domain Controller
		' AdsPaths in dynamic array arrstrDCs.
		
		Dim strDetails
		
		Do Until adoRecordset.EOF
		    Set objDC = GetObject(GetObject(adoRecordset.Fields("AdsPath").Value).Parent)
			Set objActiveOption = Document.CreateElement("OPTION")
			objActiveOption.Text = objDC.DNSHostName
		    objActiveOption.Value = objDC.DNSHostName
		    lst_domaincontrollers.Add objActiveOption
		    adoRecordset.MoveNext
		Loop
		adoRecordset.Close
	End Sub
 
	Sub Update_UserName2
		span_username2.InnerHTML = txt_username.Value
	End Sub
 
	Sub Disable_Controls
		txt_password.disabled = False
		btn_reload.disabled = False
	End Sub
 
	Sub Enable_Controls
		txt_password.disabled = True
		btn_reload.disabled = True
	End Sub
 
	Sub Reload_HTA
		Set objFSO = CreateObject("Scripting.FileSystemObject")
		Set objShell = CreateObject("WScript.Shell")
		Set wshNetwork = CreateObject("WScript.Network")
		If txt_username.Value <> "" And txt_password.Value <> "" Then
			strComputer = wshNetwork.ComputerName
			strPSExecPath = "\\server\share\psexec_194.exe"
			strCommand = "cmd /c " & objFSO.GetFile(strPSExecPath).ShortPath & " -accepteula \\" & strComputer & " -i -d -u " & txt_username.Value & " -p " & txt_password.Value & " mshta.exe " & objFSO.GetFile(strHTAPath).ShortPath
			'InputBox "Prompt", "Title", strCommand
			objShell.Run strCommand, 0, False
			Window.Close
		Else
			MsgBox "Please enter an alternate username and password to run the HTA as."
		End If
	End Sub
 
	Sub Exit_HTA
		Window.Close
	End Sub
 
	Sub Find_User
		strDisplayName = Get_LDAP_User_Properties("user", "samAccountName", txt_samaccountname.Value, "displayName,distinguishedName")
		If strDisplayName = "" Then
			MsgBox "Could find display name for " & txt_samaccountname.Value
			span_founduser.InnerHTML = " "
			span_userdn.InnerHTML = " "
		Else
			span_founduser.InnerHTML = Split(strDisplayName, VbCrLf)(0)
			span_userdn.InnerHTML = Split(strDisplayName, VbCrLf)(1)
		End If
	End Sub
 
	Sub Generate_Password
		'==============================================================================
		' 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 < 1
		 
			AddChr = Int((UCaseChrMax - UCaseChrMin + 1) * Rnd() + UCaseChrMin)
			NewPW = NewPW & Chr(AddChr)
			PWLen = PWLen + 1
		 
			'WScript.Echo AddChr
			'WScript.Echo NewPW
				
		Loop
		 
		Do While PWLen1 < 6
		 
			AddChr = Int((LCaseChrMax - LCaseChrMin + 1) * Rnd() + LCaseChrMin)
			NewPW = NewPW & Chr(AddChr)
			PWLen1 = PWLen1 + 1
		 
			'WScript.Echo AddChr
			'WScript.Echo NewPW
				
		Loop
		 
		Do While PWLen2 < 0
		 
			AddChr = Int((SpecialChrMax - SpecialChrMin + 1) * Rnd() + SpecialChrMin)
			NewPW = NewPW & Chr(AddChr)
			PWLen2 = PWLen2 + 1
		 
			'WScript.Echo AddChr
			'WScript.Echo NewPW
				
		Loop
		 
		Do While PWLen3 < 2
		 
			AddChr = Int((NumberMax - NumberMin + 1) * Rnd() + NumberMin)
			NewPW = NewPW & Chr(AddChr)
			PWLen3 = PWLen3 + 1
		 
			'WScript.Echo AddChr
			'WScript.Echo NewPW
				
		Loop
		 
		Do While PWLen4 < 0
		 
			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) < 9
		 
			Value = Int((8 - 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)
		'WScript.Echo "Final Password is           " & FinalPW
		txt_newpassword.Value = FinalPW
		Dim retval
		 
		retval = MsgBox("Username" & " legacyexchangeDN is this: " & FinalPW & VbCrLf & VbCrLf &_
		"Send Password to the clipboard?",vbYesNo+vbInformation+vbDefaultButton2,"OU Name")
		 
		If retval = vbYes Then	'Use IE for clipboard
			Dim objIE
			Set objIE = CreateObject("InternetExplorer.Application")
			objIE.Navigate("about:blank")
			'Note : intead of CRLF to save space
			Do Until objIE.ReadyState=4: WScript.Sleep 1: Loop
			objIE.Document.ParentWindow.ClipboardData.SetData "Text", FinalPW
			objIE.Quit
		End If 
	End Sub
 
	Sub Reset_User_Password
		' ResetPassword.vbs
		Dim objRootDSE, strDNSDomain, objTrans, strNetBIOSDomain
		Dim strUserDN, objUser, strPassword, strUserNTName
		 
		' Constants for the NameTranslate object.
		Const ADS_NAME_INITTYPE_GC = 3
		Const ADS_NAME_TYPE_NT4 = 3
		Const ADS_NAME_TYPE_1779 = 1
		 
		'User details
		strUserDN= span_userdn.InnerHTML
		strPassword = txt_newpassword.Value
		
		If Trim(strUserDN) <> "" And Trim(strPassword) <> "" Then
			' Bind to the user object in Active Directory with the LDAP provider.
			If boolDCHardCodedDC = True Then
				Set objUser = GetObject("LDAP://" & strSpecificDC & "/" & strUserDN)
			Else
				Set objUser = GetObject("LDAP://" & lst_domaincontrollers.value & "/" & strUserDN)
			End If
			objUser.SetPassword strPassword
			'wscript.echo err.Number
			If (Err.Number <> 0) Then
			    On Error GoTo 0
			    MsgBox "Password NOT reset for " & VbCrLf & span_founduser.InnerHTML & VbCrLf & _
			    	"Password " & strPassword & " may not be allowed, or" & VbCrLf & _
			    	"this client may not support a SSL connection."
			Else
			    objUser.AccountDisabled = False
			    objUser.Put "pwdLastSet", 0
			    objUser.SetInfo
			    If (Err.Number <> 0) Then
			        On Error GoTo 0
			        MsgBox "Password has been reset for " & span_founduser.InnerHTML & VbCrLf & _
			        	"but the accound could not be enabled."
			    End If
			End If
			On Error GoTo 0
			 
			MsgBox "Password reset and account enabled for user " & span_founduser.InnerHTML
		Else
			MsgBox "Password or username incorrect."
		End If
 
		'HTASleep 1800
		
		'Disable the account after 30 minutes
		'On Error Resume Next
		Set objFSO = CreateObject("Scripting.FileSystemObject")
		strScriptName = Left(strHTAPath, InStrRev(strHTAPath, "\")) & "Disable_" & objUser.samAccountName & ".vbs"
		Set objScript = objFSO.CreateTextFile(strScriptName, True)
		If boolDCHardCodedDC = True Then
			objScript.WriteLine "Set objUser = GetObject(""LDAP://" & strSpecificDC & "/" & strUserDN & """)"
		Else
			objScript.WriteLine "Set objUser = GetObject(""LDAP://" & lst_domaincontrollers.value & "/" & strUserDN & """)"
		End If
		objScript.WriteLine "WScript.Sleep 180000"
		objScript.WriteLine "objUser.StreetAddress = ""Account Disabled--Not Validated."""
		objScript.WriteLine "objUser.AccountDisabled = True"
		objScript.WriteLine "objUser.SetInfo"
		objScript.WriteLine "Set objFSO = CreateObject(""Scripting.FileSystemObject"")"
		objScript.WriteLine "objFSO.DeleteFile WScript.ScriptFullName, True"
		objScript.Close
		Set objShell = CreateObject("WScript.Shell")
		objShell.Run "wscript """ & strScriptName & """", 1, False
		MsgBox strUserDN & " will be disabled in 30 minutes."
	End Sub
 
	Sub HTASleep(intSeconds)
		Set objShell = CreateObject("WScript.Shell")
		objShell.Run "ping 127.0.0.1 -n " & intSeconds + 1, 0, True
	End Sub
 
	Function Get_LDAP_User_Properties(strObjectType, strSearchField, strObjectToGet, strCommaDelimProps)
	      
	      ' This is a custom function that connects to the Active Directory, and returns the specific
	      ' Active Directory attribute value, of a specific Object.
	      ' strObjectType: usually "User" or "Computer"
	      ' strSearchField: the field by which to seach the AD by. This acts like an SQL Query's WHERE clause.
	      '				It filters the results by the value of strObjectToGet
	      ' strObjectToGet: the value by which the results are filtered by, according the strSearchField.
	      '				For example, if you are searching based on the user account name, strSearchField
	      '				would be "samAccountName", and strObjectToGet would be that speicific account name,
	      '				such as "jsmith".  This equates to "WHERE 'samAccountName' = 'jsmith'"
	      '	strCommaDelimProps: the field from the object to actually return.  For example, if you wanted
	      '				the home folder path, as defined by the AD, for a specific user, this would be
	      '				"homeDirectory".  If you want to return the ADsPath so that you can bind to that
	      '				user and get your own parameters from them, then use "ADsPath" as a return string,
	      '				then bind to the user: Set objUser = GetObject("LDAP://" & strReturnADsPath)
	      
	      ' Now we're checking if the user account passed may have a domain already specified,
	      ' in which case we connect to that domain in AD, instead of the default one.
	      If InStr(strObjectToGet, "\") > 0 Then
	            arrGroupBits = Split(strObjectToGet, "\")
	            strDC = arrGroupBits(0)
	            strDNSDomain = strDC & "/" & "DC=" & Replace(Mid(strDC, InStr(strDC, ".") + 1), ".", ",DC=")
	            strObjectToGet = arrGroupBits(1)
	      Else
	      ' Otherwise we just connect to the default domain
	            Set objRootDSE = GetObject("LDAP://RootDSE")
	            strDNSDomain = objRootDSE.Get("defaultNamingContext")
	      End If
	 
	      strBase = "<LDAP://" & strDNSDomain & ">"
	      ' Setup ADO objects.
	      Set adoCommand = CreateObject("ADODB.Command")
	      Set adoConnection = CreateObject("ADODB.Connection")
	      adoConnection.Provider = "ADsDSOObject"
	      adoConnection.Open "Active Directory Provider"
	      adoCommand.ActiveConnection = adoConnection
	 
	 
	      ' Filter on user objects.
	      'strFilter = "(&(objectCategory=person)(objectClass=user))"
	      strFilter = "(&(objectClass=" & strObjectType & ")(" & strSearchField & "=" & strObjectToGet & "))"
	 
	      ' Comma delimited list of attribute values to retrieve.
	      strAttributes = strCommaDelimProps
	      arrProperties = Split(strCommaDelimProps, ",")
	 
	      ' Construct the LDAP syntax query.
	      strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
	      adoCommand.CommandText = strQuery
	      ' Define the maximum records to return
	      adoCommand.Properties("Page Size") = 100
	      adoCommand.Properties("Timeout") = 30
	      adoCommand.Properties("Cache Results") = False
	 
	      ' Run the query.
	      Set adoRecordset = adoCommand.Execute
	      ' Enumerate the resulting recordset.
	      strReturnVal = ""
	      Do Until adoRecordset.EOF
	          ' Retrieve values and display.    
	          For intCount = LBound(arrProperties) To UBound(arrProperties)
	                If strReturnVal = "" Then
	                      strReturnVal = adoRecordset.Fields(intCount).Value
	                Else
	                      strReturnVal = strReturnVal & VbCrLf & adoRecordset.Fields(intCount).Value
	                End If
	          Next
	          ' Move to the next record in the recordset.
	          adoRecordset.MoveNext
	      Loop
	 
	      ' Clean up.
	      adoRecordset.Close
	      adoConnection.Close
	      Get_LDAP_User_Properties = strReturnVal
	 
	End Function
</script>
<body style="background-color:#B0C4DE;">
	<table width= "90%" border="0" align="center">
		<tr>
			<td align="center" colspan="2">
				<h2>Reset User Password</h2>
			</td>
		</tr>
		<tr>
			<td align="left" valign="top">
				<img name="img_logo" id="img_logo" height="100px" width="100px" src="c:\MyLogo.jpg">
			</td>
			<td>
				Script is currently being run as <span id="span_currentuser"></span><br><br>
				Alternate credentials to run as: <input type="text" id="txt_username" name="txt_username" size="50" onkeyup="vbs:Update_username2"><br>
				Enter the password for <span id="span_username2"> </span><br>
				Password: <input type="password" id="txt_password" name="txt_password" size="20">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
				<button name="btn_reload" id="btn_reload" accessKey="l" onclick="vbs:Reload_HTA">Re<u>l</u>oad</button>
				<br><br>
			</td>
		</tr>
		<tr>
			<td colspan="2">
				Enter user login name to find: <input type="text" id="txt_samaccountname" name="txt_samaccountname" size="50">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
				<button name="btn_finduser" id="btn_finduser" accessKey="f" onclick="vbs:Find_User"><u>F</u>ind User</button><br><br>
				User display name found:&nbsp;<span id="span_founduser"> </span><br><br>
			</td>
		</tr>
		<tr>
			<td colspan="2">
				<button name="btn_generatepassword" id="btn_generatepassword" accessKey="g" onclick="vbs:Generate_Password"><u>G</u>enerate Password</button>
				&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<input readonly type="text" id="txt_newpassword" name="txt_newpassword" size="50">
			</td>
		</tr>
		<tr>
			<td colspan="2">
				Domain controller to reset password on:&nbsp;<span id="span_domaincontroller"></span><select size='1' name='lst_domaincontrollers'></select>
			</td>
		</tr>
		<tr>
			<td colspan="2" align="center">
				<br><br>
				<button name="btn_resetpassword" id="btn_resetpassword" onclick="vbs:Reset_User_Password">Reset User Password</button>
			</td>
		</tr>
	</table>
	<table width= "90%" border="0" align="center">
		<tr align="center">
			<td>
				<button name="btn_exit" id="btn_exit" accessKey="x" onclick="vbs:Exit_HTA">E<u>x</u>it</button><br>
				<font color="#B0C4DE"><span id="span_userdn"> </span></font>
			</td>
		</tr>
	</table>
</body>
</head>
</html>

Open in new window

0
 
LVL 12

Author Comment

by:chandru_sol
ID: 24056913
Thanks again Rob!!
0
 
LVL 12

Author Comment

by:chandru_sol
ID: 24094399
Rob,

Can this script be modified to use in Cross domains?

Users accessing this have permission to reset the password in the other domains

regards
Chandru
0
 
LVL 12

Author Comment

by:chandru_sol
ID: 24103667
Rob,

Current HTA doesn't work in cross domains?
0
 
LVL 12

Author Comment

by:chandru_sol
ID: 24126200
Rob,

Any update on this. Do you want me to open a new question?

regards
Chandru
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 24135500
Hi Chandru, I don't have any other domains to test with, so I could not provide any code that might work.  I have seen the OpenDSObject method used to provide a username and password for connection to another domain, so you could look into that method.  Otherwise, if you're existing user account already has access to the other domain, you could try changing this bit:
            strConfig = objRootDSE.Get("configurationNamingContext")

to this
            strConfig = "CN=Configuration,DC=YourOtherDomain,DC=Com

to populate the domain controllers from the other domain,
and maybe the username entered into the box would need to be in the form of
dcname.otherdomain.com/username

Regards,

Rob.
0
 
LVL 12

Author Comment

by:chandru_sol
ID: 24144731
Thanks Rob!!
0

Featured Post

Free Tool: Site Down Detector

Helpful to verify reports of your own downtime, or to double check a downed website you are trying to access.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

If you need to start windows update installation remotely or as a scheduled task you will find this very helpful.
When crafting your “Why Us” page, there are a plethora of pitfalls to avoid. Follow these five tips, and you’ll be well on your way to creating an effective page.
The viewer will the learn the benefit of plain text editors and code an HTML5 based template for use in further tutorials.
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

732 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question