mcbain942
asked on
How to Authenticate Username and/or password to any Microsoft or any Direcotry server with service account and with SSL
Im a little confused how to use use IADs to verify a username and password IF a company locks down thier Directory server with a service account username and password first before you can even connect.
The following code i have coded to work with encryption if the function is asking for it. I would like this to work for any Directory server not just microsoft. here is my code. In your response if you could just give me pseudo code on how to do this with my object names i would appreciate it
This function already works on my NT AD as is, but it do not understand how to impliment sServiceAccount username and sSA password.
Thank you.
Function AuthenticateUser(strServer Name As String, strUserName As String, blnSSL As Boolean, Optional strPassword As String, Optional sPort As String, Optional SAMName As String, Optional sServiceAccount As String, Optional sSAPassword) As Boolean
On Error Resume Next
Const ADS_SECURE_AUTHENTICATION = 1
Const ADS_SERVER_BIND = 512
Dim strUserADSPath As String
Dim blnUserExists As Boolean
Dim oADOConn As New ADODB.Connection
Dim oADORs As New ADODB.Recordset
Dim oUser As IADs
Dim oDSObj As IADsOpenDSObject
Dim strNamingContext As String
strServerName = strServerName & ":389/"
If sPort <> "" Then
strServerName = Replace(strServerName, ":389", ":" & sPort)
End If
Dim oRootDSE As IADs
Set oRootDSE = GetObject("LDAP://" & strServerName & "RootDSE")
strNamingContext = strServerName & oRootDSE.Get("defaultNamin gContext")
Set oRootDSE = Nothing
strUserADSPath = ""
blnUserExists = False
Set oADOConn = CreateObject("ADODB.CONNEC TION")
Set oADORs = CreateObject("ADODB.Record set")
oADOConn.Provider = "ADSDSOObject"
oADOConn.Open
If SAMName = "" Then SAMName = "sAMAccountName"
Set oADORs = oADOConn.Execute("<LDAP:// " & strNamingContext & ">;(" & SAMName & "=" & strUserName & ");AdsPath, cn")
If oADORs.RecordCount = 0 Then
Else
strUserADSPath = oADORs.Fields("ADSPATH").v alue
blnUserExists = True
End If
oADORs.Close
Set oADORs = Nothing
oADOConn.Close
Set oADOConn = Nothing
If Not blnUserExists Then
AuthenticateUser = False
Exit Function
Else
If strPassword = "" Then
AuthenticateUser = True
Exit Function
End If
End If
Dim oAuth
Set oUser = GetObject(strUserADSPath)
Set oDSObj = GetObject("LDAP:")
If blnSSL = True Then
Set oAuth = oDSObj.OpenDSObject("LDAP: //" & strNamingContext, strUserName, strPassword, ADS_SECURE_AUTHENTICATION + ADS_SERVER_BIND)
Else
Set oAuth = oDSObj.OpenDSObject("LDAP: //" & strNamingContext, strUserName, strPassword, ADS_SERVER_BIND)
End If
If Err.Number <> 0 Then
AuthenticateUser = False
Exit Function
End If
If Not oAuth Is Nothing Then
Set oAuth = Nothing
AuthenticateUser = True
Else
AuthenticateUser = False
End If
End Function
The following code i have coded to work with encryption if the function is asking for it. I would like this to work for any Directory server not just microsoft. here is my code. In your response if you could just give me pseudo code on how to do this with my object names i would appreciate it
This function already works on my NT AD as is, but it do not understand how to impliment sServiceAccount username and sSA password.
Thank you.
Function AuthenticateUser(strServer
On Error Resume Next
Const ADS_SECURE_AUTHENTICATION = 1
Const ADS_SERVER_BIND = 512
Dim strUserADSPath As String
Dim blnUserExists As Boolean
Dim oADOConn As New ADODB.Connection
Dim oADORs As New ADODB.Recordset
Dim oUser As IADs
Dim oDSObj As IADsOpenDSObject
Dim strNamingContext As String
strServerName = strServerName & ":389/"
If sPort <> "" Then
strServerName = Replace(strServerName, ":389", ":" & sPort)
End If
Dim oRootDSE As IADs
Set oRootDSE = GetObject("LDAP://" & strServerName & "RootDSE")
strNamingContext = strServerName & oRootDSE.Get("defaultNamin
Set oRootDSE = Nothing
strUserADSPath = ""
blnUserExists = False
Set oADOConn = CreateObject("ADODB.CONNEC
Set oADORs = CreateObject("ADODB.Record
oADOConn.Provider = "ADSDSOObject"
oADOConn.Open
If SAMName = "" Then SAMName = "sAMAccountName"
Set oADORs = oADOConn.Execute("<LDAP://
If oADORs.RecordCount = 0 Then
Else
strUserADSPath = oADORs.Fields("ADSPATH").v
blnUserExists = True
End If
oADORs.Close
Set oADORs = Nothing
oADOConn.Close
Set oADOConn = Nothing
If Not blnUserExists Then
AuthenticateUser = False
Exit Function
Else
If strPassword = "" Then
AuthenticateUser = True
Exit Function
End If
End If
Dim oAuth
Set oUser = GetObject(strUserADSPath)
Set oDSObj = GetObject("LDAP:")
If blnSSL = True Then
Set oAuth = oDSObj.OpenDSObject("LDAP:
Else
Set oAuth = oDSObj.OpenDSObject("LDAP:
End If
If Err.Number <> 0 Then
AuthenticateUser = False
Exit Function
End If
If Not oAuth Is Nothing Then
Set oAuth = Nothing
AuthenticateUser = True
Else
AuthenticateUser = False
End If
End Function
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.