Get all AD users (ADODB versus DirectorySearcher) performance issue.

I have 2 serprate functions, One uses an ADODB connection to Active directory and the other is using a DirectorySearcher object to get a "list" of all the user records in our domain.

The intent of this code it to get all our users telephone information from the Cisco Call Manager (LDAP) and import it into Active Directory (Win 2003).

The older method using ADODB is much quicker than the DirectorySearcher method, and the application rusn fine with it enabled. I would like to use the DirectorySearcher method as it doesnt require me to distribute any extra dll's with my application.

What is wrong with this and how could it be optimized to run more efficiently?

We have 2000+ users in AD. The ADODB method takes aprox. 10 sec to populate the array, while the DirectorySearcher method takes over 60sec.

Imports System
Imports System.IO
Imports System.DirectoryServices
Imports System.DirectoryServices.Protocols
Imports System.Net
Imports System.Text
Imports System.Runtime.InteropServices.COMException
Imports ADODB 'added via reference: C:\Program Files\Microsoft.NET\Primary Interop Assemblies\adodb.dll
 
Module modMain
 
    Sub Main()
        getADUsers_ADODB() '~10sec
        getADUsers_NEW() 'long time
    End Main
 
    Function getADUsers_ADODB()
        Dim arrADUsers As New ArrayList
 
        Try
            Dim oConn As New ADODB.Connection
            Dim oRS As New ADODB.Recordset
            Dim oComm As New ADODB.Command
            'Dim strComputerName As String = Nothing
            Dim strDomainName As String = "saws.org"
 
            ' set connection properties
            With oConn
                .Provider = "ADsDSOObject"
                .Open("Active Directory Provider")
            End With
 
            ' set command properties
            With oComm
                .ActiveConnection = oConn
                .CommandText = "<LDAP://DC=domain,DC=org>;(&(ObjectClass=user)(!ObjectClass=computer)(!description=Built-in*));sAMAccountName,employeeID,telephoneNumber,mail,distinguishedName"
            End With
 
            ' open recordset
            oRS = oComm.Execute
 
            If Not oRS.EOF Then
                oRS.MoveFirst()
                Do Until oRS.EOF
                    Dim arrADUser As New ArrayList
                    If Not oRS.Fields(0).Value.ToString = "" Then
 
                        arrADUser.Add(oRS.Fields(0).Value)
 
                        If Not oRS.Fields(1).Value.ToString = "" Then
                            arrADUser.Add(oRS.Fields(1).Value)
                        Else
                            arrADUser.Add("null")
                        End If
 
                        If Not oRS.Fields(2).Value.ToString = "" Then
                            arrADUser.Add(oRS.Fields(2).Value)
                        Else
                            arrADUser.Add("null")
                        End If
 
                        If Not oRS.Fields(3).Value.ToString = "" Then
                            arrADUser.Add(oRS.Fields(3).Value)
                        Else
                            arrADUser.Add("null")
                        End If
 
                        If Not oRS.Fields(4).Value.ToString = "" Then
                            arrADUser.Add(oRS.Fields(4).Value)
                        Else
                            arrADUser.Add("null")
                        End If
 
                    End If
                    arrADUsers.Add(arrADUser)
                    oRS.MoveNext()
                Loop
            End If
 
            ' clean up objects
            oRS.Close()
            oConn.Close()
            oRS = Nothing
            oComm = Nothing
            oConn = Nothing
 
 
        Catch ex As Exception
            Console.WriteLine()
            Console.WriteLine(ex.Message)
            Console.WriteLine()
            Console.WriteLine(ex.ToString)
        End Try
 
        Return arrADUsers
 
    End Function
 
 Function getADUsers_NEW()
        Dim arrADUsers As New ArrayList
 
        Try
            Dim de As DirectoryEntry = getDirectoryEntry()
            Dim ds As New DirectorySearcher(de)
 
            Dim filter As New StringBuilder
            filter.Append("(&(objectCategory=Person)(objectClass=user))")
 
            ds.Filter = filter.ToString
            ds.SearchScope = DirectoryServices.SearchScope.Subtree
            Dim results As SearchResultCollection = ds.FindAll
 
            Console.WriteLine("User COUNT: {0}", results.Count)
            Console.WriteLine()
 
            For Each result As SearchResult In results
                Dim dey As DirectoryEntry = getDirectoryEntry(result.Path)
                Console.WriteLine("User  : {0}", dey.Properties("sAMAccountName").Value)
                Console.WriteLine("Phone : {0}", dey.Properties("telephoneNumber").Value)
                Console.WriteLine()
                dey.Close()
            Next
 
            de.Close()
 
        Catch ex As Exception
            Console.WriteLine()
            Console.WriteLine(ex.Message)
            Console.WriteLine()
            Console.WriteLine(ex.ToString)
        End Try
 
        Return arrADUsers
 
    End Function
 
    Function getDirectoryEntry(Optional ByVal argPath As String = Nothing) As DirectoryEntry
        Dim de As New DirectoryEntry
        If argPath Is Nothing Then
            de.Path = "LDAP://DC=domain,DC=org"
        Else
            de.Path = argPath
        End If
        de.Username = "domain\username"
        de.Password = "password"
        Return de
    End Function
 
End Module

Select allOpen in new window