DekGenius.com
[ Team LiB ] Previous Section Next Section

20.5 Advanced Search Function—SearchAD

We will now take many of the concepts from this chapter and apply them in a useful example called SearchAD. SearchAD can be included in any VBScript and used immediately as is.

SearchAD takes five parameters and returns a Boolean indicating whether it succeeded or failed in the search. You should recognize most of these parameters.

  • The base ADsPath to start the search from

  • A valid ADO criteria string

  • The depth that you wish to search, represented by one of the exact strings Base, OneLevel, or SubTree

  • The comma-separated list of attributes that is to be returned

  • A variable that will hold the returned results of the search in an array

The last parameter does not have any values when passed in, but if SearchAD is successful, the array contains the resultset.

Here is an example use of SearchAD:

bolIsSuccess = SearchAD("LDAP://ou=Finance,dc=mycorp,dc=com", _
  "(cn=a*)", "Base", "cn,description", arrSearchResults)

You can also use it as part of an If...Then condition:

If SearchAD("LDAP://dc=mycorp,dc=com", "(description=moose)", "SubTree", _
  "ADsPath,cn,description", arrSearchResults) Then
  'success code using arrSearchResults
Else
  'failure code
End If

The array that is returned is a two-dimensional array of attributes that match the criteria. If there were 12 results returned for the preceding query, this is how you access the results:

arrSearchResults(0,0) 'ADsPath of first result
arrSearchResults(0,1) 'CN of first result
arrSearchResults(0,2) 'Description of first result
arrSearchResults(1,0) 'ADsPath of second result
arrSearchResults(1,1) 'CN of second result
arrSearchResults(1,2) 'Description of second result
arrSearchResults(2,0) 'ADsPath of third result
arrSearchResults(2,1) 'CN of third result
arrSearchResults(2,2) 'Description of third result
arrSearchResults(3,0) 'ADsPath of fourth result
arrSearchResults(3,1) 'CN of fourth result
arrSearchResults(3,2) 'Description of fourth result
.
.
.
arrSearchResults(11,0) 'ADsPath of 11th result
arrSearchResults(11,1) 'CN of 11th result
arrSearchResults(11,2) 'Description of 11th result

You can loop through these values in your own code using VBScript's built-in function UBound to find the maximum upper bound of an array:

UBound(arrSearchResults,1) 'This results in a value of 11

UBound(arrSearchResults,2) 'This results in a value of 2

The first UBound gives the upper bound of the array's first dimension, and the second gives the upper bound of the second dimension. Thus you can loop through an index from 0 to these values to iterate through the array. For example:

'Iterate through the entire set of records
For i=0 To UBound(arrSearchResults,1)
  'Now for each record iterate through the list of that record's values
  For j=0 To UBound(arrSearchResults,2)
    'Do something with arrSearchResults(i,j), e.g., the next line
    MsgBox arrSearchResults(i,j)
  Next
Next

So, without further ado, here is Example 20-2, which contains the SearchAD function.

Example 20-2. SearchAD, an advanced search function
'**********************************************************************
'SearchAD Function (returns Boolean success or failure)
'**********************************************************************
Function SearchAD(ByVal strLDAPBase, ByVal strCriteria, ByVal strDepth, _
  ByVal strAttributeList, ByRef arrResults(  ))
   
  Dim objConn, objComm, objRS, intArrayIndex, arrAttributes
  Dim intAttributeArrayIndex
   
  On Error Resume Next
   
  '**********************************************************************
  'Used to specify an unsuccessful ADO connection
  '**********************************************************************
  Const adStateClosed = 0
   
  '**********************************************************************
  'Defined in ADS_SCOPEENUM (in the ADSI documentation) for a full 
  'subtree search starting at the defined root
  '**********************************************************************
  Const ADS_SCOPE_SUBTREE = 2 
   
  Set objConn = CreateObject("ADODB.Connection")
  Set objComm = CreateObject("ADODB.Command")
  Set objRS = CreateObject("ADODB.Recordset")
   
  objConn.Provider = "ADSDSOObject"
  objConn.Open "", vbNullString, vbNullString
   
  '**********************************************************************
  'If connection failed, then return FALSE
  '**********************************************************************
  If objConn.State = adStateClosed Then
    SearchAD = False
    Exit Function
  End If
   
  '**********************************************************************
  'Link the now-open connection with the empty command object 
  '**********************************************************************
  Set objComm.ActiveConnection = objConn
   
  '**********************************************************************
  'Populate the command object in order to execute a query through the
  'linked connection. Set the text of the query command (i.e., the search),
  'the max number of results to return, the timeout in seconds to wait 
  'for the query, and whether the results are to be cached.
  '**********************************************************************
  objComm.CommandText = "<" & strLDAPBase & ">;" & strCriteria & ";" _
    & strAttributeList & ";" & strDepth
  objComm.Properties("Page Size") = 10000
  objComm.Properties("Timeout") = 60
  objComm.Properties("searchscope") = ADS_SCOPE_SUBTREE
  objComm.Properties("Cache Results") = False
   
  '**********************************************************************
  'Execute the command through the linked connection
  '**********************************************************************
  Err.Clear
  Set objRS = objComm.Execute
  '**********************************************************************
  'If there was an error, then return FALSE
  '**********************************************************************
  If Err Then
    objConn.Close
    Set objRS = Nothing
    SearchAD = False
  Else
    '**********************************************************************
    'If we're pointing at the end of the resultset already (EOF) then there 
    'were no records returned (although the query did search the AD), so
    'return FALSE
    '**********************************************************************
    If objRS.EOF Then
      objConn.Close
      Set objRS = Nothing
      SearchAD = False
    Else
      '**********************************************************************
      'Count number of attributes passed in by splitting the attributes up
      'using commas as separators into an array of elements. Then we can use
      'that array to find the upper bound (i.e., number of attributes).
      '**********************************************************************
      arrAttributes = Split(strAttributeList,",")
   
      '**********************************************************************
      'Now in order to place all the resulting attributes into the array that 
      'we'll pass back out, we need to redimension the array so that it is
      'large enough to hold the records. The array is multidimensional in
      'order to hold all the attribute fields.
      '**********************************************************************
      ReDim arrResults((objRS.RecordCount - 1),UBound(arrAttributes))

      '**********************************************************************
      'Loop through the newly redimensioned array, starting at zero, and add
      'each field to the array
      '**********************************************************************
      intArrayIndex = 0
      While Not objRS.EOF
        For intAttributeArrayIndex = 0 To UBound(arrAttributes)
          arrResults(intArrayIndex,intAttributeArrayIndex) = _
            objRS.Fields.Item(arrAttributes(intAttributeArrayIndex)).Value
        Next
        intArrayIndex = intArrayIndex + 1
        objRS.MoveNext
      Wend
   
      '**********************************************************************
      'Close the connection and return TRUE
      '**********************************************************************
      objConn.Close
      Set objRS = Nothing
      SearchAD = True
    End If   
  End If
End Function
    [ Team LiB ] Previous Section Next Section