Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations gkittelson on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

LDAP authentication using SSL in VB 6.0

Status
Not open for further replies.

richland

Programmer
Nov 11, 2004
2
US
I am trying to authenticate users using LDAP and SSL in Visual Basic 6.0. There are no problems retrieving information using port 389. When using port 636, I get error -2147217865 Provider table does not exist. When looking at the traffic using Ethereal, the client key exchange, change cipher spec and encrypted handshake message is not happening after the server hello, certificate, server hello done. I am guessing that I need a callback function here but I do not know how to implement one in VB 6.0. I have messed around with the ADODB.Connection.Properties("ADSI Flag") and all I get is different errors. Is there another property I need to set in the connection object to get this to work?
I have done this in Java and all is working fine there. Any help is greatly appreciated!!

Here is some of the code I am using:

Private Function directoryLookup(ByVal directoryType As Integer, sServerURL As String, _
userIDField As String, ByVal userSearch As String, ByVal UserName As String, _
ByVal password As String, ByVal domain As String) As ExternalDirectory

Dim conn As New ADODB.Connection
Dim rs As ADODB.Recordset
Dim oDomain As IADs
Dim sFilter As String

Dim sAttribs As String
Dim sDepth As String
Dim sQuery As String
Dim sAns As String

Dim user As IADsUser
Dim bErrRaised As Boolean
On Error GoTo ErrHandler:

Dim URL As String: URL = sServerURL & Trim$(txtBaseDN.Text)

Set oDomain = GetObject(URL)

Set conn = CreateObject("ADODB.Connection")
conn.Provider = "ADsDSOObject"

If directoryType = LDAP Then
sFilter = "(" & userIDField & "=" & userSearch & ")"
Else
conn.Properties("Encrypt Password") = True
conn.Properties("ADSI Flag") = ADS_SECURE_AUTHENTICATION
conn.Properties("User ID") = domain & "\" & UserName
sFilter = "(&(objectCategory=person)(objectClass=user)(" & userIDField & "=" & userSearch & "))"
End If

conn.Properties("Password") = password

'Use SSL
If chkSSL.Value Then conn.Properties("ADSI Flag") = _
ADS_SECURE_AUTHENTICATION + ADS_USE_SSL

sAttribs = "adsPath"
sDepth = "subTree"
sQuery = "<" & URL & ">;" & sFilter & ";" & sAttribs & ";" & sDepth

If chkSSL.Value Then
conn.Open "ADSI"
Else: conn.Open
End If

'Query the directory
Debug.Print sQuery

'!!!BREAKS HERE WITH SSL AND LDAP!!!
Set rs = conn.Execute(sQuery)

While Not rs.EOF
'...BLAH
'...BLAH
'...BLAH
If Not rs.EOF Then rs.MoveNext
Wend

rs.Close
conn.Close
Exit Function
ErrHandler:
If Err.Number = -2147023570 Then
bErrRaised = True
Err.Clear
Resume Next
End If

If Err.Number <> 0 Then
Err.Raise Err.Number
End If

On Error Resume Next
If Not rs Is Nothing Then
If rs.State <> 0 Then rs.Close
Set rs = Nothing
End If

If Not conn Is Nothing Then
If conn.State <> 0 Then conn.Close
Set conn = Nothing
End If

Set oDomain = Nothing
End Function
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top