' CannotChgPW.vbs
' VBScript program to configure a user so they cannot change their
' password.
'
' ----------------------------------------------------------------------
' Copyright (c) 2002-2010 Richard L. Mueller
' Hilltop Lab web site - http://www.rlmueller.net
' Version 1.0 - November 10, 2002
' Version 1.1 - February 19, 2003 - Standardize Hungarian notation.
' Version 1.2 - March 29, 2003 - Reorder ACE's in DACL.
' Version 1.3 - April 7, 2003 - Use function to reorder ACE's.
' Version 1.4 - January 25, 2004 - Modify error trapping.
' Version 1.5 - November 6, 2010 - No need to set objects to Nothing.
' The Distinguished Name of the user object is passed to the program as
' a parameter.
' Based on Microsoft KB articles 301287 and 269159.
' Requires that ADsSecurity.dll be registered on client.
'
' You have a royalty-free right to use, modify, reproduce, and
' distribute this script file in any way you find useful, provided that
' you agree that the copyright owner above has no warranty, obligations,
' or liability for such use.

Option Explicit

Const CHANGE_PASSWORD_GUID = "{AB721A53-1E2F-11D0-9819-00AA0040529B}"
Const ADS_RIGHT_DS_CONTROL_ACCESS = &H100
Const ADS_ACETYPE_ACCESS_ALLOWED = &H0
Const ADS_ACETYPE_ACCESS_DENIED = &H1
Const ADS_ACETYPE_ACCESS_ALLOWED_OBJECT = &H5
Const ADS_ACETYPE_ACCESS_DENIED_OBJECT = &H6
Const ADS_ACEFLAG_INHERITED_ACE = &H10
Const ADS_ACEFLAG_OBJECT_TYPE_PRESENT = &H1

Dim objACESelf, objACEEveryone, objSecDescriptor, objDACL, objUser
Dim strDN, objACE, blnSelf, blnEveryone, blnModified

' Check for required argument.
If (Wscript.Arguments.Count < 1) Then
    Wscript.Echo "Required argument <Distinguished Name> missing. " _
        & "For example:" & vbCrLf _
        & "cscript CannotChgPW.vbs cn=TestUser,ou=Sales,dc=MyDomain,dc=com"
    Wscript.Quit(0)
End If

' Bind to the user object with the LDAP provider.
strDN = Wscript.Arguments(0)
On Error Resume Next
Set objUser = GetObject("LDAP://" & strDN)
If (Err.Number <> 0) Then
    On Error GoTo 0
    Wscript.Echo "User not found" & vbCrLf & strDN
    Wscript.Quit(1)
End If
On Error GoTo 0

' Bind to the user security objects.
Set objSecDescriptor = objUser.Get("ntSecurityDescriptor")
Set objDACL = objSecDescriptor.discretionaryAcl

' Search for ACE's for Change Password and modify.
blnSelf = False
blnEveryone = False
blnModified = False
For Each objACE In objDACL
    If (UCase(objACE.objectType) = UCase(CHANGE_PASSWORD_GUID)) Then
        If (UCase(objACE.Trustee) = "NT AUTHORITY\SELF") Then
            If (objACE.AceType = ADS_ACETYPE_ACCESS_ALLOWED_OBJECT) Then
                objACE.AceType = ADS_ACETYPE_ACCESS_DENIED_OBJECT
                blnModified = True
            End If
            blnSelf = True
        End If
        If (UCase(objACE.Trustee) = "EVERYONE") Then
            If (objACE.AceType = ADS_ACETYPE_ACCESS_ALLOWED_OBJECT) Then
                objACE.AceType = ADS_ACETYPE_ACCESS_DENIED_OBJECT
                blnModified = True
            End If
            blnEveryone = True
        End If
    End If
Next

' If ACE's found and modified, save changes and exit.
If (blnSelf = True) And (blnEveryone = True) Then
    If (blnModified = False) Then
        Wscript.Echo "User already cannot change their password"
        Wscript.Quit
    Else
        objSecDescriptor.discretionaryACL = Reorder(objDACL)
        objUser.Put "ntSecurityDescriptor", objSecDescriptor
        objUser.SetInfo
        Wscript.Echo "User modified so they cannot change their password"
        Wscript.Quit
    End If
End If

' If ACE's not found, add to DACL.
If (blnSelf = False) Then
    ' Create the ACE for Self.
    Set objACESelf = CreateObject("AccessControlEntry")
    objACESelf.Trustee = "NT AUTHORITY\SELF"
    objACESelf.AceFlags = 0
    objACESelf.AceType = ADS_ACETYPE_ACCESS_DENIED_OBJECT
    objACESelf.Flags = ADS_ACEFLAG_OBJECT_TYPE_PRESENT
    objACESelf.objectType = CHANGE_PASSWORD_GUID
    objACESelf.AccessMask = ADS_RIGHT_DS_CONTROL_ACCESS
    objDACL.AddAce objACESelf
End If

If (blnEveryone = False) Then
    ' Create the ACE for Everyone.
    Set objACEEveryone = CreateObject("AccessControlEntry")
    objACEEveryone.Trustee = "Everyone"
    objACEEveryone.AceFlags = 0
    objACEEveryone.AceType = ADS_ACETYPE_ACCESS_DENIED_OBJECT
    objACEEveryone.Flags = ADS_ACEFLAG_OBJECT_TYPE_PRESENT
    objACEEveryone.objectType = CHANGE_PASSWORD_GUID
    objACEEveryone.AccessMask = ADS_RIGHT_DS_CONTROL_ACCESS
    objDACL.AddAce objACEEveryone
End If

objSecDescriptor.discretionaryACL = Reorder(objDACL)
      
' Update the user object.
objUser.Put "ntSecurityDescriptor", objSecDescriptor
objUser.SetInfo

Wscript.Echo "User denied permission to change their password"

Function Reorder(ByVal objDACL)
    ' Reorder ACE's in DACL.

    Dim objNewDACL, objInheritedDACL, objAllowDACL, objDenyDACL
    Dim objAllowObjectDACL, objDenyObjectDACL, objACE

    Set objNewDACL = CreateObject("AccessControlList")
    Set objInheritedDACL = CreateObject("AccessControlList")
    Set objAllowDACL = CreateObject("AccessControlList")
    Set objDenyDACL = CreateObject("AccessControlList")
    Set objAllowObjectDACL = CreateObject("AccessControlList")
    Set objDenyObjectDACL = CreateObject("AccessControlList")

    For Each objACE In objDACL
        If ((objACE.AceFlags And ADS_ACEFLAG_INHERITED_ACE) = _
                ADS_ACEFLAG_INHERITED_ACE) Then
            objInheritedDACL.AddAce objACE
        Else
            Select Case objACE.AceType
                Case ADS_ACETYPE_ACCESS_ALLOWED
                    objAllowDACL.AddAce objACE
                Case ADS_ACETYPE_ACCESS_DENIED
                    objDenyDACL.AddAce objACE
                Case ADS_ACETYPE_ACCESS_ALLOWED_OBJECT
                    objAllowObjectDACL.AddAce objACE
                Case ADS_ACETYPE_ACCESS_DENIED_OBJECT
                    objDenyObjectDACL.AddAce objACE
                Case Else
                    blnACL = False
            End Select
        End If
    Next
        
    For Each objACE In objDenyDACL
        objNewDACL.AddAce objACE
    Next
      
    For Each objACE In objDenyObjectDACL
        objNewDACL.AddAce objACE
    Next
        
    For Each objACE In objAllowDACL
        objNewDACL.AddAce objACE
    Next
        
    For Each objACE In objAllowObjectDACL
        objNewDACL.AddAce objACE
    Next
        
    For Each objACE In objInheritedDACL
        objNewDACL.AddAce objACE
    Next
        
    objNewDACL.ACLRevision = objDACL.ACLRevision
    Set Reorder = objNewDACL

End Function