使用ldap身份验证的MS Access 2010

我正在尝试在ms access 2010中使用用户名和密码进行ldap身份验证。我似乎无法理解这一点，并在网上尝试了不同的代码，但似乎都不起作用。有人能帮忙吗

以下是我从中得到的信息

我收到的错误是

“错误：服务器无法运行。 -2147217865“

更改为ip地址立即获取以下错误

对象“\u Command”的方法“ActiveConnection”失败，但它可能来自代码中的其他地方。如何检查ldap是否成功？

我已经解决了这个问题

Function CheckUser(UserName As String, passwd As String, Level As Integer) As Boolean

    On Error GoTo LDAP_Error

    Const ADS_SCOPE_SUBTREE = 2

    Dim LDAPPath As String
    LDAPPath = "LDAP://akutan.country.domain.com/OU=Sites;DC=domain;DC=com"

    Dim conn As ADODB.Connection
    Dim cmd As ADODB.Command
    Dim rs As ADODB.Recordset

    Set conn = New ADODB.Connection
    Set cmd = New ADODB.Command
    conn.Provider = "ADsDSOObject"
    conn.Properties("User ID") = "xxx\" & UserName
    conn.Properties("Password") = "" & passwd
    conn.Properties("Encrypt Password") = True
    'conn.Properties("ADSI Flag") = 3
    conn.Open "Active Directory Provider"

    Set cmd.ActiveConnection = conn
    cmd.Properties("Page Size") = 1000
    cmd.Properties("Searchscope") = ADS_SCOPE_SUBTREE
    cmd.CommandText = "SELECT Name FROM '" & LDAPPath & "' WHERE " & "objectCategory='user'"

    Set rs = cmd.Execute
    rs.Close
    conn.Close

    CheckUser = True
    [TempVars]![CurrentUser] = UserName
    Call LogUser([TempVars]![CurrentUser], "Logon")
    Exit Function

LDAP_Error:

    If Err.Number = -2147217911 Then
        MsgBox "Incorrect PeopleSoftID or Password!", vbExclamation, "LDAP Authentication"
    Else
        MsgBox "Error : " & Err.Description & " " & Err.Number, vbExclamation, "LDAP Authentication"
    End If

    CheckUser = False
    conn.Close

End Function

---

为理解此代码和正确运行，进行少量更改和解释：

添加了检查数据库中是否存在该用户

将LDAP路径中的“OU=Sites”更改为“CN=Users”

LDAPPath=“LDAP://替换为IP或DNS名称/CN=用户；DC=替换为没有.com的域名；DC=替换为com、net或根节点名称”

在IP或DNS名称中，必须指定服务器IP或DNS名称

在第一个“DC”中，您必须指定没有.com或.net的域名，就像这个“google”

在第二个“DC”中，您必须指定intance“com”的域类型

完整示例：

LDAPPath = "LDAP://200.201.1.1/CN=Users;DC=google;DC=com"

或

在这一行中：conn.Properties（“用户ID”）=“替换为域名短名”\”&用户名

conn.Properties（“用户ID”）=“ggle\”和用户名

最后，这是完整的代码：

    Function ldapAuth(userName As String, passwd As String, level As Integer) As Boolean

    On Error GoTo LDAP_Error
    ldapAuth = False

    If Not IsNull(userName) And Not IsNull(passwd) Then

    'Check if the user exist in DB
    Dim db As DAO.Database
    Dim rst As DAO.Recordset
    Dim qdf As QueryDef
    Dim strSQL As String

    Set dbs = CurrentDb

    strSelect = "SELECT *"
    strFrom = " FROM employee"
    strWhere = " WHERE user_name = '" & userName & "';"
    strSQL = strSelect & strFrom & strWhere

    Debug.Print strSQL

    Set rst = dbs.OpenRecordset(strSQL, dbOpenDynaset)
    'If the recordset is empty, exit.
    If rst.EOF Then
        MsgBox "The user not exist in the DataBase!!!"
    Else
        'Check user with LDAP
        Const ADS_SCOPE_SUBTREE = 2

        Dim LDAPPath As String
        LDAPPath = "LDAP://ldap.google.com/CN=Users;DC=google;DC=com"

        Dim conn As ADODB.Connection
        Dim cmd As ADODB.Command
        Dim rs As ADODB.Recordset

        Set conn = New ADODB.Connection
        Set cmd = New ADODB.Command
        conn.Provider = "ADsDSOObject"
        conn.Properties("User ID") = "ggle\" & userName
        conn.Properties("Password") = "" & passwd
        conn.Properties("Encrypt Password") = True
        'conn.Properties("ADSI Flag") = 3
        conn.Open "Active Directory Provider"

        Set cmd.ActiveConnection = conn
        cmd.Properties("Page Size") = 1000
        cmd.Properties("Searchscope") = ADS_SCOPE_SUBTREE
        cmd.CommandText = "SELECT Name FROM '" & LDAPPath & "' WHERE " & "objectCategory='user'"

        Set rs = cmd.Execute
        rs.Close
        conn.Close

        'Set userId and Role Globally
        employeeId = rst![id]
        employeeType = rst![employee_type]
        TempVars.Add "employeeId", employeeId
        TempVars.Add "employeeType", employeeType

        'Log user login and role
        Debug.Print "User login: " & TempVars!employeeId
        Debug.Print "User Role: " & TempVars!employeeType

        ldapAuth = True

        rst.Close

      End If

    End If

    Exit Function

    LDAP_Error:

    If Err.Number = -2147217911 Then
    'MsgBox "Incorrect User or Password!", vbExclamation, "LDAP Authentication"
    Else
    MsgBox "Error : " & Err.Description & " " & Err.Number, vbExclamation, "LDAP Authentication"
    End If

    conn.Close

    End Function

您最好显示您实际尝试过的代码以及遇到的问题…如果使用简单的LDAP资源管理器（例如Apache DS），您可以连接并查询目录服务器吗？可以。这是我在php中的dn
$dn=“OU=Sites，DC=domain，DC=com”使用ip地址而不是dns名称。感谢代码，我可以添加什么来测试经过身份验证的用户是否属于特定组？身份验证后，可能会再次检查成员是否属于该组。我还没做呢
LDAPPath = "LDAP://ldap.google.com/CN=Users;DC=google;DC=com"

    Function ldapAuth(userName As String, passwd As String, level As Integer) As Boolean

    On Error GoTo LDAP_Error
    ldapAuth = False

    If Not IsNull(userName) And Not IsNull(passwd) Then

    'Check if the user exist in DB
    Dim db As DAO.Database
    Dim rst As DAO.Recordset
    Dim qdf As QueryDef
    Dim strSQL As String

    Set dbs = CurrentDb

    strSelect = "SELECT *"
    strFrom = " FROM employee"
    strWhere = " WHERE user_name = '" & userName & "';"
    strSQL = strSelect & strFrom & strWhere

    Debug.Print strSQL

    Set rst = dbs.OpenRecordset(strSQL, dbOpenDynaset)
    'If the recordset is empty, exit.
    If rst.EOF Then
        MsgBox "The user not exist in the DataBase!!!"
    Else
        'Check user with LDAP
        Const ADS_SCOPE_SUBTREE = 2

        Dim LDAPPath As String
        LDAPPath = "LDAP://ldap.google.com/CN=Users;DC=google;DC=com"

        Dim conn As ADODB.Connection
        Dim cmd As ADODB.Command
        Dim rs As ADODB.Recordset

        Set conn = New ADODB.Connection
        Set cmd = New ADODB.Command
        conn.Provider = "ADsDSOObject"
        conn.Properties("User ID") = "ggle\" & userName
        conn.Properties("Password") = "" & passwd
        conn.Properties("Encrypt Password") = True
        'conn.Properties("ADSI Flag") = 3
        conn.Open "Active Directory Provider"

        Set cmd.ActiveConnection = conn
        cmd.Properties("Page Size") = 1000
        cmd.Properties("Searchscope") = ADS_SCOPE_SUBTREE
        cmd.CommandText = "SELECT Name FROM '" & LDAPPath & "' WHERE " & "objectCategory='user'"

        Set rs = cmd.Execute
        rs.Close
        conn.Close

        'Set userId and Role Globally
        employeeId = rst![id]
        employeeType = rst![employee_type]
        TempVars.Add "employeeId", employeeId
        TempVars.Add "employeeType", employeeType

        'Log user login and role
        Debug.Print "User login: " & TempVars!employeeId
        Debug.Print "User Role: " & TempVars!employeeType

        ldapAuth = True

        rst.Close

      End If

    End If

    Exit Function

    LDAP_Error:

    If Err.Number = -2147217911 Then
    'MsgBox "Incorrect User or Password!", vbExclamation, "LDAP Authentication"
    Else
    MsgBox "Error : " & Err.Description & " " & Err.Number, vbExclamation, "LDAP Authentication"
    End If

    conn.Close

    End Function