JSI Tip 10167. How can I allow users to maintain their own personal information in Active Directory?

Using information from TechNet's Using Scripts to Delegate Control of Active Directory and MSDN's Personal-Information Property Set, I have scripted Grant_Personal_Information.vbs to grant all users the right to maintain their own personal information.

To use the Grant_Personal_Information.vbs:

1. Log onto the domain you wish to configure with Domain Admin authority.

2. Open a CMD.EXE window.

3. Switch to the folder that contains the Grant_Personal_Information.vbs script.

4. Type the following command and press Enter:

cscript //nologo Grant_Personal_Information.vbs

Grant_Personal_Information.vbs contains:

On Error Resume Next
Dim objConnection, objCommand, objRootDSE, strDNSDomain
Dim strFilter, strQuery, objRecordSet, DOM
Const ADS_ACETYPE_ACCESS_ALLOWED_OBJECT = &H5
Const ADS_RIGHT_DS_READ_PROP = &H10
Const ADS_RIGHT_DS_WRITE_PROP = &H20
Const ADS_FLAG_OBJECT_TYPE_PRESENT = &H1
Const ADS_FLAG_INHERITED_OBJECT_TYPE_PRESENT = &H2
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOOBject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("defaultNamingContext")
strBase = "<LDAP://" & strDNSDomain & ">" 
strFilter = "(&(objectCategory=person)(objectClass=user))"
strAttributes = "distinguishedName,sAMAccountName"
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
objCommand.CommandText = strQuery
objCommand.Properties("Page Size") = 99999
objCommand.Properties("Timeout") = 300
objCommand.Properties("Cache Results") = False
Set objRecordSet = objCommand.Execute
Set oShell = CreateObject( "WScript.Shell" )
DOM=oShell.ExpandEnvironmentStrings("%USERDOMAIN%")
objRecordSet.MoveFirst
Do Until objRecordSet.EOF
    strDN = objRecordSet.Fields("distinguishedName")
    strSAM = objRecordSet.Fields("sAMAccountName")
    Set objSdUtil = GetObject("LDAP://" & strDN)
    Set objSD = objSdUtil.Get("ntSecurityDescriptor")
    Set objDACL = objSD.DiscretionaryACL
    Set objAce = CreateObject("AccessControlEntry")
    objAce.Trustee = DOM & "\" & sAMAccountName
    objAce.AceFlags = 0
    objAce.AceType = ADS_ACETYPE_ACCESS_ALLOWED_OBJECT
    objAce.Flags = ADS_FLAG_OBJECT_TYPE_PRESENT
    objAce.ObjectType = "\{77b5b886-944a-11d1-aebd-0000f80367c1\}"
    objAce.AccessMask = ADS_RIGHT_DS_READ_PROP OR ADS_RIGHT_DS_WRITE_PROP
    objDacl.AddAce objAce
    objSD.DiscretionaryAcl = objDacl
    objSDUtil.Put "ntSecurityDescriptor", Array(objSD)
    objSDUtil.SetInfo
    objRecordSet.MoveNext
Loop
objConnection.Close
writefile.close
Set objConnection = Nothing
Set objCommand = Nothing
Set objRootDSE = Nothing

Comments

Plain text