VBScript Query All Domain Controllers for a User Account Status

Query all domain controllers for the status of a specified user account. This can come in handy when there are suspected replication problems in AD and some domain controllers are not up to date on a given account (locked, disabled, modified, etc.).

Const userid = "ServiceAccount20"
Const ou = "OU=ServiceAccounts,OU=IT,OU=Corp,DC=contoso,DC=com"

Const pageSize = 1000
Const ADS_SCOPE_SUBTREE = 2

Set dso = GetObject("LDAP:")

'----------------------------------------------------------------

Function Domain_LDAP()
    Dim retval, objRootDSE
    Set objRootDSE = GetObject("LDAP://RootDSE")
    retval = objRootDSE.Get("defaultNamingContext")
    Domain_LDAP = retval
End Function

'----------------------------------------------------------------
' function: 
'----------------------------------------------------------------

Function CName(strval)
    Dim tmp
    tmp = Replace(strval, "CN=NTDS Settings,CN=", "")
    CName = Split(tmp, ",")(0)
End Function

'----------------------------------------------------------------
' function: 
'----------------------------------------------------------------

Function DomainControllers()
    Dim objConnection, objCommand, objRecordSet
    Dim dn, retval : retval = ""

    dcn = Domain_LDAP()

    Set objConnection = CreateObject("ADODB.Connection")
    Set objCommand = CreateObject("ADODB.Command")
    objConnection.Provider = "ADsDSOObject"
    objConnection.Properties("ADSI Flag") = 1
    objConnection.Open "Active Directory Provider"

    Set objCommand.ActiveConnection = objConnection

    objCommand.CommandText = _
        "SELECT distinguishedName FROM " & _
        "'LDAP://cn=Configuration," & dcn & "' " & _
        "WHERE objectClass='nTDSDSA'"

    objCommand.Properties("Page Size") = pageSize
    objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE

    Set objRecordSet = objCommand.Execute
    objRecordSet.MoveFirst

    wscript.echo "info: querying for list of domain controllers..."

    Do Until objRecordSet.EOF
        dn = objRecordSet.Fields("distinguishedName").Value
        If retval <> "" Then
            retval = retval & vbTab & dn
        Else
            retval = dn
        End If
        objRecordSet.MoveNext
    Loop
    DomainControllers = retval
End Function

'----------------------------------------------------------------

wscript.echo "info: user account = " & userid
dclist = DomainControllers()

wscript.echo "info: querying user account status from each domain controller..."

For each strDC in Split(dclist, vbTab)
    cn = CName(strDC)
    dcn = Replace(strDC, "CN=NTDS Settings,", "")
 
    Set objUser = GetObject("LDAP://" & cn & "/CN=" & userid & "," & ou)
    On Error Resume Next
 
    ' refer to http://support.microsoft.com/kb/305144
 
    uac = objUser.Get("userAccountControl")
    If err.Number <> 0 Then
        wscript.echo err.Number & " - " & err.Description
    Else
        ' add more cases below if you prefer, or logand the results
        Select Case uac
            Case 512: wscript.echo "info: " & cn & " = normal"
            Case 16: wscript.echo "info: " & cn & " = locked"
            Case 2: wscript.echo "info: " & cn & " = disabled"
            Case 65536: wscript.echo "info: " & cn & " = never-expires"
            Case Else: wscript.echo "info: " & cn & " = unknown: " & uac
        End Select
    End If
Next

VBScript / ASP Secure LDAP Query of User Group Membership

Check if a user is a member of a specified domain security group using a secure LDAP query with ADsDSoObject provider. Works for ASP and VBScript using a specified domain service/proxy user account (when anonymous LDAP is disabled).

Example:
If IsMemberOf("SalesManagers", "JohnDoe") Then
    Response.Write "is a member"
End If

Const ldap_user = "domain\useraccount"
Const ldap_pwd  = "P@ssW0rd$"
Const ou = "OU=Sales,OU=North America,OU=Corp,DC=contoso,DC=com"
Const ADS_SCOPE_SUBTREE = 2

Function IsMemberOf(groupName, uid)
    Dim objConnection, objCommand, objRecordSet
    Dim retval : retval = False
    Dim i, gplen : gplen = Len(groupName)+3
 
    On Error Resume Next
    Set objConnection = CreateObject("ADODB.Connection")
    Set objCommand =   CreateObject("ADODB.Command")
 
    objConnection.Provider = "ADsDSOObject"
    objConnection.Properties("User ID")  = ldap_user
    objConnection.Properties("Password") = ldap_pwd
    objConnection.Properties("Encrypt Password") = TRUE
    objConnection.Properties("ADSI Flag") = 1
    objConnection.Open "Active Directory Provider"

    Set objCommand.ActiveConnection = objConnection

    objCommand.Properties("Page Size") = 1000
    objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
    objCommand.CommandText = "SELECT memberof FROM 'LDAP://" & ou & "' " & _
        "WHERE objectCategory='user' AND sAMAccountName='" & uid & "'"

    Set objRecordSet = objCommand.Execute

    objRecordSet.MoveFirst
    Do Until objRecordSet.EOF
        For i = 0 to objRecordSet.Fields.Count -1
            For each m in objRecordSet.Fields("memberof").value
                If Left(Ucase(m),gplen) = Ucase("CN=" & groupname) Then
                    retval = True
                End If
            Next
        Next
        objRecordSet.MoveNext
    Loop
    objRecordSet.Close
    Set objRecordSet = Nothing
    Set objCommand = Nothing
    Set objConnection = Nothing
    IsMemberOf = retval
End Function

VBScript / ASP Secure LDAP User Query

Query Active Directory using a service/proxy user account from within VBScript or an ASP web page. Returns results as a tab-delimited string, where each token is sub-delimited using a pipe character "|".

example:
x = GetUserData("JohnDoe", "ADsPath, mail, department, givenName, sn")
 
For each v in Split(x, vbTab)
    response.write Replace(v, "|", " = ") & "<br/>"
Next

Const ldap_user = "domain\useraccount"
Const ldap_pwd  = "P@ssW0rd$"
Const ou = "OU=Sales,OU=North America,OU=Corp,DC=contoso,DC=com"

Function GetUserData(uid, fields)
    Const ADS_SCOPE_SUBTREE = 2
    Dim objConnection, objComment, objRecordSet
    Dim retval : retval = ""
    Dim i, fieldname, strvalue
 
    On Error Resume Next
    Set objConnection = CreateObject("ADODB.Connection")
    Set objCommand    = CreateObject("ADODB.Command")
 
    objConnection.Provider = "ADsDSOObject"
    objConnection.Properties("User ID")  = ldap_user
    objConnection.Properties("Password") = ldap_pwd
    objConnection.Properties("Encrypt Password") = TRUE
    objConnection.Properties("ADSI Flag") = 1
    objConnection.Open "Active Directory Provider"
 
    Set objCommand.ActiveConnection = objConnection

    objCommand.Properties("Page Size") = 1000
    objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
    objCommand.CommandText = "SELECT " & fields & _
        " FROM 'LDAP://" & ou & "' " & _
        "WHERE objectCategory='user' AND sAMAccountName='" & uid & "'"

    Set objRecordSet = objCommand.Execute

    objRecordSet.MoveFirst
    Do Until objRecordSet.EOF
        For i = 0 to objRecordSet.Fields.Count -1
            fieldname = objRecordSet.Fields(i).Name
            strvalue = objRecordSet.Fields(i).Value
            If retval <> "" Then
                retval = retval & vbTab & fieldname & "|" & strValue
            Else
                retval = fieldname & "|" & strValue
            End If
        Next
        objRecordSet.MoveNext
    Loop
    GetUserData = retval
End Function

VBScript Enumerate AD OUs and Containers

Dim objDSE, strDefaultDN, strDN, objContainer, objChild
Const enumContainersAlso = False

Set objRootDSE = GetObject("LDAP://rootDSE")
strDefaultDN = Domain_LDAP()
Set objContainer = GetObject("LDAP://" & strDefaultDN)

Call ListObjects(objContainer, "")

Function Domain_LDAP()
    Dim retval
    retval = objRootDSE.Get("defaultNamingContext")
    Domain_LDAP = retval
End Function

Function Domain_NetBIOS(ldapdn)
 Domain_NetBIOS = Replace(Replace(ldapdn,"DC=",""),",",".")
End Function

Sub ListObjects(objADObject, strSpace)
    Dim objChild
    For Each objChild in objADObject
        Select Case objChild.Class
            Case "organizationalUnit":
                objName = Mid(objChild.Name,4)
                objContainer = objChild.distinguishedName
                wscript.echo strSpace & "(o) " & objName
                Call ListObjects(objChild, "....")
            Case "container":
                If enumContainersAlso Then
                    objName = Mid(objChild.Name,4)
                    objContainer = objChild.distinguishedName
                    wscript.echo strSpace & "(c) " & objName
                End If
                Call ListObjects(objChild, "....")
        End Select
    Next
End Sub

VBScript Get Active Directory Environment Data

Set objRootDSE = GetObject("LDAP://rootDSE")
 
wscript.Echo "defaultNamingContext = " & objRootDSE.Get("defaultNamingContext")
wscript.Echo "rootdomainNamingContext = " & objRootDSE.Get("rootDomainNamingContext")
wscript.Echo "configurationNamingContext = " & objRootDSE.Get("configurationNamingContext")
wscript.Echo "dnsHostName = " & objRootDSE.Get("dnsHostName")
wscript.echo "CN: " & GetCN(objRootDSE.Get("defaultNamingContext"))

Function GetCN(dn)
    Dim retval
    retval = Split(dn, ",")
    GetCN = Mid(retval(0),4)
End Function

LDAP Query for User Accounts Created Since a Specific Date

Just modify the date string to use the YYYYMMDDHHMMSS.0Z format. So, for June 1, 2009, you would specify "20090601000000.0Z"

(&(objectCategory=user)(whenCreated>=20090601000000.0Z))

LDAP Query for Printers = HP DesignJet Plotters

(&(&
(uncName=*)
(objectCategory=printQueue)
(objectCategory=printQueue)
(driverName=*DesignJet*)
))

LDAP Query for Windows Server 2003 SP1 Computers in AD

(&(&(&(&(&(&(&(&(&(&
(objectCategory=Computer)
(operatingSystem=Windows Server 2003*)
(operatingSystemServicePack=Service Pack 1)
))))))))))