Solved

Querying the Active Directory

Posted on 2003-11-25
3
732 Views
Last Modified: 2012-08-14
Hi,

I want to query the Active Directory to retrieve users based on certain criteria, like 'l', 'Department', 'ReportsTo', 'ReportsFrom', etc., but I am not able to do so via ADSI.
I tried querying the Global Catalog (GC), but it is telling that these fields were not found in the directory cache. Can anyone help??

Thanks in advance,
nganesh.
0
Comment
Question by:nganesh
3 Comments
 
LVL 14

Accepted Solution

by:
waty earned 150 total points
ID: 9830924
' #Mandix Repository#************************************************************
' * Programmer Name  : Paul Gorman
' * WebSite          : http://www.smi-texas.com
' * Date             : 06/27/2002
' **********************************************************************
' * Comments         : Active Directory Search Functions
' *
' * There are 4 different function that allow you to search your
' * companies active directory in different ways. These function
' * will allow you to search active directory by user or by group
' * to determine permissions. I am currently using these in my enterprise
' * applications so that I can set up security at a very granular
' * level. Down to a specific control if i want to.
' *
' **********************************************************************

Option Explicit
Public Enum Enum_adscAccessType
   adscDenyedAccess = 0
   adscDataReader = 1
   adscDataWriter = 2
End Enum
Public Function AllowAccess(LoginID As String, Group As String) As Boolean
   Dim oCN              As ADODB.Connection, oCM As ADODB.Command, oRS As ADODB.Recordset, oField As ADODB.Field
   Dim oUser            As IADs, oParent As IADs, oGroup As IADs
   Dim oPropList        As IADsPropertyList, oPropEntry As IADsPropertyEntry, oPropVal As IADsPropertyValue
   Dim sPath            As String, v As Variant, i As Variant
   'This function checks a specific users rights via their login and what ever group you pass in.
   'You will need to replace the {YOUR DC HERE} with your own domain controller to active directory.
   Set oCN = New ADODB.Connection
   Set oCM = New ADODB.Command
   Set oRS = New ADODB.Recordset
   oCN.Provider = "ADsDSOObject"
   oCN.Open
   Set oCM.ActiveConnection = oCN
   oCM.CommandText = "SELECT AdsPath FROM 'LDAP://OU=Branches,OU=Corp,DC={YOUR DC HERE},DC=com' " & _
      "WHERE objectCategory='person' AND cn='" & LoginID & "'"
   oCM.Properties("searchscope") = 2
   Set oRS = oCM.Execute
   If Not oRS.EOF Then
      Set oUser = GetObject(oRS("AdsPath").Value)
      oUser.GetInfo
      Set oParent = GetObject(oUser.Parent)
      Set oParent = GetObject(oParent.Parent)
      For i = 0 To oUser.PropertyCount - 1
         Set oPropEntry = oUser.Item(i)
         If oPropEntry.Name = "memberOf" Then
            For Each v In oPropEntry.Values
               Set oPropVal = v
               sPath = oPropVal.DNString
               Set oGroup = GetObject("LDAP://" & sPath)
               If oGroup.Name = "CN=" & Group Then
                  AllowAccess = True
                  GoTo ShutDown
               End If
               Set oGroup = Nothing
            Next
         End If
         oUser.Next
      Next
   End If
   AllowAccess = False
ShutDown:
   Set oCN = Nothing
   Set oRS = Nothing
   Set oCM = Nothing
   Set oField = Nothing
   Set oUser = Nothing
   Set oParent = Nothing
   Set oGroup = Nothing
   Set oPropList = Nothing
   Set oPropEntry = Nothing
   Set oPropVal = Nothing
   Set v = Nothing
End Function

Public Function ADSCAllowAccessByGroup(Group As String, UserName As String) As Boolean
   On Error Resume Next
   Dim oGroup           As ActiveDs.IADsGroup
   Dim oUser            As ActiveDs.IADsUser
   'This function checks whether or not a user is in a specific group. It will return a true or false
   'You will need to replace the {YOUR DC HERE} with your own domain controller to active directory.
   Set oGroup = GetObject("WinNT://{YOUR DC HERE}.com/" & Group)
   If oGroup Is Nothing Then
      ADSCAllowAccessByGroup = False
      Exit Function
   End If
   For Each oUser In oGroup.Members
      Debug.Print oUser.Name
      If UCase(oUser.Name) = UCase(UserName) Then
         ADSCAllowAccessByGroup = True
         Exit Function
      End If
   Next
   ADSCAllowAccessByGroup = False
End Function

Public Function ADSCAllowAccessByUser(UserName As String, Group As String) As Boolean
   On Error Resume Next
   Dim oGroup           As ActiveDs.IADsGroup
   Dim oUser            As ActiveDs.IADsUser
   Set oUser = GetObject("WinNT://{YOUR DC HERE}.com/" & UCase(UserName) & ",user")
   If oUser Is Nothing Then
      ADSCAllowAccessByUser = False
      Exit Function
   End If
   For Each oGroup In oUser.Groups
      If UCase(oGroup.Name) = UCase(Group) Then
         ADSCAllowAccessByUser = True
         Exit Function
      End If
   Next
End Function

Public Function ADSCAccessType(Location As String, UserName As String, Module As String, AppName As String) As Enum_adscAccessType
   On Error Resume Next
   Dim oGroup           As ActiveDs.IADsGroup
   Dim oUser            As ActiveDs.IADsUser
   'This function assumes that you already have 2 types of groups set up. One that has DataReader at the end and another
   'that has datawriter at the end. It alsoassumes that you have set up your group name in the following
   'order: Location_AppName & Module & DataReader/DataWriter.
   'You can change this to fit your needs. The main part is the first line of code that sets the oUser
   'You will need to replace the {YOUR DC HERE} with your own domain controller to active directory.
   Set oUser = GetObject("WinNT://{YOUR DC HERE}.com/" & UCase(UserName) & ",user")
   If oUser Is Nothing Then
      ADSCAccessType = adscDenyedAccess
      Exit Function
   End If
   For Each oGroup In oUser.Groups
      Select Case oGroup.Name
         Case Location & "_" & AppName & Module & "DataReader"
            ADSCAccessType = adscDataReader
            Exit Function
         Case Location & "_" & AppName & Module & "DataWriter"
            ADSCAccessType = adscDataWriter
            Exit Function
      End Select
   Next
   ADSCAccessType = adscDenyedAccess
End Function
0

Featured Post

Best Practices: Disaster Recovery Testing

Besides backup, any IT division should have a disaster recovery plan. You will find a few tips below relating to the development of such a plan and to what issues one should pay special attention in the course of backup planning.

Question has a verified solution.

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

Suggested Solutions

Title # Comments Views Activity
Validating VB6 Function 19 59
Recommendation vb6 to vb.net or others 14 149
MS Access 03, TransferText, decimal places 8 72
VB6 - Scroll Mouse wheel on Picturebox 13 44
Most everyone who has done any programming in VB6 knows that you can do something in code like Debug.Print MyVar and that when the program runs from the IDE, the value of MyVar will be displayed in the Immediate Window. Less well known is Debug.Asse…
You can of course define an array to hold data that is of a particular type like an array of Strings to hold customer names or an array of Doubles to hold customer sales, but what do you do if you want to coordinate that data? This article describes…
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…
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…

778 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