Solved

HTA for resetting account password

Posted on 2009-03-30
22
2,200 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
  • 14
  • 7
22 Comments
 
LVL 14

Expert Comment

by:rejoinder
Comment Utility
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
Comment Utility
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
Comment Utility
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
 
LVL 65

Expert Comment

by:RobSampson
Comment Utility
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
Comment Utility
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
Comment Utility

Script needs to disable the account after 30 minutes aswell

regards
Chandru
0
 
LVL 65

Expert Comment

by:RobSampson
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
Thanks Rob!!

You helped me again

regards
Chandru
0
What Is Threat Intelligence?

Threat intelligence is often discussed, but rarely understood. Starting with a precise definition, along with clear business goals, is essential.

 
LVL 12

Author Closing Comment

by:chandru_sol
Comment Utility
Thanks again!!
0
 
LVL 12

Author Comment

by:chandru_sol
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
Thanks again Rob!!
0
 
LVL 12

Author Comment

by:chandru_sol
Comment Utility
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
Comment Utility
Rob,

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

Author Comment

by:chandru_sol
Comment Utility
Rob,

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

regards
Chandru
0
 
LVL 65

Expert Comment

by:RobSampson
Comment Utility
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
Comment Utility
Thanks Rob!!
0

Featured Post

6 Surprising Benefits of Threat Intelligence

All sorts of threat intelligence is available on the web. Intelligence you can learn from, and use to anticipate and prepare for future attacks.

Join & Write a Comment

Suggested Solutions

Title # Comments Views Activity
FTP File permissions 1 28
[Probably Simple] Responsive CSS Layout Question 4 42
Help with HTML 7 38
CSS measurement 10 11
Deploying a Microsoft Access application in a Citrix environment is not difficult but takes a few steps. However, Citrix system people are often of little help, as they typically know next to nothing about Access. The script provided here will take …
Building a website can seem like a daunting task to the uninitiated but it really only requires knowledge of two basic languages: HTML and CSS.
In this tutorial viewers will learn how to embed videos in a webpage using HTML5. Ensure your DOCTYPE declaration is set to HTML5: "<!DOCTYPE html>": Use the <video> tag to insert a video. Define the src as the URL of your video; this is similar to …
The viewer will learn how to create a basic form using some HTML5 and PHP for later processing. Set up your basic HTML file. Open your form tag and set the method and action attributes.: (CODE) Set up your first few inputs one for the name and …

743 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

Need Help in Real-Time?

Connect with top rated Experts

20 Experts available now in Live!

Get 1:1 Help Now