Active Directory


Well-known member
May 14, 2009
Programming Experience
I am creating a front end search app for AD. I have two functions both of which work, however they both have some faults.

I generally search with a either a partial name, first name, or last name so I need to use wild card searching.

This first function returns data however I cannot figure out how to return multiple results.
    Public Function GetUserInfo(ByVal strDOMAIN As String, ByVal strUSER As String, ByVal strPASSWORD As String) As List(Of clsuser)
        'Dim SortedList2 As New System.Collections.SortedList
        Dim strlname As String
        Dim strfname As String
        Dim strvalue As TextInfo = New CultureInfo("en-US", False).TextInfo
        Dim strfullname As String
        Dim stremail As String
        Dim strdescription As String
        Dim objuser As New clsuser
        Dim lstobjuser As New List(Of clsuser)

        If Not String.IsNullOrEmpty(strDOMAIN) Then
            Dim myDirectoryEntry As DirectoryEntry = New DirectoryEntry(String.Format("LDAP://{0}", strDOMAIN))
            Dim mySearcher As DirectorySearcher = New DirectorySearcher(myDirectoryEntry)
            mySearcher.Filter = "(cn=*" & strUSER & "*)"
            mySearcher.SearchScope = SearchScope.Subtree
            Dim result As SearchResult = mySearcher.FindOne()
            Dim directoryObject As DirectoryEntry = result.GetDirectoryEntry()

            'Update the new path to the user in the directory.
            _path = result.Path
            _filterAttribute = CType(result.Properties("cn")(0), String)

            'Get the last name
            mySearcher.Filter = "(SAMAccountName=" & strUSER & ")"
            Dim result2 As SearchResult = mySearcher.FindOne()

                strlname = CType(result2.Properties("sn")(0), String)

                'now the fisrt name
                mySearcher.Filter = "(SAMAccountName=" & strUSER & ")"
                Dim result3 As SearchResult = mySearcher.FindOne()

                strfname = CType(result3.Properties("givenName")(0), String)

                'format the name
                strfname = LCase(strfname)
                strlname = LCase(strlname)

                strfullname = strvalue.ToTitleCase(strfname & " " & strlname)

                objuser.FullName = strfullname

            Catch ex1 As Exception
                If Not strUSER Like "helpdesk" AndAlso Not strUSER Like "pcguys" Then
                    Throw New ArgumentException("Error")
                End If
            End Try

                'now get the email
                mySearcher.Filter = "(SAMAccountName=" & strUSER & ")"
                Dim result5 As SearchResult = mySearcher.FindOne()

                stremail = CType(result5.Properties("mail")(0), String)

                objuser.EmailAddress = stremail

            Catch e As Exception
                If InStr(e.Message, "Index") <> 0 Then
                    'The user does not have a valid email account
                End If
            End Try

                'now get the description
                mySearcher.Filter = "(SAMAccountName=" & strUSER & ")"
                Dim result5 As SearchResult = mySearcher.FindOne()

                strdescription = CType(result5.Properties("description")(0), String)

                objuser.Description = strdescription

            Catch e As Exception
                If InStr(e.Message, "Index") <> 0 Then
                    'The user does not have a valid email account
                End If
            End Try
        End If

        Return lstobjuser

    End Function

This second function is awsome in that it is clean and easy to understand however the biggest problem is that it seems that not all the properties are avaliable like the description field which I reall need.
    Public Function badpass(ByVal strvalue As String) As DataTable
        Dim adoCommand, adoConnection, strBase
        Dim objRootDSE, strDNSDomain, adoRecordset
        Dim strquery As String

        Const adUseClient = 3

        ' Setup ADO objects.
        adoCommand = CreateObject("ADODB.Command")
        adoConnection = CreateObject("ADODB.Connection")
        adoConnection.Provider = "ADsDSOObject"
        adoConnection.cursorLocation = adUseClient
        adoConnection.Open("Active Directory Provider")
        adoCommand.ActiveConnection = adoConnection

        ' Search entire Active Directory domain.
        objRootDSE = GetObject("LDAP://RootDSE")
        strDNSDomain = objRootDSE.Get("defaultNamingContext")
        strBase = "'LDAP://" & strDNSDomain & "'"

        strquery = "SELECT cn, mail, displayname,   FROM  " & strBase & " where objectCategory='Person' and objectClass='User' and cn = '*" & strvalue & "*'" 

        adoCommand.CommandText = strquery

        ' Run the query.
        adoRecordset = adoCommand.Execute

        'convert recordset to datatable for datagridview datasource
        Dim dgvdt As DataTable
        dgvdt = RecordSetToDataTable(adoRecordset)


        Return dgvdt

    End Function

    Public Function RecordSetToDataTable(ByVal objRS As ADODB.Recordset) As DataTable
        Dim objDA As New OleDbDataAdapter()
        Dim objDT As New DataTable()
        objDA.Fill(objDT, objRS)
        Return objDT
    End Function

Any help would be a great help.

Top Bottom