Authenticate Users with ADSI / LDAP
Public Function LDAPAuthenticate(strUserName As String, strPassword As String, _
          strDomain As String) As Boolean
' Purpose   Authenticate a User against his/her Active Directory Domain via ADSI
'           Accepts 3 Input Prams
'               UserName    is Not Case Sensitive
'               Password    IS Case Sensitive
'               Domain      Can either be a computer name or a Dotted IP Address
'           Returns True If Username/Password Authenticates - False Otherwise
'           Uses Late Binding - Therefore does NOT require any reference to be set
' Author    Ron Weiner
'           Copyright 2004-2005 WorksRite Software Solutions
'           You may use this code example for any purpose what-so-ever with
'           acknowledgement. However, you may not publish the code without
'           the express, written permission of the author.

    Dim objRootDSE As Object, objDSO As Object, objIAD As Object
    Dim strDefaultNamingContext As String
    Dim strQualifiedUserNamesuffix As String, strADsPath As String

    On Error Resume Next

    If Len(strDomain) > 0 Then
        If Right(strDomain, 1) <> "/" Then
            ' If a ServerName OR Dotted IP was supplied without a backslash add one
            strDomain = strDomain & "/"
        End If
    End If

    ' Get default naming context
    Set objRootDSE = GetObject("LDAP://" & strDomain & "RootDSE")
    If Err.Number <> 0 Then
        LDAPAuthenticate = False
        Exit Function
    End If
    strDefaultNamingContext = objRootDSE.Get("defaultNamingContext")
    Set objRootDSE = Nothing

    ' Will need to supply a fully qualified username to insure success
    ' When Done it should look like UserName@Something.SomethingElse
    strQualifiedUserNamesuffix = "@" & Trim(Replace(Replace(strDefaultNamingContext, _
        "DC=", ""), ",", "."))

    ' Create a LDAP string for the specified server using our Default Naming Context
    strADsPath = "LDAP://" & strDomain & "CN=Users," & strDefaultNamingContext

    ' Get the IADsOpenDSObject
    Set objDSO = GetObject("LDAP:")
    Set objIAD = objDSO.OpenDSObject(strADsPath, strUserName & strQualifiedUserNamesuffix, _

    If Err.Number <> 0 Then
        ' Any Non ZERO error code indicates failure to bind to the object
        LDAPAuthenticate = False
        LDAPAuthenticate = True
    End If

    ' Destroy our objects - and we are done
    Set objIAD = Nothing
    Set objDSO = Nothing
End Function


Copyright 2001 WorksRite Software Solutions -- Last Updated 06/13/05
Problems with this site? Please contact the with your comments, questions, or suggestions.