How to Authenticate Username and/or password to any Microsoft or any Direcotry server with service account and with SSL

Posted on 2008-06-24
Last Modified: 2013-12-24
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(strServerName 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

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("defaultNamingContext")

Set oRootDSE = Nothing

strUserADSPath = ""
blnUserExists = False
Set oADOConn = CreateObject("ADODB.CONNECTION")
Set oADORs = CreateObject("ADODB.Recordset")
oADOConn.Provider = "ADSDSOObject"

If SAMName = "" Then SAMName = "sAMAccountName"

Set oADORs = oADOConn.Execute("<LDAP://" & strNamingContext & ">;(" & SAMName & "=" & strUserName & ");AdsPath, cn")
If oADORs.RecordCount = 0 Then

    strUserADSPath = oADORs.Fields("ADSPATH").value
    blnUserExists = True
End If

Set oADORs = Nothing
Set oADOConn = Nothing

If Not blnUserExists Then
    AuthenticateUser = False
    Exit Function

    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)
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

AuthenticateUser = False
End If

End Function
Question by:mcbain942
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
1 Comment

Accepted Solution

mre224 earned 500 total points
ID: 21860342

Function AuthenticateUser3(strServerName As String, dcContextFullString As String, sSamUNContextFieldName As String, sServiceAccountContextFieldName As String, sOranizationUnitFullString As String, strUserToAuth As String, strPwToAuth As String, Optional sServiceAccountUN As String, Optional sServiceAccountPW As String, Optional strPort As String) As Integer

On Error GoTo broke

Dim con As New ADODB.Connection
Dim rs
Dim com As New ADODB.command
Dim path As String
Dim user As String
Dim sstr As String
Set con = CreateObject("ADODB.Connection")

strServerName = strServerName & ":389/"
If strPort <> "" Then
strServerName = Replace(strServerName, "389", strPort)
End If

sstr = "<LDAP://" & strServerName & dcContextFullString & ">;(" & sSamUNContextFieldName & "=" & sServiceAccountUN & ");AdsPath," & sServiceAccountContextFieldName & ";subtree"

con.Provider = "ADSDSOObject"
con.Properties("User ID") = sServiceAccountContextFieldName & "=" & sServiceAccountUN & "," & sOranizationUnitFullString & "," & dcContextFullString
con.Properties("Password") = sServiceAccountPW
con.Properties("ADSI Flag") = 34
con.Open "ADSI"

Set com = CreateObject("ADODB.Command")
Set com.ActiveConnection = con
com.CommandText = sstr
Set rs = com.Execute

If rs.EOF Then
AuthenticateUser3 = -1
End If

Dim dso
Dim cont

 Set dso = GetObject("LDAP:")
 Set cont = dso.OpenDSObject("LDAP://" & strServerName & dcContextFullString, strUserToAuth, strPwToAuth, 513)

 If Err.Number <> 0 Then
 'MsgBox Err.Description
 AuthenticateUser3 = 0
 AuthenticateUser3 = 1
 End If

Exit Function

AuthenticateUser3 = -2

Featured Post

Salesforce Has Never Been Easier

Improve and reinforce salesforce training & adoption using WalkMe's digital adoption platform. Start saving on costly employee training by creating fast intuitive Walk-Thrus for Salesforce. Claim your Free Account Now

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

A Stored Procedure in Microsoft SQL Server is a powerful feature that it can be used to execute the Data Manipulation Language (DML) or Data Definition Language (DDL). Depending on business requirements, a single Stored Procedure can return differe…
This article describes how to use a set of graphical playing cards to create a Draw Poker game in Excel or VB6.
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…
Video by: Steve
Using examples as well as descriptions, step through each of the common simple join types, explaining differences in syntax, differences in expected outputs and showing how the queries run along with the actual outputs based upon a simple set of dem…

707 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question