Question

我正在尝试使用用户名和密码在ms access 2010中执行ldap身份验证。我似乎无法弄清楚这一点，并尝试在线尝试不同的代码，但似乎没有任何工作。有人可以帮忙吗？

以下是我从here

获取的内容

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地址立即获得以下错误

Method 'ActiveConnection' of object '_Command' failed但它可能来自我的代码中的其他地方。我如何检查ldap是否成功？

Answer 1

我已经解决了问题。

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

Answer 2

进行少量更改并解释以理解此代码并正确运行：

添加了检查用户是否存在于数据库中。
已更改＆＃34; OU =网站＆＃34;在LDAP路径中由＆＃34; CN = Users＆＃34;。

LDAPPath =＆＃34; LDAP：// 替换为IP或DNS名称 / CN =用户; DC = 替换为域名而不使用.com ; DC = 替换为com，net或root节点名称＆＃34;

在IP或DNS名称中，您必须指定服务器IP或DNS名称。
在第一个＆＃34; DC＆＃34;你必须指定没有.com或.net的域名就像这样＆＃34; google＆＃34;。
在第二个＆＃34; DC＆＃34;您必须为intance＆＃34; com＆＃34;，you can see this post if you want to know what means

完整示例：

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（＆＃34;用户ID＆＃34;）=＆＃34; 替换为域名短名称 \＆＃34; ＆安培;的userName

conn.Properties("User ID") = "ggle\" & userName

最后这是完整的代码：

    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

MS Access 2010使用ldap身份验证

2 个答案: