Solved

HTA script to Reset password and show details about user

Posted on 2009-04-08
10
2,488 Views
Last Modified: 2012-05-06
1. HTA should have runas option to run the script with a different account
2. HTA should have the text box to display to chnage password
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, details about user,member of...in seperate tabs
0
Comment
Question by:anuroopkoka2005
  • 5
  • 4
10 Comments
 
LVL 65

Expert Comment

by:RobSampson
ID: 24103226
Hmmm, this looks *very* similar to this post:

http://www.experts-exchange.com/Programming/Languages/Visual_Basic/VB_Script/Q_24279527.html

Regards,

Rob.
0
 
LVL 4

Author Comment

by:anuroopkoka2005
ID: 24104154
That script i have already seen...

1.i want a script that will ask me the password or default password should be set as Welkom02.

2. that script should work on any domain without entering or changing in the script..

3.that script should most of the user management like user creation, deletion, password reset, account disabling, account unlocking,...adding user to the group

4. should show me which domain i have selected...

please can u help me....


0
 
LVL 4

Author Comment

by:anuroopkoka2005
ID: 24104857
Hi Rob,

Can u please help me in this.

It should be all in one place..

is it impossible to integrate all in one.....

Thanks...
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 24155074
Hi, to set the default password, change this line
                        &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<input readonly type="text" id="txt_newpassword" name="txt_newpassword" size="50">

to this
                        &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<input readonly type="text" id="txt_newpassword" name="txt_newpassword" size="50" value="Welkom02">

As far as the script working on any domain goes, I cannot really provide integrated code for that, because I only have one domain, and cannot test any code to read all domains.  I will, however, post some code below that you mind usefull in finding all possible domain controllers.

The user creation process is a lot bigger than this application allows for, but if you search Experts-Exchange for user creation scripts, whether from Excel, or HTA, you should find a few.

Regards,

Rob.
'Source: http://cwashington.netreach.net/depo/view.asp?Index=1132&ScriptType=vbscript

'Original author: Jan Aarts 

'Modified by: Rob Sampson

If LCase(Right(Wscript.FullName, 11)) = "wscript.exe" Then

    strPath = Wscript.ScriptFullName

    strCommand = "%comspec% /k cscript  """ & strPath & """"

    Set objShell = CreateObject("Wscript.Shell")

    objShell.Run(strCommand), 1, True

    Wscript.Quit

End If
 

strAdminDN = InputBox("Enter forest administrator username (DOMAIN/Username):", "Forest Admin Username")

strPassword = InputBox("Enter forest administrator password:", "Admin Password")
 

Set Con = CreateObject("ADODB.Connection")

con.Provider = "ADsDSOObject"

con.Open "Active Directory Provider", strAdminDN, strPassword
 

Set gc = GetObject("GC:")

For Each child In gc

    Set entpr = child

Next
 

Domains = 0

TotalDomainDCs = 0
 

Set Com = CreateObject("ADODB.Command")

Set Com.ActiveConnection = con

Com.CommandText = "<" & entpr.ADsPath & ">;(objectCategory=CN=Domain-DNS,CN=Schema,CN=Configuration," & Replace(Replace(entpr.ADsPath, ".", ",DC="), "GC://", "DC=") & ");distinguishedname;subTree"

'strQuery = "<" & strADsPath & ">;(objectCategory=CN=Domain-DNS,CN=Schema,CN=Configuration,DC=<root domain name>);distinguishedName;subtree"
 

'WScript.Echo Com.CommandText

Set rs1 = Com.Execute
 

While Not rs1.EOF

    Domains = Domains + 1

    DNSDomainName rs1.Fields(0).Value, DottedName
 

    set adsNamespaceLDAP = GetObject("LDAP:")

    OpenDSObjectStr = "LDAP://" & DottedName & "/OU=Domain Controllers," & rs1.Fields(0).Value 

    'WScript.Echo OpenDSObjectStr

    Set adsContainer = adsNamespaceLDAP.OpenDSObject(OpenDSObjectStr, strAdminDN, strPassword, 0)

    adsContainer.GetInfo

    WScript.Echo "DottedName: " & DottedName 

    For Each adsMember In adsContainer

		adsMember.getinfo

		If adsMember.objectcategory = "CN=Computer,CN=Schema,CN=Configuration," & Replace(Replace(entpr.ADsPath, ".", ",DC="), "GC://", "DC=") Then

			WScript.Echo Mid(adsMember.name, 4)

			TotalDomainDCs = TotalDomainDCs + 1            

		End If

    Next

    

    

    wscript.Echo "Total DC's: " & TotalDomainDCs 

    TotalDomainDCs = 0

    rs1.MoveNext

Wend
 

sub DNSDomainName (TxtIn, TxtOut)

    TxtIn = TxtIn & ","

    TxtOut = mid(TxtIn,4,InStr(TxtIn,",")-4)

    TxtIn = right(TxtIn,(len(TxtIn)-InStr(TxtIn,",")))

    While len(TxtIn) > 0

        TxtOut = TxtOut & "." & mid(TxtIn,4,InStr(TxtIn,",")-4)

        TxtIn = right(TxtIn,(len(TxtIn)-InStr(TxtIn,",")))

    Wend

End Sub

Open in new window

0
IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

 
LVL 4

Author Comment

by:anuroopkoka2005
ID: 24212475
Rob i found a script and made lot of changes to it as per my requirements..

Can we put th vbscript into HTA format..
'~~[scriptType]~~

'vbscript

'~~[/scriptType]~~
 

'~~[subType]~~

'DomainAdministration

'~~[/subType]~~
 

'~~[keywords]~~

'password change, account lockout, vbscript, Active Directory

'~~[/keywords]~~
 

'~~[comment]~~

'a script that searches Active Directory using Last Name or username, and resets the password to a default or custom password, or just unlocks the account.

'~~[/comment]~~
 

On Error Resume Next
 
 

Dim objRootDSE, strDNSDomain, objCommand, objConnection

Dim strBase, strFilter, strAttributes, strQuery, objRecordSet

Dim strGN, strDisplay, strLast, strLN, strDN

Dim MyArr
 
 

' Determine DNS domain name.

Set objRootDSE = GetObject("LDAP://RootDSE")

strDNSDomain = objRootDSE.Get("defaultNamingContext")
 

' Use ADO to search Active Directory.

Set objCommand = CreateObject("ADODB.Command")

Set objConnection = CreateObject("ADODB.Connection")

objConnection.Provider = "ADsDSOObject"

objConnection.Open "Active Directory Provider"

objCommand.ActiveConnection = objConnection

strBase = "<LDAP://" & strDNSDomain & ">"
 

'Change this to the Netbios Domain Name

strNetBiOSDomain = inputbox("Enter The Domain Name","Domain Name","")

Const ADS_NAME_TYPE_NT4 = 3

Const ADS_NAME_TYPE_1779 = 1
 

Do while strlast <> "quit"

  Choice = inputbox("1. Login Name " & vbcrLF & "2. Search by Last Name" & vbcrLF & "3. Exit","User management Script","Enter your choice")

    If Choice = "3" Then

      Wscript.Quit

    Else 

      If Choice = 1 Then

        strUser = inputbox("Enter Login Name","Login Name","")

        ChangePassword(strUser)

      Else  

        strLast = inputbox("Enter Last Name","Last Name","")

        strFilter = "(&(objectCategory=person)(objectClass=user)(sn=" & strLast & "))"

        strAttributes = "givenName,sn,sAMAccountName,physicalDeliveryOfficeName"

        strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"

        objCommand.CommandText = strQuery

        objCommand.Properties("Page Size") = 20

        objCommand.Properties("Timeout") = 30

        objCommand.Properties("Cache Results") = False

        objCommand.Properties("Sort On") = "givenName"

        Set objRecordSet = objCommand.Execute

        Set objRecordSetArr = objCommand.Execute

          If objRecordSet.EOF Then

            Wscript.Echo "No user found with last name: " & strLast

          End If

        DisplayName

      End If

    End If

Loop
 

'----------- Load up Recordset into Array

Function DisplayName

MyArr = objRecordsetArr.GetRows()
 

'---- Add 1 to end of array to get all of the rows

Upper = Ubound(myarr,2)+1
 

x=0

y=0

a=y+1
 

'Load up arrays with up to 100 usernames found.  Can only display 25 usernames at a time due to InputBox limitations
 

b=25

Do Until y=b or y=Upper

Display = Display & vbCrLf & a & ". " & myarr(x,y) & " " & myarr(x+1,y) & " " & myarr(x+2,y) & " " & myarr(x+3,y)

a=a+1

y=y+1

Loop
 

b=50

Do Until y=b or y=Upper

Display1 = Display1 & vbCrLf & a & ". " & myarr(x,y) & " " & myarr(x+1,y) & " " & myarr(x+2,y) & " " & myarr(x+3,y)

a=a+1

y=y+1

Loop
 

b=75

Do Until y=b or y=Upper

Display2 = Display2 & vbCrLf & a & ". " & myarr(x,y) & " " & myarr(x+1,y) & " " & myarr(x+2,y) & " " & myarr(x+3,y)

a=a+1

y=y+1

Loop
 

b=100

Do Until y=b or y=Upper

Display3 = Display3 & vbCrLf & a & ". " & myarr(x,y) & " " & myarr(x+1,y) & " " & myarr(x+2,y) & " " & myarr(x+3,y)

a=a+1

y=y+1

Loop
 

'Display arrays can add more arrays to display more than 100 results.
 

If Upper > 25 Then

Display = Display & vbcrLf & "Enter '999' for more results"

  Choice1 = inputbox("User(s) found:  Choose which one to reset password to default" & Display, "Last Name Search","0")'

Else

  Choice1 = inputbox("User(s) found:  Choose which one to reset password to default" & Display, "Last Name Search","0")'

End If

If Choice1 <= 25 Then

  PassChanged = ChangePass(choice1)

  Exit Function

End If
 

If Upper > 50 Then

Display1 = Display1 & vbcrLf & "Enter '999' for more results"

  Choice1 = inputbox("User(s) found:  Choose which one to reset password to default" & Display1, "Last Name Search","0")'

Else

  Choice1 = inputbox("User(s) found:  Choose which one to reset password to default" & Display1, "Last Name Search","0")'

End If

If Choice1 <= 50 Then

  PassChanged = ChangePass(choice1)

  Exit Function

End If
 

If Upper > 75 Then

Display2 = Display2 & vbcrLf & "Enter '999' for more results"

  Choice1 = inputbox("User(s) found:  Choose which one to reset password to default" & Display2, "Last Name Search","0")'

Else

  Choice1 = inputbox("User(s) found:  Choose which one to reset password to default" & Display2, "Last Name Search","0")'

End If

If Choice1 <= 75 Then

  PassChanged = ChangePass(choice1)

  Exit Function

End If
 

If Upper > 100 Then

Display3 = Display3 & vbcrLf & "Enter '999' for more results"

  Choice1 = inputbox("User(s) found:  Choose which one to reset password to default" & Display3, "Last Name Search","0")'

Else

  Choice1 = inputbox("User(s) found:  Choose which one to reset password to default" & Display3, "Last Name Search","0")'

End If

If Choice1 <= 100 Then

  PassChanged = ChangePass(choice1)

  Exit Function

End If

End Function
 

' ------ Function to Change the Password for username selection
 

Function ChangePass(Choice1)

y=(choice1)-1

strUserNTName = myarr(x+2,Y)
 
 

' Use the NameTranslate object to convert the NT user name to the

' Distinguished Name required for the LDAP provider.

'On Error Resume Next

Set objTrans = CreateObject("NameTranslate")

objTrans.Set ADS_NAME_TYPE_NT4, strNetBiOSDomain & "\" & strUserNTName
 

strUserDN = objTrans.Get(ADS_NAME_TYPE_1779)
 

' Bind to the user object in Active Directory with the LDAP provider.

'On Error Resume Next

Set objUser = GetObject("LDAP://" & strUserDN)

PassChoice = inputbox("1. Default Password (Welkom02) without expiry " & vbcrLF & "2. Custom Password without expiry " & vbcrLF & "3. Custom Password with expiry "& vbcrLF & "4. Account Status "& vbcrLF & "5. Unlock Account "& vbcrLF & "6. Enable Account "& vbcrLF & "7. Disable Account "& vbcrLF & "8. Back to previous menu "& vbcrLF & "9. Exit ","User Account management Page","1")

    If Passchoice = 5 Then

       objUser.IsAccountLocked = False

       objUser.SetInfo

       MsgBox "Account Unlocked for " & strUserNTname

       Exit Function

    End If

    If Passchoice = 7 Then

       objUser.AccountDisabled = True

       objUser.SetInfo

       Wscript.Echo "Account Disabled for user " & strUserNTName

    End If

    If Passchoice = 6 Then

       objUser.AccountDisabled = False

       objUser.SetInfo

       Wscript.Echo "Account Enabled for user " & strUserNTName

    End If

    If PassChoice = 1 Then

       strPassword = "Welkom02"

       objUser.SetPassword strPassword

       objUser.AccountDisabled = False

       objUser.IsAccountLocked = False

       objUser.SetInfo

       Wscript.Echo "Password reset to " & strPassword & ", account enabled for user " & strUserNTName

    End If

    If PassChoice = 2 Then

       strPassword = inputbox("Enter Custom Password")

       objUser.SetPassword strPassword

       objUser.AccountDisabled = False

       objUser.Put "pwdLastSet", 0

       objUser.IsAccountLocked = False

       objUser.SetInfo

       Wscript.Echo "Password reset to " & strPassword & ", account enabled, and password expired for user " & strUserNTName

    End If

    If PassChoice = 3 Then

       strPassword = inputbox("Enter Custom Password")

       objUser.SetPassword strPassword

       objUser.AccountDisabled = False

       objUser.IsAccountLocked = False

       objUser.SetInfo

       Wscript.Echo "Password reset to " & strPassword & ", account enabled for user " & strUserNTName

    End If

    If PassChoice = 4 Then

			If objUser.AccountDisabled = FALSE Then

      				WScript.Echo "The account is enabled."

			Else

      				WScript.Echo "The account is disabled."

			End If

    End If   

    If PassChoice = 9 Then

       Wscript.Quit

    End If

Err.Clear

  If Err.Number <> 0 Then

    On Error GoTo 0

    Wscript.Echo "Password reset for " & strUserNTName &" But, unable to enable account or expire password"

    Wscript.Quit

  End If
 

' Clean up.

Set objRootDSE = Nothing

Set objTrans = Nothing

Set objUser = Nothing

End Function
 

' ------------ Function to change password with from the Last name search selection
 

Function ChangePassword(strUser)
 

strUserNTName = strUser
 

' Use the NameTranslate object to convert the NT user name to the

' Distinguished Name required for the LDAP provider.

'On Error Resume Next

Set objTrans = CreateObject("NameTranslate")

objTrans.Set ADS_NAME_TYPE_NT4, strNetBiOSDomain & "\" & strUserNTName
 

strUserDN = objTrans.Get(ADS_NAME_TYPE_1779)
 

' Bind to the user object in Active Directory with the LDAP provider.

'On Error Resume Next

Set objUser = GetObject("LDAP://" & strUserDN)
 

UserChoice = InputBox("Is " & objUser.givenName & " " & objUser.sn & " in Office Location " & objUser.physicalDeliveryOfficeName & vbcrLF & "the correct person?"  & vbcrLF & "1. Yes"  & vbcrLF &  "2. No","Username Selection","1" )

If UserChoice = 1 Then

  PassChoice = inputbox("1. Default Password (Welkom02) without expiry " & vbcrLF & "2. Custom Password without expiry " & vbcrLF & "3. Custom Password with expiry "& vbcrLF & "4. Account Status "& vbcrLF & "5. Unlock Account "& vbcrLF & "6. Enable Account "& vbcrLF & "7. Disable Account "& vbcrLF & "8. Back to previous menu "& vbcrLF & "9. Exit ","User Account management Page","1")

    If Passchoice = 5 Then

       objUser.IsAccountLocked = False

       objUser.SetInfo

       MsgBox "Account Unlocked for " & strUserNTname

       Exit Function

    End If

    If Passchoice = 7 Then

      objUser.AccountDisabled = True

      objUser.SetInfo

      Wscript.Echo "Account Disabled for user " & strUserNTName

    End If

    If Passchoice = 6 Then

      objUser.AccountDisabled = False

      objUser.SetInfo

      Wscript.Echo "Account Enabled for user " & strUserNTName

    End If

    If PassChoice = 1 Then

      strPassword = "Welkom02"

      objUser.SetPassword strPassword

      objUser.AccountDisabled = False

      objUser.IsAccountLocked = False

      objUser.SetInfo

      Wscript.Echo "Password reset to " & strPassword & ", account enabled for user " & strUserNTName

    End If

    If PassChoice = 3 Then

      strPassword = inputbox("Enter Custom Password")

      objUser.SetPassword strPassword

      objUser.AccountDisabled = False

      objUser.Put "pwdLastSet", 0

      objUser.IsAccountLocked = False

      objUser.SetInfo

      Wscript.Echo "Password reset to " & strPassword & ", account enabled, and password expired for user " & strUserNTName

    End If

    If PassChoice = 2 Then

      strPassword = inputbox("Enter Custom Password")

      objUser.SetPassword strPassword

      objUser.AccountDisabled = False

      objUser.IsAccountLocked = False

      objUser.SetInfo

      Wscript.Echo "Password reset to " & strPassword & ", account enabled for user " & strUserNTName

    End If 

    If PassChoice = 4 Then

			If objUser.AccountDisabled = FALSE Then

      				WScript.Echo "The account is enabled."

			Else

      				WScript.Echo "The account is disabled."

			End If

    End If 

    If PassChoice = 9 Then

       Wscript.Quit

    End If

End If

' Clean up.

Set objRootDSE = Nothing

Set objTrans = Nothing

Set objUser = Nothing

End Function

'~~[/script]~~

Open in new window

0
 
LVL 65

Expert Comment

by:RobSampson
ID: 24533669
Hi mate. I'm really sorry that I've taken, like, five weeks to get back to you on this!  I've finally gone through your latest code and converted it to a HTA for you.

Hopefully it works for you.

Regards,

Rob.
<Html>

<Head>

<Title>Change User Password</Title>

 

<HTA:Application

Caption = Yes

Border = Thick

ShowInTaskBar = Yes

SingleInstance = Yes

MaximizeButton = Yes

MinimizeButton = Yes>

 

<script Language = VBScript>

Sub Window_onLoad

	intWidth = 800

	intHeight = 600

	Me.ResizeTo intWidth, intHeight

    Me.MoveTo ((Screen.Width / 2) - (intWidth / 2)),((Screen.Height / 2) - (intHeight / 2))

    lstUsers.style.width = 200

End Sub
 

Sub Exit_HTA

	window.Close

End Sub
 

Sub Start_Search

	If txtSearchText.Value <> "" Then

		' Determine DNS domain name.

		Set objRootDSE = GetObject("LDAP://RootDSE")

		strDNSDomain = objRootDSE.Get("defaultNamingContext")

		 

		' Use ADO to search Active Directory.

		Set objCommand = CreateObject("ADODB.Command")

		Set objConnection = CreateObject("ADODB.Connection")

		objConnection.Provider = "ADsDSOObject"

		objConnection.Open "Active Directory Provider"

		objCommand.ActiveConnection = objConnection

		strBase = "<LDAP://" & strDNSDomain & ">"

		 

		'Change this to the Netbios Domain Name

		Set objNetwork = CreateObject("WScript.Network")

		strNetBiOSDomain = objNetwork.UserDomain

	

		If optSearchType(0).Checked = True Then

			' Username is selected

	        strFilter = "(&(objectCategory=person)(objectClass=user)(samAccountName=" & txtSearchText.Value & "))"

		Else

			' Last name is selected

	        strFilter = "(&(objectCategory=person)(objectClass=user)(sn=" & txtSearchText.Value & "))"

		End If

		strAttributes = "givenName,sn,sAMAccountName,adsPath"

		strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"

		objCommand.CommandText = strQuery

		objCommand.Properties("Page Size") = 1000

		objCommand.Properties("Timeout") = 30

		objCommand.Properties("Cache Results") = False

		Set objRecordSet = objCommand.Execute

		Set objRecordSetArr = objCommand.Execute

	

		If objRecordSet.EOF Then

			MsgBox "No users were found."

		Else

			While Not objRecordSet.EOF

				Set objOption = Document.CreateElement("OPTION")

				objOption.Text = objRecordSet.Fields("givenName").Value & " " & objRecordSet.Fields("sn").Value

				objOption.Value = objRecordSet.Fields("adsPath").Value

				lstUsers.Add objOption

				objRecordSet.MoveNext

			Wend

		End If

	Else

		MsgBox "Please enter a search term."

	End If
 

End Sub
 

Sub Perform_Action

	strADsPath = ""

	For Each objOption In lstUsers.Options

		If objOption.Selected = True Then

			strADsPath = objOption.Value

			Exit For

		End If

	Next

	If strADsPath <> "" Then

		Set objUser = GetObject(strADsPath)

		If optAction(0).Checked = True Then

			' Default Password (Welkom02) without expiry

	       strPassword = "Welkom02"

	       objUser.SetPassword strPassword

	       objUser.AccountDisabled = False

	       objUser.IsAccountLocked = False

	       objUser.SetInfo

	       MsgBox "Password reset to " & strPassword & ", account enabled for user " & objUser.samAccountName

		ElseIf optAction(1).Checked = True Then

			' Custom Password without expiry

	       strPassword = InputBox("Enter Custom Password", "Custom password")

	       objUser.SetPassword strPassword

	       objUser.AccountDisabled = False

	       objUser.Put "pwdLastSet", 0

	       objUser.IsAccountLocked = False

	       objUser.SetInfo

	       MsgBox "Password reset to " & strPassword & ", account enabled, and password expired for user " & objUser.samAccountName

		ElseIf optAction(2).Checked = True Then

			' Custom Password with expiry

	       strPassword = InputBox("Enter Custom Password", "Custom password")

	       objUser.SetPassword strPassword

	       objUser.AccountDisabled = False

	       objUser.IsAccountLocked = False

	       objUser.SetInfo

	       MsgBox "Password reset to " & strPassword & ", account enabled for user " & objUser.samAccountName

		ElseIf optAction(3).Checked = True Then

			' Account Status

			If objUser.AccountDisabled = FALSE Then

				MsgBox objUser.samAccountName & " is enabled."

			Else

				MsgBox objUser.samAccountName & " is disabled."

			End If

		ElseIf optAction(4).Checked = True Then

			' Unlock Account

	       objUser.IsAccountLocked = False

	       objUser.SetInfo

	       MsgBox "Account Unlocked for " & objUser.samAccountName

		ElseIf optAction(5).Checked = True Then

			' Enable Account

	       objUser.AccountDisabled = False

	       objUser.SetInfo

	       MsgBox "Account Enabled for user " & objUser.samAccountName

		ElseIf optAction(6).Checked = True Then

			' Disable Account

	       objUser.AccountDisabled = True

	       objUser.SetInfo

	       MsgBox "Account Disabled for user " & objUser.samAccountName

		End If

	Else

		MsgBox "No user account has been selected."

	End If

End Sub

</script>

<body>

	<table width='80%' height='90%' align='center' border='0'>

		<tr>

			<td align='center' colspan="2">

				<h2>Change User Password</h2>

			</td>

		</tr>

		<tr>

			<td>

				<input type='radio' name='optSearchType' value='optUsername' CHECKED> Search by Username<br>

				<input type='radio' name='optSearchType' value='optLastName'> Search by Last Name<br>

			</td>

			<td>

				<input type="text" name="txtSearchText" maxlength="30" size="50">&nbsp;&nbsp;&nbsp;&nbsp;<button accesskey="s" id="btnSearch" onclick="vbs:Start_Search"><U>S</U>earch</button>

			</td>

		</tr>

		<tr>

			<td>

				Users:<br>

				<select size='15' name='lstUsers'>

				</select>

			</td>

			<td>

				&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<input type='radio' name='optAction' value='opt1' CHECKED> Default Password (Welkom02) without expiry<br>

				&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<input type='radio' name='optAction' value='opt2'> Custom Password without expiry<br>

				&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<input type='radio' name='optAction' value='opt3'> Custom Password with expiry<br>

				&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<input type='radio' name='optAction' value='opt4'> Account Status<br>

				&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<input type='radio' name='optAction' value='opt5'> Unlock Account<br>

				&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<input type='radio' name='optAction' value='opt6'> Enable Account<br>

				&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<input type='radio' name='optAction' value='opt7'> Disable Account<br><br>

				&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<button accesskey="g" id="btnPerformAction" onclick="vbs:Perform_Action"><U>G</U>o</button>

			</td>

		</tr>

		<tr>

			<td align="center" colspan="2">

				<button accesskey="x" id="btnExit" onclick="vbs:Exit_HTA">E<U>x</U>it</button>

			</td>

		</tr>

	</table>

</body>

</head>

</html>

Open in new window

0
 
LVL 4

Author Comment

by:anuroopkoka2005
ID: 24545576
Hello Rob,

i tried the script is very good but some problems are there...

1. The users field is not clearing up and i searched for a different user.
2. user account with password expirt and withpout password expiry is not working properly

Can you please help me... But i love the way u made it..

0
 
LVL 65

Accepted Solution

by:
RobSampson earned 500 total points
ID: 24552874
Hi,

Point 1 has been fixed.  I didn't test that, so thanks for pointing that out!

Point 2 was a little trickier, but I've fixed that.  Although, I need to ask, currently the script sets the "account" to never expire, or have a specific expiration date.  Did you want the option to set the "Password never expires" check box, or do we have it correct here?

Regards,

Rob.
<Html>

<Head>

<Title>Change User Password</Title>

 

<HTA:Application

Caption = Yes

Border = Thick

ShowInTaskBar = Yes

SingleInstance = Yes

MaximizeButton = Yes

MinimizeButton = Yes>

 

<script Language = VBScript>

Sub Window_onLoad

	intWidth = 800

	intHeight = 600

	Me.ResizeTo intWidth, intHeight

    Me.MoveTo ((Screen.Width / 2) - (intWidth / 2)),((Screen.Height / 2) - (intHeight / 2))

    lstUsers.style.width = 200

End Sub
 

Sub Exit_HTA

	window.Close

End Sub
 

Sub Start_Search

	If txtSearchText.Value <> "" Then

	    For Each objOption In lstUsers.Options

	        lstUsers.Remove(objOption.Index)

    	Next
 

		' Determine DNS domain name.

		Set objRootDSE = GetObject("LDAP://RootDSE")

		strDNSDomain = objRootDSE.Get("defaultNamingContext")

		 

		' Use ADO to search Active Directory.

		Set objCommand = CreateObject("ADODB.Command")

		Set objConnection = CreateObject("ADODB.Connection")

		objConnection.Provider = "ADsDSOObject"

		objConnection.Open "Active Directory Provider"

		objCommand.ActiveConnection = objConnection

		strBase = "<LDAP://" & strDNSDomain & ">"

		 

		'Change this to the Netbios Domain Name

		Set objNetwork = CreateObject("WScript.Network")

		strNetBiOSDomain = objNetwork.UserDomain

	

		If optSearchType(0).Checked = True Then

			' Username is selected

	        strFilter = "(&(objectCategory=person)(objectClass=user)(samAccountName=" & txtSearchText.Value & "))"

		Else

			' Last name is selected

	        strFilter = "(&(objectCategory=person)(objectClass=user)(sn=" & txtSearchText.Value & "))"

		End If

		strAttributes = "givenName,sn,sAMAccountName,adsPath"

		strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"

		objCommand.CommandText = strQuery

		objCommand.Properties("Page Size") = 1000

		objCommand.Properties("Timeout") = 30

		objCommand.Properties("Cache Results") = False

		Set objRecordSet = objCommand.Execute

		Set objRecordSetArr = objCommand.Execute

	

		If objRecordSet.EOF Then

			MsgBox "No users were found."

		Else

			While Not objRecordSet.EOF

				Set objOption = Document.CreateElement("OPTION")

				objOption.Text = objRecordSet.Fields("givenName").Value & " " & objRecordSet.Fields("sn").Value

				objOption.Value = objRecordSet.Fields("adsPath").Value

				lstUsers.Add objOption

				objRecordSet.MoveNext

			Wend

		End If

	Else

		MsgBox "Please enter a search term."

	End If
 

End Sub
 

Sub Perform_Action

	Const ADS_UF_DONT_EXPIRE_PASSWD = &H10000

	Set objShell = CreateObject("WScript.Shell")

	strADsPath = ""

	For Each objOption In lstUsers.Options

		If objOption.Selected = True Then

			strADsPath = objOption.Value

			Exit For

		End If

	Next

	If strADsPath <> "" Then

		Set objUser = GetObject(strADsPath)

		If optAction(0).Checked = True Then

			' Default Password (Welkom02) without expiry

			strPassword = "Welkom02"

			objUser.SetPassword strPassword

			objUser.AccountDisabled = False

			objUser.IsAccountLocked = False

			objUser.SetInfo

			objUser.AccountExpires = 0

			objUser.SetInfo

			' The below is for setting the "Password Never Expires" attribute

			'intUserAccountControl = objUser.Get("userAccountControl") 

			'If Not objUser.userAccountControl And ADS_UF_DONT_EXPIRE_PASSWD Then

			'	objUser.Put "userAccountControl", objUser.userAccountControl Xor ADS_UF_DONT_EXPIRE_PASSWD

			'	objUser.SetInfo

			'End If

			MsgBox "Password reset to " & strPassword & ", account enabled for user " & objUser.samAccountName

		ElseIf optAction(1).Checked = True Then

			' Custom Password without expiry

			strPassword = InputBox("Enter Custom Password", "Custom password")

			objUser.SetPassword strPassword

			objUser.AccountDisabled = False

			objUser.Put "pwdLastSet", 0

			objUser.IsAccountLocked = False

			objUser.SetInfo

			objUser.AccountExpires = 0

			objUser.SetInfo

			' The below is for setting the "Password Never Expires" attribute

			'intUserAccountControl = objUser.Get("userAccountControl") 

			'If Not objUser.userAccountControl And ADS_UF_DONT_EXPIRE_PASSWD Then

			'	objUser.Put "userAccountControl", objUser.userAccountControl Xor ADS_UF_DONT_EXPIRE_PASSWD

			'	objUser.SetInfo

			'End If

			MsgBox "Password reset to " & strPassword & ", account enabled for user " & objUser.samAccountName

		ElseIf optAction(2).Checked = True Then

			' Custom Password with expiry

			strPassword = InputBox("Enter Custom Password", "Custom password")

			objUser.SetPassword strPassword

			objUser.AccountDisabled = False

			objUser.IsAccountLocked = False

			objUser.SetInfo

			strExpiration = ""

			While strExpiration = ""

				strExpiration = Trim(InputBox("Enter an expiration date for " & objUser.samAccountName & VbCrLf & _

					"in MM/DD/YYYY HH:MM:SS AM/PM format:", "Expiration Date", "MM/DD/YYYY HH:MM:SS AM"))

			Wend

			If InStr(strExpiration, " ") = 0 Then strExpiration = strExpiration & " 12:00:00 AM"

			If IsDate(strExpiration) = True Then

				MsgBox strExpiration & VbCrLf & strTimeBias & VbCrLf & DateAdd("n", strTimeBias, strExpiration)

				strExpiration = DateAdd("n", strTimeBias, strExpiration)

			    ' This checks to see if the account DOES NOT expire

				On Error Resume Next

			    If objUser.AccountExpirationDate = "1/1/1970" Or objUser.AccountExpirationDate = "1/01/1601 10:00:00 AM" Or Err.Number = -2147467259 Then

			    On Error GoTo 0

			        'WScript.Echo objUser.Name & " will not expire. Setting to " & strExpiration

			        objUser.AccountExpirationDate = Eval("#" & strExpiration & "#")

					objUser.SetInfo

				Else

					'WScript.Echo objUser.Name & " already has an expiration date: " & objUser.AccountExpirationDate & vbCrLf & "Setting to " & strExpiration

					objUser.AccountExpirationDate = Eval("#" & strExpiration & "#")

					objUser.SetInfo

			    End If

				MsgBox "Password reset to " & strPassword & ", account enabled for user " & objUser.samAccountName & ", expiration set to " & strExpiration

			Else

				MsgBox "Password reset to " & strPassword & ", account enabled for user " & objUser.samAccountName & ", but expiration has NOT been set"

			End If

		ElseIf optAction(3).Checked = True Then

			' Account Status

			If objUser.AccountDisabled = FALSE Then

				MsgBox objUser.samAccountName & " is enabled."

			Else

				MsgBox objUser.samAccountName & " is disabled."

			End If

		ElseIf optAction(4).Checked = True Then

			' Unlock Account

	       objUser.IsAccountLocked = False

	       objUser.SetInfo

	       MsgBox "Account Unlocked for " & objUser.samAccountName

		ElseIf optAction(5).Checked = True Then

			' Enable Account

	       objUser.AccountDisabled = False

	       objUser.SetInfo

	       MsgBox "Account Enabled for user " & objUser.samAccountName

		ElseIf optAction(6).Checked = True Then

			' Disable Account

	       objUser.AccountDisabled = True

	       objUser.SetInfo

	       MsgBox "Account Disabled for user " & objUser.samAccountName

		End If

	Else

		MsgBox "No user account has been selected."

	End If

End Sub

</script>

<body>

	<table width='80%' height='90%' align='center' border='0'>

		<tr>

			<td align='center' colspan="2">

				<h2>Change User Password</h2>

			</td>

		</tr>

		<tr>

			<td>

				<input type='radio' name='optSearchType' value='optUsername' CHECKED> Search by Username<br>

				<input type='radio' name='optSearchType' value='optLastName'> Search by Last Name<br>

			</td>

			<td>

				<input type="text" name="txtSearchText" maxlength="30" size="50">&nbsp;&nbsp;&nbsp;&nbsp;<button accesskey="s" id="btnSearch" onclick="vbs:Start_Search"><U>S</U>earch</button>

			</td>

		</tr>

		<tr>

			<td>

				Users:<br>

				<select size='15' name='lstUsers'>

				</select>

			</td>

			<td>

				&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<input type='radio' name='optAction' value='opt1' CHECKED> Default Password (Welkom02) without expiry<br>

				&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<input type='radio' name='optAction' value='opt2'> Custom Password without expiry<br>

				&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<input type='radio' name='optAction' value='opt3'> Custom Password with expiry<br>

				&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<input type='radio' name='optAction' value='opt4'> Account Status<br>

				&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<input type='radio' name='optAction' value='opt5'> Unlock Account<br>

				&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<input type='radio' name='optAction' value='opt6'> Enable Account<br>

				&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<input type='radio' name='optAction' value='opt7'> Disable Account<br><br>

				&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<button accesskey="g" id="btnPerformAction" onclick="vbs:Perform_Action"><U>G</U>o</button>

			</td>

		</tr>

		<tr>

			<td align="center" colspan="2">

				<button accesskey="x" id="btnExit" onclick="vbs:Exit_HTA">E<U>x</U>it</button>

			</td>

		</tr>

	</table>

</body>

</head>

</html>

Open in new window

0
 
LVL 65

Expert Comment

by:RobSampson
ID: 25456327
Hi, I understand you have issues with this not displaying users....if you describe your problem, I will have a look at it when I have access to a domain.

Regards,

Rob.
0

Featured Post

Top 6 Sources for Identifying Threat Actor TTPs

Understanding your enemy is essential. These six sources will help you identify the most popular threat actor tactics, techniques, and procedures (TTPs).

Join & Write a Comment

Navigation is an important part of web design from a usability perspective. But it is often a pain when it comes to a developer’s perspective. By navigation, it often means menuing. This is less theory and more practical of how to get a specific gro…
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 …
The viewer will be introduced to the technique of using vectors in C++. The video will cover how to define a vector, store values in the vector and retrieve data from the values stored in the vector.
This video will show you how to get GIT to work in Eclipse.   It will walk you through how to install the EGit plugin in eclipse and how to checkout an existing repository.

760 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

19 Experts available now in Live!

Get 1:1 Help Now