[Webinar] Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 2705
  • Last Modified:

HTA script to Reset password and show details about user

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
anuroopkoka2005
Asked:
anuroopkoka2005
  • 5
  • 4
1 Solution
 
RobSampsonCommented:
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
 
anuroopkoka2005Author Commented:
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
 
anuroopkoka2005Author Commented:
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
Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

 
RobSampsonCommented:
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
 
anuroopkoka2005Author Commented:
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
 
RobSampsonCommented:
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
 
anuroopkoka2005Author Commented:
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
 
RobSampsonCommented:
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
 
RobSampsonCommented:
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

Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

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