Option Explicit



Dim objUser 'An ADSI User object

Dim str     'A text string



' User object using the LDAP namespace

Set objUser = GetObject("LDAP://cn=Administrator,cn=Users,dc=mycorp,dc=com")

str = str & "Name: " & objUser.Name & vbCrLf

str = str & "GUID: " & objUser.GUID & vbCrLf

str = str & "Class: " & objUser.Class & vbCrLf

str = str & "ADsPath: " & objUser.ADsPath & vbCrLf

str = str & "Parent: " & objUser.Parent & vbCrLf

str = str & "Schema: " & objUser.Schema & vbCrLf & vbCrLf



WScript.Echo str



Set objUser = Nothing

On Error Resume Next



'**********************************************************************

'Clear errors

'**********************************************************************

Err.Clear



'**********************************************************************

'Get a pointer to the Administrator account

'**********************************************************************

Set objUser = GetObject ("LDAP://cn=Administrator,cn=Users,dc=mycorp,dc=com")

If Err.Number = &H80005000 Then

  WScript.Echo "Bad ADSI path!" & vbCrLf & "Err. Number: " _

    & vbTab & CStr(Hex(Err.Number)) & vbCrLf & "Err. Descr.: " _

    & vbTab & Err.Description

  WScript.Quit

End If



'**********************************************************************

'Explicitly call GetInfo for completeness

'**********************************************************************

objUser.GetInfo



'**********************************************************************

'Clear any previous errors

'**********************************************************************

Err.Clear



'**********************************************************************

'Try and get a pointer to the "moose" attribute of the user (which

'doesn't exist)

'**********************************************************************

x = objUser.Get("moose")



'**********************************************************************

'Check for property does not exist error

'**********************************************************************

If Err.Number = &H8000500D Then

  WScript.Echo "No such property!" & vbCrLf & "Err. Number: " _

    & vbTab & CStr(Hex(Err.Number)) & vbCrLf & "Err. Descr.: " _

    & vbTab & Err.Description

End If

Option Explicit



Const ForReading = 1



Dim objDomain, objUser, fso, tsInputFile, strLine, arrInput

Dim fldUserHomedir, wshShell



Set objDomain = GetObject("LDAP://cn=Users,dc=mycorp,dc=com")

Set fso = CreateObject("Scripting.FileSystemObject")



'**********************************************************************

'Open the text file as a text stream for reading.

'Don't create a file if users-to-create.txt doesn't exist

'**********************************************************************

Set tsInputFile = fso.OpenTextFile("c:\users-to-create.txt", ForReading, False)



'**********************************************************************

'Execute the lines inside the loop, as long as you're not at the end

'of the file

'**********************************************************************

While Not tsInputFile.AtEndOfStream



  '**********************************************************************

  'Read a line, and use the Split function to split the data set into

  'its separate parts

  '**********************************************************************

  strLine = tsInputFile.ReadLine

  arrInput = Split(strLine, ":")



  Set objUser = objDomain.Create("user","cn=" & arrInput(0))

  objUser.Put "sAMAccountName", arrInput(0)

  objUser.Put "userPrincipalName", arrInput(0) & "@mycorp.com"



  '**********************************************************************

  'Write the newly created object out from the property cache

  'Read all the properties for the object, including

  'the ones set by the system on creation

  '**********************************************************************

  objUser.SetInfo

  objUser.GetInfo



  '**********************************************************************

  'Set the password

  '**********************************************************************

  objUser.SetPassword arrInput(4)



  '**********************************************************************

  'Set the properties

  '**********************************************************************

  objUser.AccountDisabled = False

  objUser.AccountExpirationDate = arrInput(1)

  objUser.Description = arrInput(2)

  objUser.LoginScript = "\\MYDOMAIN\DFS\Loginscripts\" & arrInput(0) & ".vbs"

  objUser.Profile = "\\MYDOMAIN\DFS\Users\" & arrInput(0) & "\profile"

  objUser.PasswordRequired = True

  objUser.DisplayName = arrInput(3)



  '**********************************************************************

  'Set the drive that you'll map to

  '**********************************************************************

  objUser.HomeDirectory = "\\MYDOMAIN\DFS\Users\" & arrInput(0)

  objUser.Put "homeDrive", "Z:"

  objUser.SetInfo



  '**********************************************************************

  'Create the home directory

  '**********************************************************************

  If Not fso.FolderExists("\\MYDOMAIN\DFS\Users\" & arrInput(0)) Then

    Set fldUserHomedir = fso.CreateFolder("\\MYDOMAIN\DFS\Users\" & arrInput(0))

  End If



  '**********************************************************************

  'Set full rights for the user to the home directory

  '**********************************************************************

  Set wshShell = WScript.CreateObject("Wscript.Shell")

  wshShell.Run "cacls \\MYDOMAIN\DFS\Users\" & arrInput(0) _

    & " /e /g " & arrInput(0) & ":F", 1, True



  '**********************************************************************

  'Stop referencing this user

  '**********************************************************************

  Set objUser = Nothing

Wend



'Close the file

tsInputFile.Close

Option Explicit

On Error Resume Next

Dim objConn, objComm, objRS, objUser

Dim strBase, strFilter, strAttrs, strScope

'**********************************************************************

'Set the ADO search criteria

'**********************************************************************

strBase   = "<LDAP://dc=mycorp,dc=com>;"

strFilter = "(&(objectclass=user)(objectcategory=person)(department=Sales));"

strAttrs  = "ADsPath;"

strScope  = "Subtree"



set objConn = CreateObject("ADODB.Connection")

objConn.Provider = "ADsDSOObject"

objConn.Open

'**********************************************************************

'Need to enable Paging in case there are more than 1000 objects returned

'**********************************************************************

Set objComm = CreateObject("ADODB.Command")

Set objComm.ActiveConnection = objConn

objComm.CommandText = strBase & strFilter & strAttrs & strScope

objComm.Properties("Page Size") = 1000

Set objRS = objComm.Execute()

While not objRS.EOF

  Set objUser = GetObject( objRS.Fields.Item("ADsPath").Value )

  objUser.LoginScript = "login-sales.vbs"

  objUser.SetInfo

  if Err.Number <> 0 Then

     Wscript.Echo objUser.Name & " error occurred"

     Err.Clear

  Else

     Wscript.Echo objUser.Name & " modified"

  End if

  Set objUser = Nothing

  objRS.MoveNext

Wend

'**********************************************************************

'How to unlock and enable a Active Directory user via arguments

' to this script

' Parameters should be <domain> <username>, where domain specifies

' a fully qualified AD domain like dc=mycorp,dc=com

'**********************************************************************

Option Explicit



Dim wshArgs, objUser, strOutput, arrSearchResults



On Error Resume Next



'**********************************************************************

'Get the arguments

'**********************************************************************

Set wshArgs = Wscript.Arguments



'**********************************************************************

'If no arguments passed in, then quit

'**********************************************************************

If wshArgs.Count = 0 Then

  WScript.Echo "ERROR: No arguments passed in." & vbCrLf & vbCrLf _

    & "Please use AD-UNLOCK <domain> <username>" & vbCrLf & vbCrLf

  WScript.Quit

End If



'**********************************************************************

'Error checking of the arguments could go here if we wanted to

'**********************************************************************



'**********************************************************************

'Use SearchAD function from the end of  to scan the entire

'Active Directory for this user and return the ADsPath. If the search

'failed for whatever reason, then quit

'**********************************************************************

If Not SearchAD("LDAP://" & wshArgs(0), _

  "(&(objectcategory=person)(objectClass=user)(sAMAccountName=" _

     & wshArgs(1) & "))", "SubTree", "ADsPath", arrSearchResults) Then



  WScript.Echo "ERROR: No users found." & vbCrLf & vbCrLf

  WScript.Quit

Else

  '**********************************************************************

  'Attempt to bind to the first ADsPath specified in the array

  '(as there should be only one)

  '**********************************************************************

  Set objUser = GetObject(arrSearchResults(0,0))

  If Err Then

    Wscript.Echo "Error: Could not bind to the following user: " & vbCrLf _

      & vbCrLf & arrSearchResults(0,0) & vbCrLf & vbCrLf

    WScript.Quit

  Else

    strOutput = "Connected to user " & arrSearchResults(0,0) & vbCrLf

  End If



  '**********************************************************************

  'Attempt to enable the user (but don't quit if you fail)

  '**********************************************************************

  Err.Clear

  objUser.AccountDisabled = False

  objUser.SetInfo

  If Err Then

    strOutput = strOutput & vbTab & "Error: Could not enable the user." & vbCrLf

  Else

    strOutput = strOutput & vbTab & "User enabled." & vbCrLf

  End If



  '**********************************************************************

  'Attempt to unlock the user

  '**********************************************************************

  Err.Clear

  objUser.IsAccountLocked = False

  objUser.SetInfo

  If Err Then

    strOutput = strOutput & vbTab & "Error: Could not unlock the user." & vbCrLf

  Else

    strOutput = strOutput & vbTab & "User unlocked." & vbCrLf

  End If



  WScript.Echo strOutput

End If

Option Explicit



Dim objDomain, objGroup, objComputer



'Creating a group in a Windows NT domain

Set objDomain = GetObject("WinNT://MYDOMAIN")

Set objGroup = objDomain.Create("group","MyGroup")

objGroup.SetInfo



'Creating a local group on a computer or member server

'Valid for Windows NT, Windows 200x

Set objComputer = GetObject("WinNT://MYCOMPUTER")

Set objGroup = objComputer.Create("group","My Group")

objGroup.SetInfo



'Creating a group in Active Directory

Set objDomain = GetObject("LDAP://cn=Users,dc=mycorp,dc=com")

Set objGroup = objDomain.Create("group","cn=My Group")

objGroup.Put "sAMAccountName", "MyGroup"

objGroup.SetInfo

Option Explicit



'Declare constants

Const FULL_CONTROL = -1

Const ADS_ACETYPE_ACCESS_ALLOWED = 0

Const ADS_FLAG_INHERITED_OBJECT_TYPE_PRESENT = 2



'Declare variables

Dim objObject    'Any object

Dim objSecDesc   'SecurityDescriptor

Dim objDACL      'AccessControlList

Dim objNewACE    'AccessControlEntry



'Create the new ACE and populate it

Set objNewACE = CreateObject("AccessControlEntry")

objNewACE.Trustee = "AMER\ANewGroup"

objNewACE.AccessMask = FULL_CONTROL

objNewACE.AceType = ADS_ACETYPE_ACCESS_ALLOWED

objNewACE.AceFlags = ADS_FLAG_INHERITED_OBJECT_TYPE_PRESENT



'Add the new ACE to the object and write it to the AD

Set objObject = GetObject("LDAP://ou=myOU,dc=amer,dc=mycorp,dc=com")



'Use IADs::Get to retrieve the SD for the object

Set objSecDesc = objObject.Get("ntSecurityDescriptor")



'Use IADsSecurityDescriptor:: DiscretionaryAcl to retrieve the existing DACL

Set objDACL = objSecDesc.DiscretionaryAcl



'Use IADsAccessControlList::AddACE to add an ACE to an existing DACL

objDACL.AddAce objNewACE



'Use IADsSecurityDescriptor:: DiscretionaryAcl to put back the modified DACL

objSecDesc.DiscretionaryAcl = objDACL



'Use IADs::Put to replace the SD for the object

objObject.Put "ntSecurityDescriptor", Array(objSecDesc)



'Write out the property cache using IADs::SetInfo

objObject.SetInfo

Option Explicit



'Modify these to change your trustee and target for the ACL mod

Const TRUSTEE="AMER\PasswordAdmin"

Const OBJPATH="ou=myOU,dc=amer,dc=mycorp,dc=com"



'Attribute, Class, Control Access Right constants

Const ATTRIB_LOCKOUTTIME_GUID = "{28630EBF-41D5-11D1-A9C1-0000F80367C1}"

Const ATTRIB_PWDLASTSET_GUID = "{BF967A0A-0DE6-11D0-A285-00AA003049E2}"

Const CLASS_USER_GUID = "{BF967ABA-0DE6-11D0-A285-00AA003049E2}"

Const CAR_RESETPWD_GUID = "{00299570-246D-11D0-A768-00AA006E0529}"



'AccessMask constants

Const ADS_RIGHT_GENERIC_READ = &H80000000

Const ADS_RIGHT_GENERIC_WRITE = &H40000000

Const ADS_RIGHT_GENERIC_EXECUTE = &H20000000

Const ADS_RIGHT_GENERIC_ALL = &H10000000

Const ADS_RIGHT_ACCESS_SYSTEM_SECURITY = &H1000000

Const ADS_RIGHT_SYNCHRONIZE = &H100000

Const ADS_RIGHT_WRITE_OWNER = &H80000

Const ADS_RIGHT_WRITE_DAC = &H40000

Const ADS_RIGHT_READ_CONTROL = &H20000

Const ADS_RIGHT_DELETE = &H10000

Const ADS_RIGHT_DS_CONTROL_ACCESS = &H100

Const ADS_RIGHT_DS_LIST_OBJECT = &H80

Const ADS_RIGHT_DS_DELETE_TREE = &H40

Const ADS_RIGHT_DS_WRITE_PROP = &H20

Const ADS_RIGHT_DS_READ_PROP = &H10

Const ADS_RIGHT_DS_SELF = &H8

Const ADS_RIGHT_ACTRL_DS_LIST = &H4

Const ADS_RIGHT_DS_DELETE_CHILD = &H2

Const ADS_RIGHT_DS_CREATE_CHILD = &H1

Const FULL_CONTROL = -1



'AceType constants

Const ADS_ACETYPE_SYSTEM_AUDIT_OBJECT = &H7

Const ADS_ACETYPE_ACCESS_DENIED_OBJECT = &H6

Const ADS_ACETYPE_ACCESS_ALLOWED_OBJECT = &H5

Const ADS_ACETYPE_SYSTEM_AUDIT = &H2

Const ADS_ACETYPE_ACCESS_DENIED = &H1

Const ADS_ACETYPE_ACCESS_ALLOWED = &H0



'AceFlags constants

Const ADS_ACEFLAG_FAILED_ACCESS = &H80

Const ADS_ACEFLAG_SUCCESSFUL_ACCESS = &H40

Const ADS_ACEFLAG_VALID_INHERIT_FLAGS = &H1F

Const ADS_ACEFLAG_INHERITED_ACE = &H10

Const ADS_ACEFLAG_INHERIT_ONLY_ACE = &H8

Const ADS_ACEFLAG_NO_PROPAGATE_INHERIT_ACE = &H4

Const ADS_ACEFLAG_INHERIT_ACE = &H2



'Flags constants

Const ADS_FLAG_INHERITED_OBJECT_TYPE_PRESENT = &H2

Const ADS_FLAG_OBJECT_TYPE_PRESENT = &H1



'Declare variables

Dim objObject    'Any object

Dim objSecDesc   'SecurityDescriptor

Dim objDACL      'AccessControlList

Dim objNewACE_1  'AccessControlEntry

Dim objNewACE_2  'AccessControlEntry

Dim objNewACE_3  'AccessControlEntry



'Create new ACE, Unlock User Objects

Set objNewACE_1 = CreateObject("AccessControlEntry")

objNewACE_1.Trustee = TRUSTEE

objNewACE_1.AccessMask = ADS_RIGHT_DS_WRITE_PROP or ADS_RIGHT_DS_READ_PROP

objNewACE_1.AceType = ADS_ACETYPE_ACCESS_ALLOWED_OBJECT

objNewACE_1.AceFlags = ADS_ACEFLAG_INHERIT_ONLY_ACE _

                                                 or ADS_ACEFLAG_INHERIT_ACE

objNewACE_1.Flags= ADS_FLAG_OBJECT_TYPE_PRESENT _

                                  or ADS_FLAG_INHERITED_OBJECT_TYPE_PRESENT

objNewACE_1.ObjectType= ATTRIB_LOCKOUTTIME_GUID

objNewACE_1.InheritedObjectType = CLASS_USER_GUID



'Create new ACE, Set/Clear Must change password on next logon

Set objNewACE_2 = CreateObject("AccessControlEntry")

objNewACE_2.Trustee = TRUSTEE

objNewACE_2.AccessMask = ADS_RIGHT_DS_WRITE_PROP or ADS_RIGHT_DS_READ_PROP

objNewACE_2.AceType = ADS_ACETYPE_ACCESS_ALLOWED_OBJECT

objNewACE_2.AceFlags = ADS_ACEFLAG_INHERIT_ONLY_ACE _

                                                 or ADS_ACEFLAG_INHERIT_ACE

objNewACE_2.Flags= ADS_FLAG_OBJECT_TYPE_PRESENT _

                                  or ADS_FLAG_INHERITED_OBJECT_TYPE_PRESENT

objNewACE_2.ObjectType= ATTRIB_PWDLASTSET_GUID

objNewACE_2.InheritedObjectType = CLASS_USER_GUID



'Create new ACE, Reset Password

Set objNewACE_3 = CreateObject("AccessControlEntry")

objNewACE_3.Trustee = TRUSTEE

objNewACE_3.AccessMask = ADS_RIGHT_DS_CONTROL_ACCESS

objNewACE_3.AceType = ADS_ACETYPE_ACCESS_ALLOWED_OBJECT

objNewACE_3.AceFlags = ADS_ACEFLAG_INHERIT_ONLY_ACE _

                                                 or ADS_ACEFLAG_INHERIT_ACE

objNewACE_3.Flags= ADS_FLAG_OBJECT_TYPE_PRESENT _

                                  or ADS_FLAG_INHERITED_OBJECT_TYPE_PRESENT

objNewACE_3.ObjectType= CAR_RESETPWD_GUID

objNewACE_3.InheritedObjectType = CLASS_USER_GUID



'Add the new ACE to the object and write it to the AD

Set objObject = GetObject("LDAP://" & OBJPATH)



'Use IADs::Get to retrieve the SD for the object

Set objSecDesc = objObject.Get("ntSecurityDescriptor")



'Use IADsSecurityDescriptor:: DiscretionaryAcl to retrieve the existing DACL

Set objDACL = objSecDesc.DiscretionaryAcl



'Use IADsAccessControlList::AddACE to add ACEs to an existing DACL

objDACL.AddAce objNewACE_1    ' Add Unlock

objDACL.AddAce objNewACE_2    ' Add Set/Clear must change password

objDACL.AddAce objNewACE_3    ' Add Reset password



'Use IADsSecurityDescriptor:: DiscretionaryAcl to put back the modified DACL

objSecDesc.DiscretionaryAcl = objDACL



'Use IADs::Put to replace the SD for the object

objObject.Put "ntSecurityDescriptor", Array(objSecDesc)



'Write out the property cache using IADs::SetInfo

objObject.SetInfo

Option Explicit



'Declare the variables

Dim objObject, objRootDSE, objSchema, objExtRights, objEnum, objSD

Dim objDACL, objSACL, objACE

Dim SchemaGuids, CARGuids, SDCtlD, AccMaskD, ACEFlagsD, FlagsD

Dim strDC, strSchemaPath, strConfigPath, strGUID, strLDAPPath



'AccessMask constants

Const FULL_CONTROL                     = -1

Const FULL_CONTROL2                    = &HF01FF



Const ADS_RIGHT_GENERIC_READ           = &H80000000

Const ADS_RIGHT_GENERIC_WRITE          = &H40000000

Const ADS_RIGHT_GENERIC_EXECUTE        = &H20000000

Const ADS_RIGHT_GENERIC_ALL            = &H10000000

Const ADS_RIGHT_ACCESS_SYSTEM_SECURITY = &H1000000

Const ADS_RIGHT_SYNCHRONIZE            = &H100000

Const ADS_RIGHT_WRITE_OWNER            = &H80000

Const ADS_RIGHT_WRITE_DAC              = &H40000

Const ADS_RIGHT_READ_CONTROL           = &H20000

Const ADS_RIGHT_DELETE                 = &H10000

Const ADS_RIGHT_DS_CONTROL_ACCESS      = &H100

Const ADS_RIGHT_DS_LIST_OBJECT         = &H80

Const ADS_RIGHT_DS_DELETE_TREE         = &H40

Const ADS_RIGHT_DS_WRITE_PROP          = &H20

Const ADS_RIGHT_DS_READ_PROP           = &H10

Const ADS_RIGHT_DS_SELF                = &H8

Const ADS_RIGHT_ACTRL_DS_LIST          = &H4

Const ADS_RIGHT_DS_DELETE_CHILD        = &H2

Const ADS_RIGHT_DS_CREATE_CHILD        = &H1



'AccessMask Dictionary for Flag enumeration

Set AccMaskD = CreateObject("Scripting.Dictionary")

AccMaskD.Add FULL_CONTROL, "FULL_CONTROL"

AccMaskD.Add FULL_CONTROL2, "FULL_CONTROL2"

AccMaskD.Add ADS_RIGHT_GENERIC_READ, "ADS_RIGHT_GENERIC_READ"

AccMaskD.Add ADS_RIGHT_GENERIC_WRITE, "ADS_RIGHT_GENERIC_WRITE"

AccMaskD.Add ADS_RIGHT_GENERIC_EXECUTE, "ADS_RIGHT_GENERIC_EXECUTE"

AccMaskD.Add ADS_RIGHT_GENERIC_ALL, "ADS_RIGHT_GENERIC_ALL"

AccMaskD.Add ADS_RIGHT_ACCESS_SYSTEM_SECURITY, "ADS_RIGHT_ACCESS_SYSTEM_SECURITY"

AccMaskD.Add ADS_RIGHT_SYNCHRONIZE, "ADS_RIGHT_SYNCHRONIZE"

AccMaskD.Add ADS_RIGHT_WRITE_OWNER, "ADS_RIGHT_WRITE_OWNER"

AccMaskD.Add ADS_RIGHT_WRITE_DAC, "ADS_RIGHT_WRITE_DAC"

AccMaskD.Add ADS_RIGHT_READ_CONTROL, "ADS_RIGHT_READ_CONTROL"

AccMaskD.Add ADS_RIGHT_DELETE, "ADS_RIGHT_DELETE"

AccMaskD.Add ADS_RIGHT_DS_CONTROL_ACCESS, "ADS_RIGHT_DS_CONTROL_ACCESS"

AccMaskD.Add ADS_RIGHT_DS_LIST_OBJECT, "ADS_RIGHT_DS_LIST_OBJECT"

AccMaskD.Add ADS_RIGHT_DS_DELETE_TREE, "ADS_RIGHT_DS_DELETE_TREE"

AccMaskD.Add ADS_RIGHT_DS_WRITE_PROP, "ADS_RIGHT_DS_WRITE_PROP"

AccMaskD.Add ADS_RIGHT_DS_READ_PROP, "ADS_RIGHT_DS_READ_PROP"

AccMaskD.Add ADS_RIGHT_DS_SELF, "ADS_RIGHT_DS_SELF"

AccMaskD.Add ADS_RIGHT_ACTRL_DS_LIST, "ADS_RIGHT_ACTRL_DS_LIST"

AccMaskD.Add ADS_RIGHT_DS_DELETE_CHILD, "ADS_RIGHT_DS_DELETE_CHILD"

AccMaskD.Add ADS_RIGHT_DS_CREATE_CHILD, "ADS_RIGHT_DS_CREATE_CHILD"



'AceType constants

Const ADS_ACETYPE_SYSTEM_AUDIT_OBJECT   = &H7

Const ADS_ACETYPE_ACCESS_DENIED_OBJECT  = &H6

Const ADS_ACETYPE_ACCESS_ALLOWED_OBJECT = &H5



Const ADS_ACETYPE_SYSTEM_AUDIT          = &H2

Const ADS_ACETYPE_ACCESS_DENIED         = &H1

Const ADS_ACETYPE_ACCESS_ALLOWED        = &H0



'AceFlags constants

Const ADS_ACEFLAG_FAILED_ACCESS            = &H80

Const ADS_ACEFLAG_SUCCESSFUL_ACCESS        = &H40

Const ADS_ACEFLAG_VALID_INHERIT_FLAGS      = &H1F

Const ADS_ACEFLAG_INHERITED_ACE            = &H10

Const ADS_ACEFLAG_INHERIT_ONLY_ACE         = &H8

Const ADS_ACEFLAG_NO_PROPAGATE_INHERIT_ACE = &H4

Const ADS_ACEFLAG_INHERIT_ACE              = &H2



'AceFlags Dictionary for Flag enumeration

Set ACEFlagsD = CreateObject("Scripting.Dictionary")

ACEFlagsD.Add ADS_ACEFLAG_FAILED_ACCESS, "ADS_ACEFLAG_FAILED_ACCESS"

ACEFlagsD.Add ADS_ACEFLAG_SUCCESSFUL_ACCESS, "ADS_ACEFLAG_SUCCESSFUL_ACCESS"

ACEFlagsD.Add ADS_ACEFLAG_VALID_INHERIT_FLAGS, "ADS_ACEFLAG_VALID_INHERIT_FLAGS"

ACEFlagsD.Add ADS_ACEFLAG_INHERITED_ACE, "ADS_ACEFLAG_INHERITED_ACE"

ACEFlagsD.Add ADS_ACEFLAG_INHERIT_ONLY_ACE, "ADS_ACEFLAG_INHERIT_ONLY_ACE"

ACEFlagsD.Add ADS_ACEFLAG_NO_PROPAGATE_INHERIT_ACE, _

                                       "ADS_ACEFLAG_NO_PROPAGATE_INHERIT_ACE"

ACEFlagsD.Add ADS_ACEFLAG_INHERIT_ACE, "ADS_ACEFLAG_INHERIT_ACE"





'Security Descriptor constants

Const ADS_SD_CONTROL_SE_SACL_PROTECTED        = &H2000

Const ADS_SD_CONTROL_SE_DACL_PROTECTED        = &H1000

Const ADS_SD_CONTROL_SE_DACL_AUTO_INHERITED   = &H400

Const ADS_SD_CONTROL_SE_SACL_AUTO_INHERITED   = &H800

Const ADS_SD_CONTROL_SE_SACL_AUTO_INHERIT_REQ = &H200

Const ADS_SD_CONTROL_SE_DACL_AUTO_INHERIT_REQ = &H100

Const ADS_SD_CONTROL_SE_SACL_DEFAULTED        = &H20

Const ADS_SD_CONTROL_SE_SACL_PRESENT          = &H10

Const ADS_SD_CONTROL_SE_DACL_DEFAULTED        = &H8

Const ADS_SD_CONTROL_SE_DACL_PRESENT          = &H4

Const ADS_SD_CONTROL_SE_GROUP_DEFAULTED       = &H2

Const ADS_SD_CONTROL_SE_OWNER_DEFAULTED       = &H1



'Security Descriptor Dictionary for Flag enumeration

Set SDCtlD = CreateObject("Scripting.Dictionary")

SDCtlD.Add ADS_SD_CONTROL_SE_SACL_PROTECTED, "ADS_SD_CONTROL_SE_SACL_PROTECTED"

SDCtlD.Add ADS_SD_CONTROL_SE_DACL_PROTECTED, "ADS_SD_CONTROL_SE_DACL_PROTECTED"

SDCtlD.Add ADS_SD_CONTROL_SE_SACL_AUTO_INHERITED, _

                                        "ADS_SD_CONTROL_SE_SACL_AUTO_INHERITED"



SDCtlD.Add ADS_SD_CONTROL_SE_DACL_AUTO_INHERITED, _

                                        "ADS_SD_CONTROL_SE_DACL_AUTO_INHERITED"

SDCtlD.Add ADS_SD_CONTROL_SE_SACL_AUTO_INHERIT_REQ, _

                                      "ADS_SD_CONTROL_SE_SACL_AUTO_INHERIT_REQ"

SDCtlD.Add ADS_SD_CONTROL_SE_DACL_AUTO_INHERIT_REQ, _

                                      "ADS_SD_CONTROL_SE_DACL_AUTO_INHERIT_REQ"

SDCtlD.Add ADS_SD_CONTROL_SE_SACL_DEFAULTED, "ADS_SD_CONTROL_SE_SACL_DEFAULTED"

SDCtlD.Add ADS_SD_CONTROL_SE_SACL_PRESENT, "ADS_SD_CONTROL_SE_SACL_PRESENT"

SDCtlD.Add ADS_SD_CONTROL_SE_DACL_DEFAULTED, "ADS_SD_CONTROL_SE_DACL_DEFAULTED"

SDCtlD.Add ADS_SD_CONTROL_SE_DACL_PRESENT, "ADS_SD_CONTROL_SE_DACL_PRESENT"

SDCtlD.Add ADS_SD_CONTROL_SE_GROUP_DEFAULTED, "ADS_SD_CONTROL_SE_GROUP_DEFAULTED"

SDCtlD.Add ADS_SD_CONTROL_SE_OWNER_DEFAULTED, "ADS_SD_CONTROL_SE_OWNER_DEFAULTED"



'Flags constants

Const ADS_FLAG_INHERITED_OBJECT_TYPE_PRESENT = &H2

Const ADS_FLAG_OBJECT_TYPE_PRESENT           = &H1



'Flags Dictionary for Flag enumeration

Set FlagsD = CreateObject("Scripting.Dictionary")

FlagsD.Add ADS_FLAG_INHERITED_OBJECT_TYPE_PRESENT, _

                               "ADS_FLAG_INHERITED_OBJECT_TYPE_PRESENT"

FlagsD.Add ADS_FLAG_OBJECT_TYPE_PRESENT, "ADS_FLAG_OBJECT_TYPE_PRESENT"



' Misc Constants

Const ADS_SECURITY_INFO_SACL   = &H8

Const ADS_SECURITY_INFO_DACL   = &H4

Const ADS_SECURITY_INFO_GROUP  = &H2

Const ADS_SECURITY_INFO_OWNER  = &H1

Const ADS_OPTION_SECURITY_MASK = &H3         ' Security mask for options

Const ADS_OPTION_SERVERNAME = 0

Const E_ADS_PROPERTY_NOT_FOUND = &H8000500D  ' Property not found in cache



'Main Script Logic Begin

'Retrieve parameter, display usage if necessary

If (WScript.Arguments.Count <> 1) Then

  Out "Usage: sdlist ADsPath"

  Out "   Ex: sdlist LDAP://dc=mycorp,dc=com"

  WScript.Quit

End If

strLDAPPath=WScript.Arguments.item(0)



'Bind to object

Out "Opening object - " & strLDAPPath

Set objObject = GetObject(strLDAPPath)

strDC = objObject.GetOption(ADS_OPTION_SERVERNAME)

Out "Using domain controller: " & strDC



'Connect to RootDSE, retrieve Schema/Config NCs

Out "Opening RootDSE"

Set objRootDSE = GetObject("LDAP://" & strDC & "/RootDSE")

strSchemaPath = objRootDSE.Get("schemaNamingContext")

strConfigPath = objRootDSE.Get("configurationNamingContext")



'Connect to schema and retrieve schemaIDGUIDs of attributes and classes

'  schemaIDGUID attribute is an octet string

'Build dictionary object to hold values

Out "Opening Schema"

Set objSchema = GetObject("LDAP://" & strSchemaPath)

Out "Retrieving classes and attributes"

objSchema.Filter=Array("attributeSchema","classSchema")

Set SchemaGuids = CreateObject("Scripting.Dictionary")

For Each objEnum In objSchema

  strGUID=GuidToStr(objEnum.schemaIDGUID)

  SchemaGuids.add UCase(strGUID),objEnum.lDAPDisplayName

Next



'Connect to extended-rights container and retrieve rightsGuids of CA objects

'  rightsGuid is a unicode string

'Build dictionary object to hold values

'  handle validated writes special, MS duplicated a rightsGuid

Out "Opening Extended-Rights container"

Set objExtRights = GetObject("LDAP://cn=extended-rights," & strConfigPath)

Out "Retrieving Property Sets, Extended Rights, and Validated Rights"

objExtRights.Filter=Array("controlAccessRight")

Set CARGuids = CreateObject("Scripting.Dictionary")

For Each objEnum In objExtRights

  strGUID="{" & objEnum.rightsGuid & "}"

  if objEnum.validAccesses = 8 then strGUID = "VWRITE - " & strGUID

  CARGuids.add UCase(strGUID),objEnum.displayName

Next



'Retrieve Security Descriptor

'  Need to check if the property not found in cache error was thrown as it

'  indicates person running script has insufficient rights



On Error Resume Next

Set objSD = objObject.Get("nTSecurityDescriptor")

If Err = E_ADS_PROPERTY_NOT_FOUND Then

  Out ""

  Out "You do not have access to the DACL..."

  WScript.Quit

End If

On Error Goto 0



'Write out the SDs general information

Out ""

Out "=================================================================="

Out "Security Descriptor"

Out "  SD revision is : " & objSD.Revision

Out "  SD Owner is    : " & objSD.Owner

Out "  SD Group is    : " & objSD.Group

Out "  Control Flags " & HexStr(objSD.Control)

DisplayFlags GetFlagStrs(objSD.Control,SDCtlD),"      "

Out "++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++"



'Write out the DACL general information

Set objDACL = objSD.DiscretionaryAcl

Out "Discretionary ACL"

Out "  DACL revision : " & objDACL.AclRevision

Out "  DACL ACE Count: " & objDACL.AceCount

Out "------------------------------------------------------------------"



'Loop through ACEs

EnumACEs(objDACL)

Out "------------------------------------------------------------------"

Out "------------------------------------------------------------------"



'Retrieve SACL

'   The SACL requires enhanced permissions to retrieve. Because of this

'   and how the Security Interface works, the script disconnects from the

'   the object and reconnects and attempts to set the options to retrieve

'   the SACL. If it fails, throw an error.

Set objObject = Nothing

Set objObject = GetObject(strLDAPPath)

objObject.SetOption ADS_OPTION_SECURITY_MASK, ADS_SECURITY_INFO_OWNER _

                                           Or ADS_SECURITY_INFO_GROUP _

                                           Or ADS_SECURITY_INFO_DACL _

                                           Or ADS_SECURITY_INFO_SACL



On Error Resume Next

Set objSD = objObject.Get("nTSecurityDescriptor")

If Err = E_ADS_PROPERTY_NOT_FOUND Then

  Out ""

  Out "You do not have access to the SACL..."

  WScript.Quit

End If

On Error Goto 0



'Write out the SACL general information

Set objSACL = objSD.SystemAcl

Out "System ACL"

Out "  SACL revision : " & objSACL.AclRevision

Out "  SACL ACE Count: " & objSACL.AceCount

Out "------------------------------------------------------------------"



'Loop through ACEs

EnumACEs(objSACL)

Out "------------------------------------------------------------------"



'Main Script Logic End

'Subroutines



'Output Routine, change this routine to redirect output

Sub Out(str)

  WScript.Echo str

End Sub



'Convert a binary GUID to a string GUID

'   Convert GUID octet string to Hex characters then arrange in proper order

'   and add brackets {}

Function GuidToStr(Guid)

  Dim i, str

  str = " "

  For i = 1 To Lenb(Guid)

    str = str & Right("0" & Hex(Ascb(Midb(Guid, i, 1))), 2)

  Next



  GuidToStr = "{"

  For i = 1 to 4

    GuidToStr = GuidToStr & Mid(str,10-(i*2),2)

  Next

  GuidToStr = GuidToStr & "-"

  For i = 1 to 2

    GuidToStr = GuidToStr & Mid(str,14-(i*2),2)

  Next

  GuidToStr = GuidToStr & "-"

  For i = 1 to 2

    GuidToStr = GuidToStr & Mid(str,18-(i*2),2)

  Next

  GuidToStr = GuidToStr & "-"

  For i = 1 to 2

    GuidToStr = GuidToStr & Mid(str,16+(i*2),2)

  Next

  GuidToStr = GuidToStr & "-"

  For i = 1 to 6

    GuidToStr = GuidToStr & Mid(str,20+(i*2),2)

  Next

  GuidToStr = GuidToStr & "}"

End Function



'Convert integer to Hexidecimal string for output - format (0xnnnn)

Function HexStr(val)

  HexStr = "(0x" & Hex(val) & ")"

End Function



'Get list of Flag strings for given bit flag value and Dictionary

'  Loops through the keys of a dictionary object and executes a bitwise-AND

'  against value and each key. If there is a match, adds key's matching item

Function GetFlagStrs(val,ByRef dict)

  Dim keys, keycnt, i, ar(), flgcnt

  flgcnt=0

  keys = dict.Keys

  keycnt = UBound(keys)

  For i = 0 To keycnt

    If ((val and keys(i)) = keys(i)) Then

      Redim Preserve ar(flgcnt)

      ar(flgcnt) = dict(keys(i)) & "  " & HexStr(keys(i))

      flgcnt = flgcnt + 1

    End If

  Next

  GetFlagStrs=ar

End Function



'Loop through Array and display strings with fill padding

Sub DisplayFlags(ar,fill)

  Dim str

  For Each str In ar

    Out fill & str

  Next

End Sub



'Convert ACETYPE value to string

'   ACETYPE is NOT a bitflag attribute.

Function AceTypeToStr(acetype)

  Select Case acetype

    Case ADS_ACETYPE_SYSTEM_AUDIT_OBJECT

      AceTypeToStr = "ADS_ACETYPE_SYSTEM_AUDIT_OBJECT"

    Case ADS_ACETYPE_ACCESS_DENIED_OBJECT

      AceTypeToStr = "ADS_ACETYPE_ACCESS_DENIED_OBJECT"

    Case ADS_ACETYPE_ACCESS_ALLOWED_OBJECT

      AceTypeToStr = "ADS_ACETYPE_ACCESS_ALLOWED_OBJECT"

    Case ADS_ACETYPE_SYSTEM_AUDIT

      AceTypeToStr = "ADS_ACETYPE_SYSTEM_AUDIT"

    Case ADS_ACETYPE_ACCESS_DENIED

      AceTypeToStr = "ADS_ACETYPE_ACCESS_DENIED"

    Case ADS_ACETYPE_ACCESS_ALLOWED

      AceTypeToStr = "ADS_ACETYPE_ACCESS_ALLOWED"

    Case Else

      AceTypeToStr = "Unknown"

  End Select

  AceTypeToStr = AceTypeToStr & " " & HexStr(acetype)

End Function



'Resolves a GUID to a schema objects or a Control Access Right object

Function GuidToObj(guid, access)

  Dim str

  guid = UCase(guid)

  If (guid <> "") Then

    If (SchemaGuids.Exists(guid)) Then

      str = SchemaGuids(guid)

    End If

    If (str = "") Then

      If (access and ADS_RIGHT_DS_SELF) Then

        guid = "VWRITE - " & guid

      End If

      If (CARGuids.Exists(guid)) Then

        str = CARGuids(guid)

      End If

    End If

    If (str = "") Then str = "_ _UNKNOWN_ _"

    GuidToObj = str & " (" & guid & ")"



  Else

    GuidToObj = "_ _NONE_ _"

  End If

End Function



'Loop through ACES from ACL and display information about each ACE

Sub EnumACEs(ByRef objACL)

  dim intACECount

  intACECount = 1

  For Each objACE In objACL

    Out "  ACE #" & intACECount

    Out "     Trustee               : " & objACE.Trustee

    Out "     AceType               : " & AceTypeToStr(objACE.AceType)

    Out "     AceFlags " & HexStr(objACE.AceFlags)

    DisplayFlags GetFlagStrs(objACE.AceFlags,ACEFlagsD), "        "

    Out "     Access Mask Flags " & HexStr(objACE.AccessMask)

    DisplayFlags GetFlagStrs(objACE.AccessMask,AccMaskD), "        "

    Out "     Flags " & HexStr(objACE.Flags)

    DisplayFlags GetFlagStrs(objACE.Flags,FlagsD), "        "

    Out "     Object Type           : " _

                & GuidToObj(objACE.ObjectType,objACE.AccessMask)

    Out "     Inherited Object Type : " _

       & GuidToObj(objACE.InheritedObjectType,objACE.AccessMask)

    Out ""

    intAceCount = intACECount + 1

  Next

End Sub