AutenticaAD

 Private Function AutenticaAD(ByVal ipServer As String, ByVal username As String, ByVal pwd As String) As Boolean
        'Instancia um novo Objeto active directory passando o caminho(ip do servidor) o username e password
        Dim entry As DirectoryEntry = New DirectoryEntry("LDAP://" & ipServer, username, pwd)
        Try
            'Bind to the native AdsObject to force authentication.

            Dim obj As Object = entry.NativeObject
            Dim search As DirectorySearcher = New DirectorySearcher(entry)

            search.Filter = "(SAMAccountName=" & username & ")"
            search.PropertiesToLoad.Add("cn")

            Dim result As SearchResult = search.FindOne

            If (result Is Nothing) Then
                Return False
            End If

        Catch ex As Exception
            Return False
        End Try

        Return True
    End Function