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    rweiner@WorksRite.com
'           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
    Const ADS_SECURE_AUTHENTICATION = 1

    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, _
        strPassword, ADS_SECURE_AUTHENTICATION)

    If Err.Number <> 0 Then
        ' Any Non ZERO error code indicates failure to bind to the object
        LDAPAuthenticate = False
    Else
        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 Webmaster@WorksRite.com with your comments, questions, or suggestions.