MS Access 2010 using ldap authentication - ldap

Question

I am trying to do ldap authentication in ms access 2010 using username and password. I cannot seem to figure this out and have tried different codes online but none seem to work. Can anyone help?
The following is what i have taken from 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
Error I receive is
"Error: The server is not operational.
-2147217865"
Changed to ip address get following error now
Method 'ActiveConnection' of object '_Command' failed but it might be coming from elsewhere in my code. how would i check if ldap was success?

Answer 1

I have fixed issue.
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

Making little changes and explaining for understanding this code and a correct functioning:
Added the check if the user exist in the Database.
Changed "OU=Sites" in the LDAP path by "CN=Users".
LDAPPath = "LDAP://replace with IP or DNS name/CN=Users;DC=replace with domain name without .com;DC=replace with com, net or root node name"
In IP or DNS Name you must to specify the server IP or DNS Name.
In the first "DC" you must to specify the Domain Name without .com or .net would be like this "google".
In the second "DC" you must to specify the Domain type for intance "com", you can see this post if you want to know what means
Full example:
LDAPPath = "LDAP://200.201.1.1/CN=Users;DC=google;DC=com"
or
LDAPPath = "LDAP://ldap.google.com/CN=Users;DC=google;DC=com"
In this line: conn.Properties("User ID") = "replace with domain short name\" & userName
conn.Properties("User ID") = "ggle\" & userName
Finaly this the full code:
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