使用ldap身份验证的MS Access 2010

Question

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

以下是我从这里学到的

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

    On Error GoTo LDAP_Error

    username = "sharifu"
    passwd = "xxx"

    Const ADS_SCOPE_SUBTREE = 2

    Dim LDAPPath As String
    LDAPPath = "LDAP://172.16.0.12/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") = "domain\" & 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
    Exit Function

LDAP_Error:

    If Err.Number = -2147217911 Then

    MsgBox "Incorrect PeopleSoftID or Password!", vbExclamation, "HILDA"

    Else

    MsgBox "Error : " & Err.Description & " " & Err.Number, vbExclamation, "HILDA"

    End If
    CheckUser = False

    conn.Close


End Function

我收到的错误是

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

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

方法'ActiveConnection'的对象'_Command'失败，但它可能来自其他地方在我的代码.我将如何检查，如果ldap是成功的？

Answer 1

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

1. 添加了检查数据库中是否存在该用户。
2. 将LDAP路径中的“OU=Sites”更改为“CN=Users”

LDAPPath="LDAP：//替换为IP或DNS名称/CN=用户；DC=替换为不带. com的域名；DC=替换为com、net或根节点名称"

完整的例子：

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

或者

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

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

Answer 2

我有固定的问题。

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