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.Shell")

' 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("defaultNamingContext")


' Convert DNS domain name to NetBIOS domain name.
Set objTrans = CreateObject("NameTranslate")
objTrans.Init ADS_NAME_INITTYPE_GC, ""
objTrans.Set ADS_NAME_TYPE_1779, strDNSDomain
strNetBIOSDomain = objTrans.Get(ADS_NAME_TYPE_NT4)
' Remove trailing backslash.
strNetBIOSDomain = Left(strNetBIOSDomain, Len(strNetBIOSDomain) - 1)

' 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\System\CurrentControlSet\Control\" _
  & "TimeZoneInformation\ActiveTimeBias")
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


         
       

Start Free Trial