Tuesday, July 6, 2010

LDAP query

I needed to find out how to query the active directory database easily and so looked into how to script an LDAP query. Code below shows the basics of the simple query based on the LDAP://rootdse object and a recordset connection to perform the query.

Function LDAPsearch (strSearch,strQ)
'set variable to hold required amount of attributes
Dim aResults(4)

'set LDAP defaults to root domain
Set rootDSE = GetObject("LDAP://RootDSE")
DomainContainer = rootDSE.Get("defaultNamingContext")

'create recordset connection
Set conn = CreateObject("ADODB.Connection")
conn.Provider = "ADSDSOObject"
conn.Open "ADs Provider"

'set query, using strQ for searched FOR item and strSearch as search ON string
ldapStr = ";(" & strQ & "=" & strSearch & "*);adspath;Subtree"

'execute LDAP query
Set rs = conn.Execute(ldapStr)

'look for records that meet the query
While Not rs.EOF

'FoundObject is a successful find for query
Set FoundObject = GetObject (rs.Fields(0).Value)

'put results into array with tags
aResults(0) = FoundObject.employeeID
aResults(1) = FoundObject.displayName
aResults(2) = FoundObject.userPrincipalName
aResults(3) = FoundObject.sAMAccountName
aResults(4) = FoundObject.telephoneNumber

'goto next record
rs.MoveNext

'concatenate attributes to string
For i = 0 To 4
strResult = strResult & aResults(i)
Next

'count results (searches may produce multiple results)
iCount = iCount + 1

'add newline results string
strResult = strResult & vbnewline

'continue until no further records are found
Wend
End Function

Posted by at
Labels: , , , ,

1 comment:

  1. PaulSeptember 19, 2011 at 10:38 PM

    An update on the ldap query.

    I recently had to connect to a different domain, namely our email domain, to obtain alternative attributes of users. It took quite a while to suss it, but a worthwhile endeavor.

    Below is the code that allows an ado recordset object to connect. Note real domain name, username and password have been 'dummified'...


    Function LDAPsearch(strSearch) As String()
    On Error Resume Next

    Dim strDNSDomain, adoCommand, adoConnection
    Dim strBase, strFilter, strAttributes, strQuery, adoRecordset
    Dim strDN, strUser, strPassword, objNS, strServer, i As Integer

    Const ADS_SECURE_AUTHENTICATION = &H1
    Const ADS_SERVER_BIND = &H200

    Dim sResult(17) As String, strQ As String, S_Result(0) As String, _
    ldapStr As String, strNone(0) As String

    ' Specify a server (Domain Controller).
    strServer = "p.matz.com"

    ' Specify or prompt for credentials. update to prompt once testing completed
    strUser = "pmatz\user01"
    strPassword = "pa55word"

    strDNSDomain = "OU=Users,DC=p,DC=matz,DC=com"

    ' Use ADO to search Active Directory.
    ' Use alternate credentials.
    Set adoCommand = CreateObject("ADODB.Command")
    Set adoConnection = CreateObject("ADODB.Connection")
    adoConnection.Provider = "ADsDSOObject"
    adoConnection.Properties("User ID") = strUser
    adoConnection.Properties("Password") = strPassword
    adoConnection.Properties("Encrypt Password") = True
    adoConnection.Properties("ADSI Flag") = ADS_SERVER_BIND _
    Or ADS_SECURE_AUTHENTICATION
    adoConnection.Open "Active Directory Provider"
    Set adoCommand.ActiveConnection = adoConnection

    ' Search entire domain. Use server binding.
    strBase = ""

    ' Search for all users.
    strFilter = "(&(objectCategory=user)(objectClass=user)(mailNickname=" & strSearch & "*))"

    ' Comma delimited list of attribute values to retrieve.
    strAttributes = "division, displayName, co, company, department, givenName," & _
    " l, mail, manager, middleName, mobile, otherTelephone, postalCode," & _
    " sAMAccountName, sn, streetAddress, telephoneNumber, title"

    ' Construct the LDAP query.
    strQuery = strBase & ";" & strFilter & ";" _
    & strAttributes & ";subtree"

    ' Run the query.
    adoCommand.CommandText = strQuery
    adoCommand.Properties("Page Size") = 100
    adoCommand.Properties("Timeout") = 30
    adoCommand.Properties("Cache Results") = False
    Set adoRecordset = adoCommand.Execute
    ' Enumerate the resulting recordset.
    Do Until adoRecordset.EOF
    'put results into variable
    For i = 0 To 17
    sResult(i) = adoRecordset.Fields(i).Value & "#" & adoRecordset.Fields(i).Name
    Next i
    adoRecordset.MoveNext
    Loop

    ' Clean up.
    adoRecordset.Close
    adoConnection.Close
    LDAPsearchE2K = sResult()
    End Function

    ReplyDelete

Subscribe to: Post Comments (Atom)