Accessing Active Directory from Remote Non Domain Computer

I am trying to access Active Directory information from a Remote Computer which is not part of the domain.
I am using a Visual Basic 6 program.
I can authenticate the user but cannot retrieve user information.

I receive the error

Automation error. Specified domain either does not exist or could not be contacted.

This works well when the user is inside the network but not on the outside.  They are connecting thru a VPN tunnel.

Here is my code for getting the information form AD.

Public Sub UserInfo()
'PURPOSE: Display information that is available in
'the Active Directory about a given user

'PARAMETER: Login Name for user

'RETURNS: String with selected information about
'user, or empty string if there is no such
'login on the current domain

'REQUIRES: Windows 2000 ADSI, LDAP Provider
'Proper Security Credentials.

'EXAMPLE: msgbox UserInfo("Administrator")

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

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

Dim user As IADsUser

'On Error GoTo ErrHandler:

'Get user Using LDAP/ADO.  There is an easier way
'to bind to a user object using the WinNT provider,
'but this way is a better for educational purposes
Set oRoot = GetObject("LDAP://rootDSE")
'work in the default domain

gDomain="my.domain.com"
Set oDomain = GetObject("LDAP://" & gDomain)
sBase = "<" & oDomain.ADsPath & ">"
'Only get user name requested
sFilter = "(&(objectCategory=person)(objectClass=user)(samaccountname=" _
  & UCase(gUserRecord.LoginName) & "))"
sAttribs = "adsPath"
sDepth = "subTree"

sQuery = sBase & ";" & sFilter & ";" & sAttribs & ";" & sDepth
                   
conn.Open _
  "Data Source=Active Directory Provider;Provider=ADsDSOObject"
 
Set rs = conn.Execute(sQuery)


If Not rs.EOF Then
    Set user = GetObject(rs("adsPath"))
    With user
   
    'if the attribute is not stored in AD,
    'an error will occur.  Therefore, this
    'will return data only from populated attributes
    On Error Resume Next
   
    gUserRecord.FirstName = .FirstName
    gUserRecord.LastName = .LastName
    gUserRecord.EmployeeID = .EmployeeID
    gUserRecord.Title = .Title
    gUserRecord.Division = .Division
    gUserRecord.Department = .Department
    gUserRecord.Manager = .Manager

    gUserRecord.PhoneNumber = .TelephoneNumber
    gUserRecord.FaxNumber = .FaxNumber
   
    gUserRecord.EmailAddress = .EmailAddress
    gUserRecord.HomePage = .HomePage
    gUserRecord.ComputerName = Trim(CStr(VBA.Environ("COMPUTERNAME")))
   
    'IN RC2, this returned 1/1/1970 when password
    'never expires option is set
       
    End With
Else
    MsgBox "PRESS OK TO CONTINUE", vbCritical + vbOKOnly, "NOT A VALID USER!!!"
    Set rs = Nothing
    Set conn = Nothing
    Set oRoot = Nothing
    Set oDomain = Nothing
    Unload frmMain
    End
End If

ErrHandler:

'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
    Else
        MsgBox Err.Description, vbOKOnly, Err.Number
       
        MsgBox "PLEASE CONTACT COMPUTER SUPPORT!!", vbCritical + vbOKOnly, "CANNOT CONNECT TO NETWORK SERVER!!!"
        Set conn = Nothing
        Set oRoot = Nothing
        Set oDomain = Nothing
        End
    End If
End If

Set conn = Nothing
Set oRoot = Nothing
Set oDomain = Nothing
End Sub
msilkaAsked:
Who is Participating?

Improve company productivity with a Business Account.Sign Up

x
 
msilkaConnect With a Mentor Author Commented:
I just do a quick check if the user exists from the following routine.

' Check whether a username/password pair is correct
'
' if DOMAIN is omitted, it uses the local account database
' and then asks trusted domains to search their account databases
' until it finds the account or the search is exhausted
' use DOMAIN="." to search only the local account database

Public Function CheckWindowsUser(ByVal UserName As String, _
    ByVal Password As String) As Boolean
   
    Dim hToken As Long, ret As Long
   
    CheckWindowsUser = False
   
    ' provide a default for the Domain name
    If Len(gDomain) = 0 Then gDomain = vbNullString
    ' check the username/password pair
    ' using LOGON32_LOGON_NETWORK delivers the best performance
    ret = LogonUser(UserName,gDomain, Password, LOGON32_LOGON_NETWORK, _
        LOGON32_PROVIDER_DEFAULT, hToken)
        ' a non-zero value means success
    If ret Then
        CheckWindowsUser = True
        CloseHandle hToken
    End If

I will troubleshoot the oDomain.ADsPath on the computer in question.
0
 
Chris DentPowerShell DeveloperCommented:

Are they still authenticated?

I recommend you check the value returned by this:

sBase = "<" & oDomain.ADsPath & ">"

It should be right, but it's possible they cannot resolve the domain name listed in that path. Check nslookup for the value of gDomain if the path is correct.

Minor side-note: You know this serves no purpose at all, right? :)

Set oRoot = GetObject("LDAP://rootDSE")

Chris
0
 
msilkaAuthor Commented:
I took off the pont values so I would not get the credit.
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.