Re: PWDReset Script - Please Help

Tech Tip: Click here to run a free scan for Windows Errors and optimize PC performance

Active directory logs the event natively. I would even suggest a
better method. Create a customized MMC. Create a taskpad and add a
reset password option to the tasks.


Darren King wrote:
Dear All,

I have unfortunately a very limited understanding of VBS scripting so I am
unsure how to do this? We use a script which was obtained from the internet
where open permission is granted to use it which will reset account
passwords in Active Directory. Presently this is used in our organisation
by our 24hr switchboard to reset account passwords outside of our IT
Departments normal 9am - 5pm shift because the switchboard work under our
management this is allowed.

Another department the library would also like this facility, but we are
reluctant to let them use the script as presently it resets passwords
without logging what was done. We would like the script to log what
accounts have had their password reset to a text file so we can monitor what
accounts have been reset by these users. Does anyone know what change we
will need to make to the script below to achieve our aim???

'Will search Active Directory by Last Name or username
'has options to reset password to a default or custom password and option
'to just unlock the account.
'Feel free to use the script
'Customary legal disclaimer, not liable for damage done by using this script
'change the strNetBiosDomain to your domain.

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 = "newhamhealth"
Const ADS_NAME_TYPE_NT4 = 3
Const ADS_NAME_TYPE_1779 = 1

Do while strlast <> "quit"
Choice = inputbox("1. Login username or " & vbcrLF & "2. Search by Last
Name" & vbcrLF & "3. To quit" & vbcrLF & "Please enter your choice of number
in the box","Password Reset Script","1")
If Choice = "3" Then
Wscript.Quit
Else
If Choice = 1 Then
strUser = inputbox("Enter Login username","Login username","")
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 by entering the number
in the box" & Display, "Last Name Search","0")'
Else
Choice1 = inputbox("User(s) found: Choose which one by entering the number
in the box" & 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 by entering the number
in the box" & Display1, "Last Name Search","0")'
Else
Choice1 = inputbox("User(s) found: Choose which one by entering the number
in the box" & 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 by entering the number
in the box" & Display2, "Last Name Search","0")'
Else
Choice1 = inputbox("User(s) found: Choose which one by entering the number
in the box" & 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 by entering the number
in the box" & Display3, "Last Name Search","0")'
Else
Choice1 = inputbox("User(s) found: Choose which one by entering the number
in the box" & 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 or " & vbcrLF & "2. Custom
Password or " & vbcrLF & "3. Unlock Account?","","1")
If Passchoice = 3 Then
objUser.IsAccountLocked = False
objUser.SetInfo
MsgBox "Account Unlocked for " & strUserNTname
Exit Function
End If
If Passchoice = 1 Then
strPassword = "newhamnhs"
Else
strPassword = inputbox("Enter Custom Password")
End If

objUser.SetPassword strPassword
If PassChoice = 1 Then
objUser.AccountDisabled = False
objUser.Put "pwdLastSet", 0
objUser.IsAccountLocked = False
Else
objUser.AccountDisabled = False
objUser.IsAccountLocked = False
End If
Err.Clear
objUser.SetInfo
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

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

' 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 & " the
correct person? " & vbcrLF & "1. Yes" & vbcrLF & "2. No","","1" )
If UserChoice = 1 Then
PassChoice = inputbox("1. Default Password or " & vbcrLF & "2. Custom
Password or " & vbcrLF & "3. Unlock Account?","","1")
If Passchoice = 3 Then
MsgBox Passchoice
objUser.IsAccountLocked = False
objUser.SetInfo
MsgBox "Account Unlocked for " & strUserNTname
Exit Function
End If
If Passchoice = 1 Then
strPassword = "newhamnhs"
Else
strPassword = inputbox("Enter Custom Password")
End If
objUser.SetPassword strPassword
If PassChoice = 1 Then
objUser.AccountDisabled = False
objUser.Put "pwdLastSet",0
objUser.IsAccountLocked = False
Else
objUser.AccountDisabled = False
objUser.IsAccountLocked = False
End If
objUser.SetInfo
Wscript.Echo "Password reset to " & strPassword & ", Account enabled, and
Password expired for user " & strUserNTName
Else
Exit Function
End If
' Clean up.
Set objRootDSE = Nothing
Set objTrans = Nothing
Set objUser = Nothing
End Function

.