Once again User Inits....this time using ADODB

Once again User Inits....this time using ADODB

Post by PatLa » Fri, 14 Mar 2003 23:17:11



Hello all,
Thanks for the help so far. Here's what I found that I
got to work and can modify for my app but I have
questions about security. In order to use the following
code what privelege level do I need? I am logged in as a
domain admin and it works but I can't do that for my
floor apps. Will this code work with user rights only?

Dim Con As ADODB.Connection
Dim ocommand As ADODB.Command
Dim gc As IADs

On Error Resume Next
' Maximum number of items to list on a msgbox.
MAX_DISPLAY = 5

' Prompt for surname to search for.
strName = InputBox("This routine searches in the current
domain for users with the specified surname." & vbCrLf &
vbCrLf & "Specify the surname:")

If strName = "" Then
  MsgBox "No surname was specified. The routine will
search for all users."
End If

' Create ADO connection object for Active Directory
Set Con = CreateObject("ADODB.Connection")
  If (Err.Number <> 0) Then
     BailOnFailure Err.Number, "on CreateObject"
  End If
Con.Provider = "ADsDSOObject"
  If (Err.Number <> 0) Then
     BailOnFailure Err.Number, "on Provider"
  End If
Con.Open "Active Directory Provider"
  If (Err.Number <> 0) Then
     BailOnFailure Err.Number, "on Open"
  End If

' Create ADO command object for the connection.
Set ocommand = CreateObject("ADODB.Command")
  If (Err.Number <> 0) Then
     BailOnFailure Err.Number, "on CreateObject"
  End If
ocommand.ActiveConnection = Con
  If (Err.Number <> 0) Then
     BailOnFailure Err.Number, "on Active Connection"
  End If

' Get the ADsPath for the domain to search.
Set root = GetObject("LDAP://rootDSE")
  If (Err.Number <> 0) Then
     BailOnFailure Err.Number, "on GetObject for rootDSE"
  End If
sDomain = root.Get("defaultNamingContext")
  If (Err.Number <> 0) Then
     BailOnFailure Err.Number, "on Get on
defaultNamingContext"
  End If
Set domain = GetObject("LDAP://" & sDomain)
  If (Err.Number <> 0) Then
     BailOnFailure Err.Number, "on GetObject for domain"
  End If

' Build the ADsPath element of the commandtext
sADsPath = "<" & domain.ADsPath & ">"

' Build the filter element of the commandtext
If (strName = "") Then
  sFilter = "(&(objectCategory=person)(objectClass=user))"
Else
  sFilter = "(&(objectCategory=person)(objectClass=user)
(sn=" & strName & "))"
End If

' Build the returned attributes element of the
commandtext.
sAttribsToReturn = "name,Initials"

' Build the depth element of the commandtext.
sDepth = "subTree"

' Assemble the commandtext.
ocommand.CommandText = sADsPath & ";" & sFilter & ";" &
sAttribsToReturn & ";" & sDepth
  If (Err.Number <> 0) Then
     BailOnFailure Err.Number, "on CommandText"
  End If
' Display.
show_items "CommandText: " & ocommand.CommandText, ""

' Execute the query.
Set rs = ocommand.Execute
  If (Err.Number <> 0) Then
     BailOnFailure Err.Number, "on Execute"
  End If

strText = "Found " & rs.RecordCount & " Users in the
domain:"
intNumDisplay = 0
intCount = 0

' Navigate the record set.
rs.MoveFirst
While Not rs.EOF
    intCount = intCount + 1
    strText = strText & vbCrLf & intCount & ") "
    For i = 0 To rs.Fields.Count - 1
        If rs.Fields(i).Type = adVariant And Not (IsNull
(rs.Fields(i).Value)) Then
          strText = strText & rs.Fields(i).Name & " = "
          For j = LBound(rs.Fields(i).Value) To UBound
(rs.Fields(i).Value)
             strText = strText & rs.Fields(i).Value(j)
& " "
          Next
        Else
          strText = strText & rs.Fields(i).Name & " = " &
rs.Fields(i).Value & vbCrLf
        End If
    Next
    intNumDisplay = intNumDisplay + 1
    ' Display in msgbox if there are MAX_DISPLAY items to
display.
    If intNumDisplay = MAX_DISPLAY Then
        Call show_items(strText, "Users in domain")
        strText = ""
        intNumDisplay = 0
    End If
    rs.MoveNext
Wend

show_items strText, "Users in domain"

End Sub

Thanks
Pat

 
 
 

Once again User Inits....this time using ADODB

Post by Richard Muelle » Sat, 15 Mar 2003 00:44:15


Hi,

Regular users should be able to use the code.
Authenticated users have read permissions for AD objects.
The only requirement is MDAC on the client to use ADO.
MDAC comes on W2k and XP clients, and NT and Win9x clients
with DSClient installed.

Richard
http://www.RLMueller.net

Quote:>-----Original Message-----
>Hello all,
>Thanks for the help so far. Here's what I found that I
>got to work and can modify for my app but I have
>questions about security. In order to use the following
>code what privelege level do I need? I am logged in as a
>domain admin and it works but I can't do that for my
>floor apps. Will this code work with user rights only?

>Dim Con As ADODB.Connection
>Dim ocommand As ADODB.Command
>Dim gc As IADs

>On Error Resume Next
>' Maximum number of items to list on a msgbox.
>MAX_DISPLAY = 5

>' Prompt for surname to search for.
>strName = InputBox("This routine searches in the current
>domain for users with the specified surname." & vbCrLf &
>vbCrLf & "Specify the surname:")

>If strName = "" Then
>  MsgBox "No surname was specified. The routine will
>search for all users."
>End If

>' Create ADO connection object for Active Directory
>Set Con = CreateObject("ADODB.Connection")
>  If (Err.Number <> 0) Then
>     BailOnFailure Err.Number, "on CreateObject"
>  End If
>Con.Provider = "ADsDSOObject"
>  If (Err.Number <> 0) Then
>     BailOnFailure Err.Number, "on Provider"
>  End If
>Con.Open "Active Directory Provider"
>  If (Err.Number <> 0) Then
>     BailOnFailure Err.Number, "on Open"
>  End If

>' Create ADO command object for the connection.
>Set ocommand = CreateObject("ADODB.Command")
>  If (Err.Number <> 0) Then
>     BailOnFailure Err.Number, "on CreateObject"
>  End If
>ocommand.ActiveConnection = Con
>  If (Err.Number <> 0) Then
>     BailOnFailure Err.Number, "on Active Connection"
>  End If

>' Get the ADsPath for the domain to search.
>Set root = GetObject("LDAP://rootDSE")
>  If (Err.Number <> 0) Then
>     BailOnFailure Err.Number, "on GetObject for rootDSE"
>  End If
>sDomain = root.Get("defaultNamingContext")
>  If (Err.Number <> 0) Then
>     BailOnFailure Err.Number, "on Get on
>defaultNamingContext"
>  End If
>Set domain = GetObject("LDAP://" & sDomain)
>  If (Err.Number <> 0) Then
>     BailOnFailure Err.Number, "on GetObject for domain"
>  End If

>' Build the ADsPath element of the commandtext
>sADsPath = "<" & domain.ADsPath & ">"

>' Build the filter element of the commandtext
>If (strName = "") Then
>  sFilter = "(&(objectCategory=person)(objectClass=user))"
>Else
>  sFilter = "(&(objectCategory=person)(objectClass=user)
>(sn=" & strName & "))"
>End If

>' Build the returned attributes element of the
>commandtext.
>sAttribsToReturn = "name,Initials"

>' Build the depth element of the commandtext.
>sDepth = "subTree"

>' Assemble the commandtext.
>ocommand.CommandText = sADsPath & ";" & sFilter & ";" &
>sAttribsToReturn & ";" & sDepth
>  If (Err.Number <> 0) Then
>     BailOnFailure Err.Number, "on CommandText"
>  End If
>' Display.
>show_items "CommandText: " & ocommand.CommandText, ""

>' Execute the query.
>Set rs = ocommand.Execute
>  If (Err.Number <> 0) Then
>     BailOnFailure Err.Number, "on Execute"
>  End If

>strText = "Found " & rs.RecordCount & " Users in the
>domain:"
>intNumDisplay = 0
>intCount = 0

>' Navigate the record set.
>rs.MoveFirst
>While Not rs.EOF
>    intCount = intCount + 1
>    strText = strText & vbCrLf & intCount & ") "
>    For i = 0 To rs.Fields.Count - 1
>        If rs.Fields(i).Type = adVariant And Not (IsNull
>(rs.Fields(i).Value)) Then
>          strText = strText & rs.Fields(i).Name & " = "
>          For j = LBound(rs.Fields(i).Value) To UBound
>(rs.Fields(i).Value)
>             strText = strText & rs.Fields(i).Value(j)
>& " "
>          Next
>        Else
>          strText = strText & rs.Fields(i).Name & " = " &
>rs.Fields(i).Value & vbCrLf
>        End If
>    Next
>    intNumDisplay = intNumDisplay + 1
>    ' Display in msgbox if there are MAX_DISPLAY items to
>display.
>    If intNumDisplay = MAX_DISPLAY Then
>        Call show_items(strText, "Users in domain")
>        strText = ""
>        intNumDisplay = 0
>    End If
>    rs.MoveNext
>Wend

>show_items strText, "Users in domain"

>End Sub

>Thanks
>Pat
>.


 
 
 

1. cable modem once again ...

We are looking at moving to cable for internet access.
After looking through deja, I am confused as to whether or not there are
still problems with cable setup or not.
Article Q219364 seems to say that the problem of dynamic ip address
assignment is a simple matter of installing SP5 and disabling dhcp binding
on the nic connected to the cable modem.
However postings suggest that people are still having problems getting a
cable connection to work when dynamic address assignment is involved.
Can someone give me a quick reply as to whether or not I am reading the Q
article correctly or are there still issues with SBS and cable.

2. FA: SGI O2 295$ NR R5K 200; 192Mb; Irix 6.5 Media

3. Once again about out of office assistant

4. AT&T International Information Now Dialable From Canada

5. OT - Once again port 80 is not the most attacked port.....

6. sub-interface's bitrate

7. Once Again, Dissapearing Icons

8. Yet Another Free Programming Language ...

9. SBS 4.5 over WAN once again!

10. SBS2k Licens Problem - Once again :(

11. okay people..back once again with a little question

12. once again other problem with sms

13. Once again: Samba and Network Neighborhood