laurakotas
asked on
How to reset passwords across domains.
Running two trusted domains, trying to reset passwords.
This script works fine if you are logged onto the same domain as the computer, but if you logon to a different domain than the machine, there is a problem.
Can anyone help
' Set AccPwd.vbs
' VBScript to unlock accounts, reset passwords and prompt user to change password at next logon
' -------------------------- ---------- ---------- ---------- ---------'
Option Explicit
Dim objUser, objDomain, lngBias, objLockout, dtmLockout
Dim objDuration, lngDuration, lngHigh, lngLow, dtmUnLock
Dim strUserDN, strDNSDomain, strNetBIOSDomain, strUserNTName, strProvider
Dim objTrans, objShell, lngBiasKey, k, objRootDSE
Dim strText, strTitle, intConstants, intAns
' Constants for the NameTranslate object.
Const ADS_NAME_INITTYPE_GC = 3
Const ADS_NAME_TYPE_NT4 = 3
Const ADS_NAME_TYPE_1779 = 1
strTitle = "Unlock User and Reset Password"
Set objShell = CreateObject("Wscript.Shel l")
' Request user sAMAccountName.
strUserNTName = Trim(InputBox("Enter User NT Logon Name", strTitle))
If strUserNTName = "" Then
strText = "Program has been cancelled"
intConstants = vbOKOnly + vbExclamation
intAns = objShell.Popup(strText, , strTitle, intConstants)
Wscript.Quit
End If
' Retrieve DNS domain name.
Set objRootDSE = GetObject("LDAP://RootDSE" )
strDNSDomain = objRootDSE.Get("defaultNam ingContext ")
' Convert DNS domain name to NetBIOS domain name.
Set objTrans = CreateObject("NameTranslat e")
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)
' Convert user NT name to Distinguished Name.
On Error Resume Next
objTrans.Set ADS_NAME_TYPE_NT4, "curriculum\" & strUserNTName
If Err.Number <> 0 Then
On Error GoTo 0
strText = "User " & strUserNTName & " not found"
strText = strText & vbCrLf & "Program aborted"
intConstants = vbOKOnly + vbCritical
intAns = objShell.Popup(strText, , strTitle, intConstants)
Wscript.Quit
End If
On Error GoTo 0
strUserDN = objTrans.Get(ADS_NAME_TYPE _1779)
' Bind to user object.
On Error Resume Next
Set objUser = GetObject("LDAP://" & strUserDN)
If Err.Number <> 0 Then
On Error GoTo 0
strText = "User " & strUserNTName & " not found"
strText = strText & vbCrLf & "DN: " & strUserDN
strText = strText & vbCrLf & "Program aborted"
intConstants = vbOKOnly + vbCritical
intAns = objShell.Popup(strText, , strTitle, intConstants)
Wscript.Quit
End If
On Error GoTo 0
' Bind to domain.
Set objDomain = GetObject("LDAP://" & strDNSDomain)
' Obtain local Time Zone bias from machine registry.
lngBiasKey = objShell.RegRead("HKLM\Sys tem\Curren tControlSe t\Control\ " _
& "TimeZoneInformation\Activ eTimeBias" )
If UCase(TypeName(lngBiasKey) ) = "LONG" Then
lngBias = lngBiasKey
ElseIf UCase(TypeName(lngBiasKey) ) = "VARIANT()" Then
lngBias = 0
For k = 0 To UBound(lngBiasKey)
lngBias = lngBias + (lngBiasKey(k) * 256^k)
Next
End If
' Retrieve user lockoutTime and convert to date.
On Error Resume Next
Set objLockout = objUser.lockoutTime
If Err.Number <> 0 Then
On Error GoTo 0
strText = "User " & strUserNTName & " is not locked out. Click 'Yes' to reset the password to the word 'password' all lowercase, click 'No' to cancel"
intConstants = vbYesNo + vbExclamation
intAns = objShell.Popup(strText, , strTitle, intConstants)
If intAns = vbYes Then
'On Error Resume Next
objUser.SetPassword "password"
'Force user to change password at next logon
objUser.Put "PwdLastSet", 0
If strProvider = "WinNT" Then
'objUser.Put "PasswordExpired", CLng(1)
Else 'must be LDAP
'objUser.put "pwdLastSet", CLng(0)
End If
objUser.setinfo
If Err.Number <> 0 Then
On Error GoTo 0
strText = "Unable to unlock user " & strUserNTName
strText = "You may not have sufficient rights"
strText = "Program aborted"
intConstants = vbOKOnly + vbCritical
intAns = objShell.Popup(strText, , strTitle, intConstants)
Else
On Error GoTo 0
strText = "User " & strUserNTName & " Password has been reset to the word 'password' all lowercase"
intConstants = vbOKOnly + vbExclamation
intAns = objShell.Popup(strText, , strTitle, intConstants)
End If
ElseIf intAns = vbNo Then
strText = "User " & strUserNTName & " account left locked out"
intConstants = vbOKOnly + vbInformation
intAns = objShell.Popup(strText, , strTitle, intConstants)
Else
strText = "Program aborted"
strText = strText & vbCrLf & "User " & strUserNTName _
& " still locked out"
intConstants = vbOKOnly + vbExclamation
intAns = objShell.Popup(strText, , strTitle, intConstants)
End If
Wscript.Quit
End If
On Error GoTo 0
dtmLockout = Integer8Date(objLockout, lngBias)
If dtmLockout = #1/1/1601# Then
strText = "User " & strUserNTName & " is not locked out. Click 'Yes' to reset the password to the word 'password' all lowercase, click 'No' to cancel"
intConstants = vbYesNo + vbExclamation
intAns = objShell.Popup(strText, , strTitle, intConstants)
If intAns = vbYes Then
'On Error Resume Next
objUser.SetPassword "password"
'Force user to change password at next logon
objUser.Put "PwdLastSet", 0
If strProvider = "WinNT" Then
'objUser.Put "PasswordExpired", CLng(1)
Else 'must be LDAP
'objUser.put "pwdLastSet", CLng(0)
End If
objUser.setinfo
If Err.Number <> 0 Then
On Error GoTo 0
strText = "Unable to unlock user " & strUserNTName
strText = "You may not have sufficient rights"
strText = "Program aborted"
intConstants = vbOKOnly + vbCritical
intAns = objShell.Popup(strText, , strTitle, intConstants)
Else
On Error GoTo 0
strText = "User " & strUserNTName & " Password has been reset to the word 'password' all lowercase"
intConstants = vbOKOnly + vbExclamation
intAns = objShell.Popup(strText, , strTitle, intConstants)
End If
ElseIf intAns = vbNo Then
strText = "User " & strUserNTName & " account left locked out"
intConstants = vbOKOnly + vbInformation
intAns = objShell.Popup(strText, , strTitle, intConstants)
Else
strText = "Program aborted"
strText = strText & vbCrLf & "User " & strUserNTName _
& " still locked out"
intConstants = vbOKOnly + vbExclamation
intAns = objShell.Popup(strText, , strTitle, intConstants)
End If
Wscript.Quit
End If
strText = "User " & strUserNTName & " locked out at: " & dtmLockout
' Retrieve domain lockoutDuration policy.
Set objDuration = objDomain.lockoutDuration
lngHigh = objDuration.HighPart
lngLow = objDuration.LowPart
If lngLow < 0 Then
lngHigh = lngHigh + 1
End If
lngDuration = lngHigh * (2^32) + lngLow
lngDuration = -lngDuration/(60 * 10000000)
strText = strText & vbCrLf & "Domain lockout duration (minutes): " _
& lngDuration
' Determine if account still locked out.
dtmUnLock = DateAdd("n", lngDuration, dtmLockout)
If Now > dtmUnLock Then
strText = strText & vbCrLf & "The account was unlocked at: " _
& dtmUnLock
intConstants = vbOKOnly + vbInformation
intAns = objShell.Popup(strText, , strTitle, intConstants)
Wscript.Quit
Else
strText = strText & vbCrLf & "Account will unlock at: " & dtmUnLock
strText = strText & vbCrLf & "Click ""Yes"" to unlock account now and reset the password to the word 'password' all lowercase"
strText = strText & vbCrLf & "Click ""No"" to leave account locked"
intConstants = vbYesNo + vbExclamation
intAns = objShell.Popup(strText, , strTitle, intConstants)
If intAns = vbYes Then
'On Error Resume Next
objUser.IsAccountLocked = False
objUser.SetPassword "password"
'Force user to change password at next logon
objUser.Put "PwdLastSet", 0
'If strProvider = "WinNT" Then
'objUser.Put "PasswordExpired", CLng(1)
'Else 'must be LDAP
'objUser.put "pwdLastSet", CLng(0)
'End If
objUser.setinfo
If Err.Number <> 0 Then
On Error GoTo 0
strText = "Unable to unlock user " & strUserNTName
strText = "You may not have sufficient rights"
strText = "Program aborted"
intConstants = vbOKOnly + vbCritical
intAns = objShell.Popup(strText, , strTitle, intConstants)
Else
On Error GoTo 0
strText = "User " & strUserNTName & " unlocked. Password has been reset to the word 'password' all lowercase"
intConstants = vbOKOnly + vbExclamation
intAns = objShell.Popup(strText, , strTitle, intConstants)
End If
ElseIf intAns = vbNo Then
strText = "User " & strUserNTName & " account left locked out"
intConstants = vbOKOnly + vbInformation
intAns = objShell.Popup(strText, , strTitle, intConstants)
Else
strText = "Program aborted"
strText = strText & vbCrLf & "User " & strUserNTName _
& " still locked out"
intConstants = vbOKOnly + vbExclamation
intAns = objShell.Popup(strText, , strTitle, intConstants)
End If
End If
' Clean up.
Set objUser = Nothing
Set objDomain = Nothing
Set objLockout = Nothing
Set objDuration = Nothing
Set objTrans = Nothing
Set objShell = Nothing
Function Integer8Date(objDate, lngBias)
' Function to convert Integer8 (64-bit) value to a date, adjusted for
' local time zone bias.
Dim lngAdjust, lngDate, lngHigh, lngLow
lngAdjust = lngBias
lngHigh = objDate.HighPart
lngLow = objdate.LowPart
' Account for bug in IADslargeInteger property methods.
If lngLow < 0 Then
lngHigh = lngHigh + 1
End If
If (lngHigh = 0) And (lngLow = 0) Then
lngAdjust = 0
End If
lngDate = #1/1/1601# + (((lngHigh * (2 ^ 32)) _
+ lngLow) / 600000000 - lngAdjust) / 1440
Integer8Date = CDate(lngDate)
End Function
This script works fine if you are logged onto the same domain as the computer, but if you logon to a different domain than the machine, there is a problem.
Can anyone help
' Set AccPwd.vbs
' VBScript to unlock accounts, reset passwords and prompt user to change password at next logon
' --------------------------
Option Explicit
Dim objUser, objDomain, lngBias, objLockout, dtmLockout
Dim objDuration, lngDuration, lngHigh, lngLow, dtmUnLock
Dim strUserDN, strDNSDomain, strNetBIOSDomain, strUserNTName, strProvider
Dim objTrans, objShell, lngBiasKey, k, objRootDSE
Dim strText, strTitle, intConstants, intAns
' Constants for the NameTranslate object.
Const ADS_NAME_INITTYPE_GC = 3
Const ADS_NAME_TYPE_NT4 = 3
Const ADS_NAME_TYPE_1779 = 1
strTitle = "Unlock User and Reset Password"
Set objShell = CreateObject("Wscript.Shel
' Request user sAMAccountName.
strUserNTName = Trim(InputBox("Enter User NT Logon Name", strTitle))
If strUserNTName = "" Then
strText = "Program has been cancelled"
intConstants = vbOKOnly + vbExclamation
intAns = objShell.Popup(strText, , strTitle, intConstants)
Wscript.Quit
End If
' Retrieve DNS domain name.
Set objRootDSE = GetObject("LDAP://RootDSE"
strDNSDomain = objRootDSE.Get("defaultNam
' Convert DNS domain name to NetBIOS domain name.
Set objTrans = CreateObject("NameTranslat
objTrans.Init ADS_NAME_INITTYPE_GC, ""
objTrans.Set ADS_NAME_TYPE_1779, strDNSDomain
strNetBIOSDomain = objTrans.Get(ADS_NAME_TYPE
' Remove trailing backslash.
strNetBIOSDomain = Left(strNetBIOSDomain, Len(strNetBIOSDomain) - 1)
' Convert user NT name to Distinguished Name.
On Error Resume Next
objTrans.Set ADS_NAME_TYPE_NT4, "curriculum\" & strUserNTName
If Err.Number <> 0 Then
On Error GoTo 0
strText = "User " & strUserNTName & " not found"
strText = strText & vbCrLf & "Program aborted"
intConstants = vbOKOnly + vbCritical
intAns = objShell.Popup(strText, , strTitle, intConstants)
Wscript.Quit
End If
On Error GoTo 0
strUserDN = objTrans.Get(ADS_NAME_TYPE
' Bind to user object.
On Error Resume Next
Set objUser = GetObject("LDAP://" & strUserDN)
If Err.Number <> 0 Then
On Error GoTo 0
strText = "User " & strUserNTName & " not found"
strText = strText & vbCrLf & "DN: " & strUserDN
strText = strText & vbCrLf & "Program aborted"
intConstants = vbOKOnly + vbCritical
intAns = objShell.Popup(strText, , strTitle, intConstants)
Wscript.Quit
End If
On Error GoTo 0
' Bind to domain.
Set objDomain = GetObject("LDAP://" & strDNSDomain)
' Obtain local Time Zone bias from machine registry.
lngBiasKey = objShell.RegRead("HKLM\Sys
& "TimeZoneInformation\Activ
If UCase(TypeName(lngBiasKey)
lngBias = lngBiasKey
ElseIf UCase(TypeName(lngBiasKey)
lngBias = 0
For k = 0 To UBound(lngBiasKey)
lngBias = lngBias + (lngBiasKey(k) * 256^k)
Next
End If
' Retrieve user lockoutTime and convert to date.
On Error Resume Next
Set objLockout = objUser.lockoutTime
If Err.Number <> 0 Then
On Error GoTo 0
strText = "User " & strUserNTName & " is not locked out. Click 'Yes' to reset the password to the word 'password' all lowercase, click 'No' to cancel"
intConstants = vbYesNo + vbExclamation
intAns = objShell.Popup(strText, , strTitle, intConstants)
If intAns = vbYes Then
'On Error Resume Next
objUser.SetPassword "password"
'Force user to change password at next logon
objUser.Put "PwdLastSet", 0
If strProvider = "WinNT" Then
'objUser.Put "PasswordExpired", CLng(1)
Else 'must be LDAP
'objUser.put "pwdLastSet", CLng(0)
End If
objUser.setinfo
If Err.Number <> 0 Then
On Error GoTo 0
strText = "Unable to unlock user " & strUserNTName
strText = "You may not have sufficient rights"
strText = "Program aborted"
intConstants = vbOKOnly + vbCritical
intAns = objShell.Popup(strText, , strTitle, intConstants)
Else
On Error GoTo 0
strText = "User " & strUserNTName & " Password has been reset to the word 'password' all lowercase"
intConstants = vbOKOnly + vbExclamation
intAns = objShell.Popup(strText, , strTitle, intConstants)
End If
ElseIf intAns = vbNo Then
strText = "User " & strUserNTName & " account left locked out"
intConstants = vbOKOnly + vbInformation
intAns = objShell.Popup(strText, , strTitle, intConstants)
Else
strText = "Program aborted"
strText = strText & vbCrLf & "User " & strUserNTName _
& " still locked out"
intConstants = vbOKOnly + vbExclamation
intAns = objShell.Popup(strText, , strTitle, intConstants)
End If
Wscript.Quit
End If
On Error GoTo 0
dtmLockout = Integer8Date(objLockout, lngBias)
If dtmLockout = #1/1/1601# Then
strText = "User " & strUserNTName & " is not locked out. Click 'Yes' to reset the password to the word 'password' all lowercase, click 'No' to cancel"
intConstants = vbYesNo + vbExclamation
intAns = objShell.Popup(strText, , strTitle, intConstants)
If intAns = vbYes Then
'On Error Resume Next
objUser.SetPassword "password"
'Force user to change password at next logon
objUser.Put "PwdLastSet", 0
If strProvider = "WinNT" Then
'objUser.Put "PasswordExpired", CLng(1)
Else 'must be LDAP
'objUser.put "pwdLastSet", CLng(0)
End If
objUser.setinfo
If Err.Number <> 0 Then
On Error GoTo 0
strText = "Unable to unlock user " & strUserNTName
strText = "You may not have sufficient rights"
strText = "Program aborted"
intConstants = vbOKOnly + vbCritical
intAns = objShell.Popup(strText, , strTitle, intConstants)
Else
On Error GoTo 0
strText = "User " & strUserNTName & " Password has been reset to the word 'password' all lowercase"
intConstants = vbOKOnly + vbExclamation
intAns = objShell.Popup(strText, , strTitle, intConstants)
End If
ElseIf intAns = vbNo Then
strText = "User " & strUserNTName & " account left locked out"
intConstants = vbOKOnly + vbInformation
intAns = objShell.Popup(strText, , strTitle, intConstants)
Else
strText = "Program aborted"
strText = strText & vbCrLf & "User " & strUserNTName _
& " still locked out"
intConstants = vbOKOnly + vbExclamation
intAns = objShell.Popup(strText, , strTitle, intConstants)
End If
Wscript.Quit
End If
strText = "User " & strUserNTName & " locked out at: " & dtmLockout
' Retrieve domain lockoutDuration policy.
Set objDuration = objDomain.lockoutDuration
lngHigh = objDuration.HighPart
lngLow = objDuration.LowPart
If lngLow < 0 Then
lngHigh = lngHigh + 1
End If
lngDuration = lngHigh * (2^32) + lngLow
lngDuration = -lngDuration/(60 * 10000000)
strText = strText & vbCrLf & "Domain lockout duration (minutes): " _
& lngDuration
' Determine if account still locked out.
dtmUnLock = DateAdd("n", lngDuration, dtmLockout)
If Now > dtmUnLock Then
strText = strText & vbCrLf & "The account was unlocked at: " _
& dtmUnLock
intConstants = vbOKOnly + vbInformation
intAns = objShell.Popup(strText, , strTitle, intConstants)
Wscript.Quit
Else
strText = strText & vbCrLf & "Account will unlock at: " & dtmUnLock
strText = strText & vbCrLf & "Click ""Yes"" to unlock account now and reset the password to the word 'password' all lowercase"
strText = strText & vbCrLf & "Click ""No"" to leave account locked"
intConstants = vbYesNo + vbExclamation
intAns = objShell.Popup(strText, , strTitle, intConstants)
If intAns = vbYes Then
'On Error Resume Next
objUser.IsAccountLocked = False
objUser.SetPassword "password"
'Force user to change password at next logon
objUser.Put "PwdLastSet", 0
'If strProvider = "WinNT" Then
'objUser.Put "PasswordExpired", CLng(1)
'Else 'must be LDAP
'objUser.put "pwdLastSet", CLng(0)
'End If
objUser.setinfo
If Err.Number <> 0 Then
On Error GoTo 0
strText = "Unable to unlock user " & strUserNTName
strText = "You may not have sufficient rights"
strText = "Program aborted"
intConstants = vbOKOnly + vbCritical
intAns = objShell.Popup(strText, , strTitle, intConstants)
Else
On Error GoTo 0
strText = "User " & strUserNTName & " unlocked. Password has been reset to the word 'password' all lowercase"
intConstants = vbOKOnly + vbExclamation
intAns = objShell.Popup(strText, , strTitle, intConstants)
End If
ElseIf intAns = vbNo Then
strText = "User " & strUserNTName & " account left locked out"
intConstants = vbOKOnly + vbInformation
intAns = objShell.Popup(strText, , strTitle, intConstants)
Else
strText = "Program aborted"
strText = strText & vbCrLf & "User " & strUserNTName _
& " still locked out"
intConstants = vbOKOnly + vbExclamation
intAns = objShell.Popup(strText, , strTitle, intConstants)
End If
End If
' Clean up.
Set objUser = Nothing
Set objDomain = Nothing
Set objLockout = Nothing
Set objDuration = Nothing
Set objTrans = Nothing
Set objShell = Nothing
Function Integer8Date(objDate, lngBias)
' Function to convert Integer8 (64-bit) value to a date, adjusted for
' local time zone bias.
Dim lngAdjust, lngDate, lngHigh, lngLow
lngAdjust = lngBias
lngHigh = objDate.HighPart
lngLow = objdate.LowPart
' Account for bug in IADslargeInteger property methods.
If lngLow < 0 Then
lngHigh = lngHigh + 1
End If
If (lngHigh = 0) And (lngLow = 0) Then
lngAdjust = 0
End If
lngDate = #1/1/1601# + (((lngHigh * (2 ^ 32)) _
+ lngLow) / 600000000 - lngAdjust) / 1440
Integer8Date = CDate(lngDate)
End Function
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.