使用ldap身份验证的MS Access 2010

Question

我正在尝试使用用户名和密码在ms-access2010中进行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地址，现在出现以下错误

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

为理解此代码和正确的功能进行一些更改和解释：

1. 添加了检查用户是否存在于数据库中
2. "CN=Users"更改了LDAP路径中的"OU=Sites">

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

3. 在IP或DNS名称中，必须指定服务器IP或DNS名
4. 在第一个"DC"中，您必须指定没有.com或.net的域名。这将类似于"谷歌">
5. 在第二个"DC"中，您必须指定"com"的域类型，如果您想知道什么是

完整示例：

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

或

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

6. 在行中：conn.Properties("User ID")=">替换为域短名称\"&用户名

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