Larry Steinle

March 17, 2011

AdCommand: Running Active Directory Queries

Filed under: Active Directory,VS.Net — Larry Steinle @ 9:20 pm
Tags: , , ,

In our previous posts we learned how to connect to Active Directory and how to parse SQL statements. In today’s post we will cover the classes required to implement the DBCommand interface. The DBCommand interface that will be implemented will use the AdComandTextParser to build the DirectoryEntry and DirectorySearcher objects which will be used by the AdDataReader to read the results from Active Directory.
This is the fifth post of an eight part series about the Active Directory Data Access Layer. As each post builds on the previous it may be helpful to review older posts prior to reading this one. If you would like to download a working copy of the AD DAL please refer to the download on the Code Share page.

AdCommand Class Diagram

The DBCommand class uses a DBParameterCollection and DBParameter class which are used to apply command parameters to the CommandText. Command parameters simplify the code required when executing the same query with different values. Use of a command validator should be used to reduce the risk of SQL Code Injection.

The AdSorterCollection and AdSorter are used to manage the sort options parsed out of the SQL statement. Please note that in Active Directory you can only sort on a single attribute name. So while a collection is used to track the sort parameters, the sort is based on the first parameter and the remaining parameters are ignored. Use a DataView to sort on more than one column.

The AdCommand class both creates an instance of the DBDataReader and uses the instantiated DBDataReader. The AdCommand uses the AdCommandTextParser to initialize the DirectoryEntry and DirectorySearcher objects prior to passing the object into the DBDataReader. The DBDataReader uses the DirectorySearcher instance to pull the data out of Active Directory in a consistent and reliable manner. The ExecuteNonQuery method uses the DBDataReader to identify which objects to update or delete. ExecuteNonQuery is able to support both single-valued and multivalued attributes.

AdCommand Class Diagram

AdCommand Class Diagram

AdParameter

Namespace Data.ActiveDirectory
  Public Class AdParameter
    Inherits System.Data.Common.DbParameter

    Public Sub New()
    End Sub

    Public Sub New(ByVal parameterName As String)
      Me.ParameterName = parameterName.Trim
    End Sub

    Public Sub New(ByVal parameterName As String, ByVal value As Object)
      Me.ParameterName = parameterName.Trim
      _Value = value
    End Sub

    Public Overrides Property DbType As System.Data.DbType
    Public Overrides Property Direction As System.Data.ParameterDirection
    Public Overrides Property IsNullable As Boolean

    Public Overrides Property ParameterName As String
      Get
        Return _ParameterName
      End Get
      Set(ByVal value As String)
        _AppendValue = False
        _RemoveValue = False

        If value.StartsWith("+") Then
          _AppendValue = True
          _ParameterName = value.Substring(1)
        ElseIf value.StartsWith("-") Then
          _RemoveValue = True
          _ParameterName = value.Substring(1)
        Else
          _AppendValue = True
          _ParameterName = value
        End If
      End Set
    End Property
    Private _ParameterName As String

    ''' <summary>
    ''' Gets a value that indicates when to add a value to a multivalued attribute.
    ''' </summary>
    ''' <remarks></remarks>
    Public ReadOnly Property AppendValue As Boolean
      Get
        If IsMultiValued Then
          Return _AppendValue
        Else
          Return False
        End If
      End Get
    End Property
    Private _AppendValue As Boolean = False

    ''' <summary>
    ''' Gets a value that indicates when to remove the value from a multivalued attribute.
    ''' </summary>
    ''' <remarks></remarks>
    Public ReadOnly Property RemoveValue As Boolean
      Get
        If IsMultiValued Then
          Return _RemoveValue
        Else
          Return False
        End If
      End Get
    End Property
    Private _RemoveValue As Boolean = False

    Public Overrides Sub ResetDbType()
      _DbType = Nothing
    End Sub

    Public Overrides Property Size As Integer
    Public Overrides Property SourceColumn As String
    Public Overrides Property SourceColumnNullMapping As Boolean
    Public Overrides Property SourceVersion As System.Data.DataRowVersion
    Public Overrides Property Value As Object

    ''' <summary>
    ''' Get or set a value that indicates that the parameter is a multivalued attribute.
    ''' </summary>
    ''' <remarks></remarks>
    Public Property IsMultiValued As Boolean

    ''' <summary>
    ''' Copies the values of the current class into the target DbParameter class.
    ''' </summary>
    ''' <param name="parm">
    ''' An instance of DbParameter type.
    ''' </param>
    ''' <remarks></remarks>
    Public Sub CopyTo(ByVal parm As System.Data.Common.DbParameter)
      parm.ParameterName = Me.ParameterName
      parm.DbType = Me.DbType
      parm.Direction = Me.Direction
      parm.Size = Me.Size
      parm.SourceColumn = Me.SourceColumn
      parm.SourceColumnNullMapping = Me.SourceColumnNullMapping
      parm.SourceVersion = Me.SourceVersion
      parm.Value = Me.Value

      If TypeOf parm Is AdParameter Then
        CType(parm, AdParameter).IsMultiValued = Me.IsMultiValued

        If _AppendValue Then
          parm.ParameterName = "+" & parm.ParameterName
        ElseIf _RemoveValue Then
          parm.ParameterName = "-" & parm.ParameterName
        End If
      End If
    End Sub
  End Class
End Namespace

AdParameterCollection

Namespace Data.ActiveDirectory
  Public Class AdParameterCollection
    Inherits System.Data.Common.DbParameterCollection

#Region "Supporting Properties"
    Protected ReadOnly Property InnerList As System.Collections.Generic.List(Of AdParameter)
      Get
        If _InnerList Is Nothing Then
          _InnerList = New System.Collections.Generic.List(Of AdParameter)
        End If
        Return _InnerList
      End Get
    End Property
    Private _InnerList As System.Collections.Generic.List(Of AdParameter)
#End Region

#Region "Implement DbParameterCollection Interface"
    Public Overrides Function Add(ByVal value As Object) As Integer
      Me.InnerList.Add(DirectCast(value, AdParameter))
      Return IndexOf(value)
    End Function

    Public Overrides Sub AddRange(ByVal values As System.Array)
      For Each value As Object In values
        Add(value)
      Next
    End Sub

    Public Overrides Sub Clear()
      Me.InnerList.Clear()
    End Sub

    Public Overloads Overrides Function Contains(ByVal value As Object) As Boolean
      Return Me.IndexOf(value) >= 0
    End Function

    Public Overloads Overrides Function Contains(ByVal value As String) As Boolean
      Return Me.IndexOf(value) >= 0
    End Function

    Public Overrides Sub CopyTo(ByVal array As System.Array, ByVal index As Integer)
      Dim arrayIndex As Integer = 0
      For parmIndex As Integer = index To InnerList.Count
        array.SetValue(InnerList(parmIndex), arrayIndex)
        arrayIndex += 1
      Next
    End Sub

    Public Overrides ReadOnly Property Count As Integer
      Get
        Return InnerList.Count
      End Get
    End Property

    Public Overrides Function GetEnumerator() As System.Collections.IEnumerator
      Return InnerList.GetEnumerator
    End Function

    Protected Overloads Overrides Function GetParameter(ByVal index As Integer) As System.Data.Common.DbParameter
      Return InnerList.Item(index)
    End Function

    Protected Overloads Overrides Function GetParameter(ByVal parameterName As String) As System.Data.Common.DbParameter
      Return InnerList.Item(IndexOf(parameterName))
    End Function

    Public Overloads Overrides Function IndexOf(ByVal value As Object) As Integer
      Return InnerList.IndexOf(DirectCast(value, AdParameter))
    End Function

    Public Overloads Overrides Function IndexOf(ByVal parameterName As String) As Integer
      For parmIndex As Integer = 0 To InnerList.Count - 1
        If String.Compare(InnerList(parmIndex).ParameterName, parameterName, True) = 0 Then
          Return parmIndex
        End If
      Next
      Return -1
    End Function

    Public Overrides Sub Insert(ByVal index As Integer, ByVal value As Object)
      InnerList.Insert(index, DirectCast(value, AdParameter))
    End Sub

    Public Overrides ReadOnly Property IsFixedSize As Boolean
      Get
        Return DirectCast(InnerList, IList).IsFixedSize
      End Get
    End Property

    Public Overrides ReadOnly Property IsReadOnly As Boolean
      Get
        Return DirectCast(InnerList, IList).IsReadOnly
      End Get
    End Property

    Public Overrides ReadOnly Property IsSynchronized As Boolean
      Get
        Return DirectCast(InnerList, IList).IsSynchronized
      End Get
    End Property

    Public Overrides Sub Remove(ByVal value As Object)
      InnerList.Remove(DirectCast(value, AdParameter))
    End Sub

    Public Overloads Overrides Sub RemoveAt(ByVal index As Integer)
      InnerList.RemoveAt(index)
    End Sub

    Public Overloads Overrides Sub RemoveAt(ByVal parameterName As String)
      RemoveAt(IndexOf(parameterName))
    End Sub

    Protected Overloads Overrides Sub SetParameter(ByVal index As Integer, ByVal value As System.Data.Common.DbParameter)
      InnerList(index) = DirectCast(value, AdParameter)
    End Sub

    Protected Overloads Overrides Sub SetParameter(ByVal parameterName As String, ByVal value As System.Data.Common.DbParameter)
      SetParameter(IndexOf(parameterName), value)
    End Sub

    Public Overrides ReadOnly Property SyncRoot As Object
      Get
        Return DirectCast(InnerList, ICollection).SyncRoot
      End Get
    End Property
#End Region
  End Class
End Namespace

AdSorter

Namespace Data.ActiveDirectory
  ''' <summary>
  ''' Represents sorting a field.
  ''' </summary>
  ''' <remarks></remarks>
  Public Class AdSorter
    ''' <summary>
    ''' Instantiates a new instance of AdSorter.
    ''' </summary>
    ''' <param name="parameterName">
    ''' The name of the parameter to sort.
    ''' </param>
    ''' <remarks></remarks>
    Public Sub New(ByVal parameterName As String)
      _Direction = System.DirectoryServices.SortDirection.Ascending

      If parameterName.IndexOf(" ") > 0 Then
        _ParameterName = parameterName.Substring(0, parameterName.IndexOf(" "))
        If parameterName.Substring(parameterName.IndexOf(" ") + 1).Trim.ToUpper = "DESC" Then
          _Direction = System.DirectoryServices.SortDirection.Descending
        End If
      Else
        _ParameterName = parameterName
      End If
    End Sub

    ''' <summary>
    ''' Instantiate a new AdSorter instance.
    ''' </summary>
    ''' <param name="parameterName">
    ''' The name of the parameter to sort.
    ''' </param>
    ''' <param name="direction">
    ''' The direction to sort the parameter.
    ''' </param>
    ''' <remarks></remarks>
    Public Sub New(ByVal parameterName As String, ByVal direction As System.DirectoryServices.SortDirection)
      _ParameterName = parameterName
      _Direction = direction
    End Sub

    ''' <summary>
    ''' The name of the parameter to sort.
    ''' </summary>
    ''' <remarks></remarks>
    Public Property ParameterName As String

    ''' <summary>
    ''' The direction to sort the parameter.
    ''' </summary>
    ''' <remarks></remarks>
    Public Property Direction As System.DirectoryServices.SortDirection
  End Class
End Namespace

AdSorterCollection

Namespace Data.ActiveDirectory
  ''' <summary>
  ''' Represents a collection of AdSorter instances.
  ''' </summary>
  ''' <remarks>
  ''' AdDataReader only supports sorting on a single field.
  ''' </remarks>
  Public Class AdSorterCollection
    Inherits System.Collections.Generic.List(Of AdSorter)

    ''' <summary>
    ''' Get the first AdSorter in the list.
    ''' </summary>
    ''' <returns>
    ''' Returns the first AdSorter in the list when the list contains
    ''' at least one sorter, otherwise returns a null object.
    ''' </returns>
    ''' <remarks></remarks>
    Public ReadOnly Property Value As AdSorter
      Get
        If Count > 0 Then
          Return Item(0)
        Else
          Return Nothing
        End If
      End Get
    End Property
  End Class
End Namespace

AdCommand

Imports System.Text.RegularExpressions

Namespace Data.ActiveDirectory
  ''' <summary>
  ''' Represents a non-transactionable Active Directory statement to execute against an Active Directory Domain Controller.
  ''' </summary>
  ''' <remarks>
  ''' <para>
  ''' The purpose of the AdCommand object is to bypass the limitations of the OLE DB Provider.
  ''' </para>
  ''' The ADSI OLE DB Provider suffers from the following limitations:
  ''' <list>
  ''' <item>Multivalued properties cannot be returned in the result set to SQL Server.</item>
  ''' <item>Paging is not supported therefore the result set is limited to the server limit (by default 1,000 rows).</item>
  ''' </list>
  ''' For more details about the ADSI OLE DB Provider refer to http://support.microsoft.com/kb/299410.
  ''' </remarks>
  Public Class AdCommand
    Inherits System.Data.Common.DbCommand

#Region "Definition Section"
    Private _CancelAction As Boolean
    Private _InnerException As AdException
    Private _PropertyNames() As String
    Private _RowsAffected As Integer = -1
    Private _Searcher As System.DirectoryServices.DirectorySearcher

    'The following constants for use with PutEx. For more details refer
    'to: http://technet.microsoft.com/en-us/library/ee156515.aspx.
    Private Const ADS_PROPERTY_CLEAR As Integer = 1
    Private Const ADS_PROPERTY_UPDATE As Integer = 2
    Private Const ADS_PROPERTY_APPEND As Integer = 3
    Private Const ADS_PROPERTY_DELETE As Integer = 4
#End Region

#Region "Constructor Section"
    ''' <summary>
    ''' Instantiate a new instance of the AdCommand class.
    ''' </summary>
    ''' <remarks></remarks>
    Public Sub New()
    End Sub

    ''' <summary>
    ''' Instantiate a new instance of the AdCommand class.
    ''' </summary>
    ''' <param name="commandText">
    ''' The text of the query.
    ''' </param>
    ''' <remarks></remarks>
    Public Sub New(ByVal commandText As String)
      Me.CommandText = commandText
    End Sub

    ''' <summary>
    ''' Instantiate a new instance of the AdCommand class.
    ''' </summary>
    ''' <param name="commandText">
    ''' The text of the query.
    ''' </param>
    ''' <param name="connectionString">
    ''' The connection used to open the Active Directory database or the key
    ''' name referring to the connection string stored in AppSettings or Web.Config.
    ''' </param>
    ''' <remarks></remarks>
    Public Sub New(ByVal commandText As String, ByVal connectionString As String)
      Me.CommandText = commandText
      Me.Connection = New AdConnection(connectionString)
    End Sub

    ''' <summary>
    ''' Instantiate a new instance of the AdCommand class.
    ''' </summary>
    ''' <param name="commandText">
    ''' The text of the query.
    ''' </param>
    ''' <param name="connection">
    ''' An AdConnection that represents the connection to an instance of Active Directory.
    ''' </param>
    ''' <remarks></remarks>
    Public Sub New(ByVal commandText As String, ByVal connection As AdConnection)
      Me.CommandText = commandText
      Me.Connection = connection
    End Sub

    ''' <summary>
    ''' Instantiate a new instance of the AdCommand class.
    ''' </summary>
    ''' <param name="commandText">
    ''' The text of the query.
    ''' </param>
    ''' <param name="connection">
    ''' An AdConnection that represents the connection to an instance of Active Directory.
    ''' </param>
    ''' <param name="transaction">
    ''' Not Supported. The AdTransaction in which the AdCommand executes.
    ''' </param>
    ''' <remarks></remarks>
    Public Sub New(ByVal commandText As String, ByVal connection As AdConnection, ByVal transaction As IDbTransaction)
      Me.CommandText = commandText
      Me.Connection = connection
      'Transaction is ignored by this interface
    End Sub
#End Region

#Region "Supporting Behaviors"
    ''' <summary>
    ''' Get a string array of command text.
    ''' </summary>
    ''' <remarks></remarks>
    Friend ReadOnly Property InnerCommandSets As AdCommandTextSets
      Get
        If _InnerCommands Is Nothing OrElse _InnerCommands.Count = 0 Then
          _InnerCommands = New AdCommandTextSets(CommandText)
        End If
        Return _InnerCommands
      End Get
    End Property
    Private _InnerCommands As AdCommandTextSets

    ''' <summary>
    ''' Throws an InvalidOperationiException when the current row is null.
    ''' </summary>
    ''' <remarks></remarks>
    Private Sub ThrowErrorOnInvalidRead()
      If _Searcher Is Nothing Then
        Throw New InvalidOperationException("Attempted to read an invalid record.")
      End If
    End Sub

    ''' <summary>
    ''' Replaces named parameters in the CommandText insert or update statements with the values from the Parameters collection.
    ''' </summary>
    ''' <param name="index">
    ''' An integer value to the specific parser to update.
    ''' </param>
    ''' <remarks>
    ''' Don't replace Me.Parameters values or the
    ''' parameter name can't be found in future calls.
    ''' </remarks>
    Private Function ReplaceNamedParameters(ByVal index As Integer) As AdParameterCollection
      Dim targetCol As New AdParameterCollection
      Dim parmName As String

      'Replace named parameters with provided parameter values
      For Each adQryParm As AdParameter In InnerCommandSets(index).Parameters
        Dim targetParm As New AdParameter
        adQryParm.CopyTo(targetParm)
        targetCol.Add(targetParm)

        If targetParm.Value IsNot Nothing _
        AndAlso targetParm.Value.ToString.StartsWith("@") Then
          parmName = targetParm.Value.ToString.Trim
          For Each adParm As AdParameter In Parameters
            If String.Compare(adParm.ParameterName, parmName, True) = 0 Then
              targetParm.Value = adParm.Value
              Exit For
            End If
          Next
        End If
      Next

      Return targetCol
    End Function

    ''' <summary>
    ''' Replaced named parameters in the CommandText where clause with the values from the Parameters collection.
    ''' </summary>
    ''' <param name="filter">
    ''' An ADSI filter with named parameters.
    ''' </param>
    ''' <returns>
    ''' The modified adsi filter.
    ''' </returns>
    ''' <remarks></remarks>
    Private Function ReplaceNamedParametersInFilter(ByVal filter As String) As String
      Dim namedParms As MatchCollection = Regex.Matches(filter, "@[^/(/)]*", RegexOptions.IgnoreCase Or RegexOptions.Multiline)

      For parmIndex As Integer = namedParms.Count - 1 To 0 Step -1
        Dim namedParmMatch As System.Text.RegularExpressions.Match = namedParms(parmIndex)
        Dim parmName As String = namedParmMatch.Value.Trim
        For Each adParm As AdParameter In Parameters
          If String.Compare(adParm.ParameterName, parmName, True) = 0 Then
            Dim parameterValue As String = AdCommandTextParser.EscapeFilterValue(adParm.Value.ToString)
            filter = filter.Substring(0, namedParmMatch.Index) & parameterValue & filter.Substring(namedParmMatch.Index + namedParmMatch.Length)
            Exit For
          End If
        Next
      Next

      Return filter
    End Function

    ''' <summary>
    ''' Searches the path for parameter names replacing the parameter names with the corresponding value.
    ''' </summary>
    ''' <param name="path">
    ''' The path to search for parameter names.
    ''' </param>
    ''' <remarks></remarks>
    Private Sub ReplaceNamedParametersInPath(ByVal path As Path)
      For Each adParm As AdParameter In Parameters
        If Not String.IsNullOrWhiteSpace(path.Provider) _
        AndAlso String.Compare(path.Provider.Trim, adParm.ParameterName, True) = 0 Then
          path.Provider = adParm.Value.ToString
        End If

        If Not String.IsNullOrWhiteSpace(path.HostName) _
        AndAlso String.Compare(path.HostName.Trim, adParm.ParameterName, True) = 0 Then
          path.HostName = adParm.Value.ToString
        End If

        If Not String.IsNullOrWhiteSpace(path.PortNumber) _
        AndAlso String.Compare(path.PortNumber.Trim, adParm.ParameterName, True) = 0 Then
          path.PortNumber = adParm.Value.ToString
        End If

        For Each rdn As RelativeDistinguishedName In path.RDNs
          If String.Compare(rdn.Value.Trim, adParm.ParameterName.Trim, True) = 0 Then
            If adParm.Value Is Nothing Then
              rdn.Value = Nothing
            Else
              rdn.Value = adParm.Value.ToString
            End If

            Exit For
          End If
        Next
      Next
    End Sub

    ''' <summary>
    ''' Get a DirectorySearcher configured for the specified connection and initialized to execute the specified command text.
    ''' </summary>
    ''' <param name="commandIndex">
    ''' The index to the command text to execute.
    ''' </param>
    ''' <returns>
    ''' Returns an initialized DirectorySearcher.
    ''' </returns>
    ''' <remarks></remarks>
    Friend Function CreateSearcher(ByVal commandIndex As Integer) As System.DirectoryServices.DirectorySearcher
      'Instantiate Search Engine
      Dim parser As AdCommandTextParser = InnerCommandSets(commandIndex)
      Dim searchRoot As String
      If parser.SearchRoot Is Nothing OrElse String.IsNullOrWhiteSpace(parser.SearchRoot) Then
        Dim connectionBuilder As New AdConnectionStringBuilder(Connection.ConnectionString)
        searchRoot = connectionBuilder.RootDN
      Else
        searchRoot = parser.SearchRoot
      End If

      Dim filter As String = ReplaceNamedParametersInFilter(parser.Filter)
      _Searcher = Connection.CreateDirectorySearcher(filter, searchRoot)

      'Load Property Names
      For Each propertyItem As AdParameter In parser.Parameters
        If String.Compare(propertyItem.ParameterName, "ADsPath", True) <> 0 Then
          _Searcher.PropertiesToLoad.Add(propertyItem.ParameterName)
        End If
      Next

      'Sort as needed
      If parser.OrderBy.Count > 0 Then
        _Searcher.Sort = New System.DirectoryServices.SortOption(parser.OrderBy.Value.ParameterName, parser.OrderBy.Value.Direction)
      End If

      _Searcher.ServerPageTimeLimit = TimeSpan.FromSeconds(CommandTimeout)
      Return _Searcher
    End Function

    ''' <summary>
    ''' Get a DirectorySearcher configured for the specified connection and initialized to execute the specified command text.
    ''' </summary>
    ''' <param name="commandText">
    ''' The command text to execute.
    ''' </param>
    ''' <returns>
    ''' Returns an initialized DirectorySearcher.
    ''' </returns>
    ''' <remarks></remarks>
    Private Function CreateSearcher(ByVal commandText As String) As System.DirectoryServices.DirectorySearcher
      'Instantiate Search Engine
      Dim parser As New AdCommandTextParser(commandText)
      Dim filter As String = ReplaceNamedParametersInFilter(parser.Filter)
      _Searcher = Connection.CreateDirectorySearcher(filter, parser.SearchRoot)

      'Load Property Names
      For Each propertyItem As AdParameter In parser.Parameters
        If String.Compare(propertyItem.ParameterName, "ADsPath", True) <> 0 Then
          _Searcher.PropertiesToLoad.Add(propertyItem.ParameterName)
        End If
      Next

      'Sort as needed
      If parser.OrderBy.Count > 0 Then
        _Searcher.Sort = New System.DirectoryServices.SortOption(parser.OrderBy.Value.ParameterName, parser.OrderBy.Value.Direction)
      End If

      _Searcher.ServerPageTimeLimit = TimeSpan.FromSeconds(CommandTimeout)
      Return _Searcher
    End Function

    ''' <summary>
    ''' Deletes an object from Active Directory.
    ''' </summary>
    ''' <param name="adsiPath">The path to the object to delete.</param>
    ''' <remarks>
    ''' To delete an object the parent and child must be created
    ''' from the same DirectoryEntry object. If they are created
    ''' from different DirectoryEntry objects the action will be
    ''' denied by the system.
    ''' </remarks>
    Private Function DeleteObject(ByVal adsiPath As String) As Boolean
      Dim returnCode As Boolean = False
      Dim parentEntry As System.DirectoryServices.DirectoryEntry = Nothing

      Try
        'Ensure Formatting
        Dim adPath As New Path(adsiPath)
        ReplaceNamedParametersInPath(adPath)

        'Get the Object
        Dim childEntry As System.DirectoryServices.DirectoryEntry
        childEntry = Connection.CreateDirectoryEntry(adPath.ToString)

        'Get the Parent
        parentEntry = childEntry.Parent

        'Double check the binding to ensure complete connection to Active Directory.
        Dim _adsNative As Object = parentEntry.NativeObject

        'Delete the child
        parentEntry.Children.Remove(childEntry)
        parentEntry.CommitChanges()

        returnCode = True
      Catch ex As Exception
        _InnerException.Errors.Add(New AdException("Error occurred while deleting record.", ex))
      Finally
        If parentEntry IsNot Nothing Then parentEntry.Dispose()
      End Try

      Return returnCode
    End Function

    ''' <summary>
    ''' Deletes a container and its children from Active Directory.
    ''' </summary>
    ''' <param name="adsiPath">
    ''' The path to the container to delete.
    ''' </param>
    ''' <remarks></remarks>
    Private Function DeleteTree(ByVal adsiPath As String) As Boolean
      Dim returnCode As Boolean = False

      Try
        'Ensure Formatting
        Dim adPath As New Path(adsiPath)
        ReplaceNamedParametersInPath(adPath)

        Dim childEntry As System.DirectoryServices.DirectoryEntry
        childEntry = Connection.CreateDirectoryEntry(adPath.ToString)
        childEntry.DeleteTree()
        returnCode = True
      Catch ex As Exception
        If ex.Message.Trim.ToLower = "there is no such object on the server." Then
          'Ignore - Object Does Not Exist
          returnCode = True
        Else
          _InnerException.Errors.Add(New AdException("Error occurred while deleting tree.", ex))
        End If
      End Try

      Return returnCode
    End Function

    ''' <summary>
    ''' Create new objects in Active Directory.
    ''' </summary>
    ''' <param name="orgUnitPath">The ADSI Path to the organizational unit where the object will be stored.</param>
    ''' <param name="name">The name to give the new object.</param>
    ''' <param name="objectSchemaName">The schema class name to base the new object upon.</param>
    ''' <param name="propertiesToSave">The values to save to the object.</param>
    ''' <remarks></remarks>
    Private Function CreateObject(ByVal orgUnitPath As String, ByVal name As String, ByVal objectSchemaName As String, ByVal propertiesToSave As AdParameterCollection) As Boolean
      Dim parentEntry As System.DirectoryServices.DirectoryEntry = Nothing
      Dim childEntry As System.DirectoryServices.DirectoryEntry = Nothing
      Dim returnCode As Boolean = False
      Dim allPropertiesSaved As Boolean = True

      Try
        'Ensure Formatting
        Dim ouPath As Path
        If String.IsNullOrWhiteSpace(orgUnitPath) Then
          ouPath = New Path(Connection.InnerBuilder.RootDN)
        Else
          ouPath = New Path(orgUnitPath)
        End If
        ReplaceNamedParametersInPath(ouPath)

        'Validate Name & Ensure Encoding
        Dim rdn As RelativeDistinguishedName
        If name.IndexOf("=") < 0 Then
          rdn = New RelativeDistinguishedName("CN=" & name)
        ElseIf name.IndexOf("=") < 1 Then
          rdn = New RelativeDistinguishedName("CN" & name)
        Else
          rdn = New RelativeDistinguishedName(name)
        End If

        'Get the Parent Object
        parentEntry = Connection.CreateDirectoryEntry(ouPath.ToString)

        'Attempt to retrieve the SchemaName if missing
        If objectSchemaName Is Nothing OrElse String.IsNullOrWhiteSpace(objectSchemaName) Then
          objectSchemaName = parentEntry.SchemaClassName
        End If

        'Double check the binding to ensure complete connection to Active Directory.
        Dim adsNative As Object = parentEntry.NativeObject

        'Create the Child Object
        childEntry = parentEntry.Children.Add(rdn.ToString, objectSchemaName)

        'Save the values to the object
        returnCode = SaveObject(childEntry, propertiesToSave)
      Catch ex As Exception
        _InnerException.Errors.Add(New AdException("Error occurred while creating a new record.", ex))
      Finally
        If childEntry IsNot Nothing Then childEntry.Dispose()
        If parentEntry IsNot Nothing Then parentEntry.Dispose()
      End Try

      Return returnCode
    End Function

    ''' <summary>
    ''' Saves changes to an Active Directory object.
    ''' </summary>
    ''' <param name="adsiPath">The path to the object to update.</param>
    ''' <param name="propertiesToSave">The values to add/remove from the object.</param>
    ''' <remarks></remarks>
    Private Function SaveObject(ByVal adsiPath As String, ByVal propertiesToSave As AdParameterCollection) As Boolean
      Dim returnCode As Boolean = False
      Dim dirEntry As System.DirectoryServices.DirectoryEntry = Nothing

      Try
        'Ensure Formatting
        Dim adPath As New Path(adsiPath)
        ReplaceNamedParametersInPath(adPath)

        'Get Object
        dirEntry = Connection.CreateDirectoryEntry(adPath.ToString)

        'Check binding to ensure active, complete connection to Active Directory.
        Dim adsNative As Object = dirEntry.NativeObject

        'Save Changes
        returnCode = SaveObject(dirEntry, propertiesToSave)
      Catch ex As Exception
        _InnerException.Errors.Add(New AdException("Error occurred while saving changes.", ex))
      Finally
        If dirEntry IsNot Nothing Then dirEntry.Dispose()
      End Try

      Return returnCode
    End Function

    ''' <summary>
    ''' Saves changes to an Active Directory object.
    ''' </summary>
    ''' <param name="dirEntry">An DirectoryEntry object.</param>
    ''' <param name="propertiesToSave">The values to add/remove from the object.</param>
    ''' <remarks>
    ''' Multivalued attribute names that begin with a plus (+) or have no operator are appended.
    ''' Multivalued attribute names that begin with a dash (-) are removed from the value.
    ''' The attribute name may be used only once per query. Therefore you cannot add a value and
    ''' remove a value in the same call.
    ''' Multivalued attributes do not support replacing a specific field location. Instead the field
    ''' is viewed as a list of values that can have values appended or removed...Never replaced.
    ''' By restricting the system to perform one action per call and by not supporting replacing values
    ''' the system avoids the problems associated with multivalued attribute updates in an environment
    ''' that does not support delta changes.
    ''' When adding a value that already exists in a multivalued attribute a Duplicate Object error
    ''' may or may not be thrown depending on the attribute. For example, the url attribute ignores
    ''' the value when a duplicate while the member attribute throws an exception.
    ''' </remarks>
    Private Function SaveObject(ByVal dirEntry As System.DirectoryServices.DirectoryEntry, ByVal propertiesToSave As AdParameterCollection) As Boolean
      Dim returnCode As Boolean = False

      Try
        Dim password As String = String.Empty

        'Populate the Object
        For Each propertyItem As AdParameter In propertiesToSave
          If String.Compare(propertyItem.ParameterName, "ADsPath", True) = 0 Then
            'This attribute is used to find the object to update...Ignore
          ElseIf String.Compare(propertyItem.ParameterName.Trim, "Password", True) = 0 Then
            dirEntry.Invoke("SetPassword", New Object() {propertyItem.Value.ToString})
          ElseIf propertyItem.IsMultiValued Then
            If propertyItem.RemoveValue Then
              dirEntry.Properties.Item(propertyItem.ParameterName).Remove(propertyItem.Value)
            ElseIf propertyItem.AppendValue Then
              dirEntry.Properties.Item(propertyItem.ParameterName).Add(propertyItem.Value)
            Else
              Throw New AdException("Replacing values is not supported.")
            End If
          ElseIf propertyItem Is Nothing OrElse propertyItem.Value Is Nothing OrElse String.IsNullOrWhiteSpace(propertyItem.Value.ToString) Then
            dirEntry.Properties.Item(propertyItem.ParameterName).Clear()
          ElseIf dirEntry.Properties.Item(propertyItem.ParameterName).Count = 0 _
          OrElse (String.Compare(dirEntry.Properties.Item(propertyItem.ParameterName).Value.ToString, propertyItem.Value.ToString, True) <> 0) Then
            'Save only if there are changes to save to reduce network traffic
            dirEntry.Properties.Item(propertyItem.ParameterName).Value = propertyItem.Value
          End If
        Next

        'Save Object Changes
        dirEntry.CommitChanges()
        returnCode = True
      Catch ex As Exception
        _InnerException.Errors.Add(New AdException("Error occurred while saving record.", ex))
      Finally
        If dirEntry IsNot Nothing Then dirEntry.Dispose()
      End Try

      Return returnCode
    End Function
#End Region

#Region "Implement DbCommand Interface"
    ''' <summary>
    ''' Tries to cancel the execution of an AdCommand.
    ''' </summary>
    ''' <remarks></remarks>
    Public Overrides Sub Cancel()
      _CancelAction = True
    End Sub

    ''' <summary>
    ''' Gets or sets the Transact-SQL statement to execute at the data source.
    ''' </summary>
    ''' <remarks></remarks>
    Public Overrides Property CommandText As String
      Get
        Return _CommandText
      End Get
      Set(ByVal value As String)
        _CommandText = value
        _InnerCommands = Nothing
      End Set
    End Property
    Private _CommandText As String

    ''' <summary>
    ''' Gets or sets the wait time before terminating the attempt to execute a command.
    ''' May or may not return an error. May cause a partial list of results to be returned.
    ''' </summary>
    ''' <remarks></remarks>
    Public Overrides Property CommandTimeout As Integer

    ''' <summary>
    ''' Gets or sets a value indicating how the CommandText property is interpreted.
    ''' </summary>
    ''' <value>
    ''' Only supports Text. Table and Procedure options are not supported.
    ''' </value>
    ''' <returns>
    ''' Returns CommandType.Text
    ''' </returns>
    ''' <remarks></remarks>
    Public Overrides Property CommandType As System.Data.CommandType
      Get
        Return System.Data.CommandType.Text
      End Get
      Set(ByVal value As System.Data.CommandType)
        If value <> System.Data.CommandType.Text Then
          Throw New ArgumentException("The value provided for CommandType is not support by AdCommand. Must use CommandType.Text", "value")
        End If
        _CommandType = System.Data.CommandType.Text
      End Set
    End Property
    Private _CommandType As System.Data.CommandType = System.Data.CommandType.Text

    ''' <summary>
    ''' Creates a new instance of a DbParameter object.
    ''' </summary>
    ''' <returns>A DbParameter object.</returns>
    ''' <remarks></remarks>
    Protected Overrides Function CreateDbParameter() As System.Data.Common.DbParameter
      Dim parmIndex As Integer = MyBase.Parameters.Add(New AdParameter)
      Return MyBase.Parameters(parmIndex)
    End Function

    ''' <summary>
    ''' Creates a new instance of a SqlParameter object.
    ''' </summary>
    ''' <returns>An AdParameter object.</returns>
    ''' <remarks></remarks>
    Public Shadows Function CreateParameter() As AdParameter
      Dim parmIndex As Integer = MyBase.Parameters.Add(New AdParameter)
      Return DirectCast(MyBase.Parameters(parmIndex), AdParameter)
    End Function

    ''' <summary>
    ''' Gets or sets the DbConnection used by this DbCommand.
    ''' </summary>
    ''' <remarks></remarks>
    Protected Overrides Property DbConnection As System.Data.Common.DbConnection
      Get
        Return _DbConnection
      End Get
      Set(ByVal value As System.Data.Common.DbConnection)
        _DbConnection = value
      End Set
    End Property
    Private _DbConnection As System.Data.Common.DbConnection

    ''' <summary>
    ''' Gets or sets the AdConnection used by this instance of the AdCommand.
    ''' </summary>
    ''' <remarks></remarks>
    Public Shadows Property Connection As AdConnection
      Get
        Return DirectCast(MyBase.Connection, AdConnection)
      End Get
      Set(ByVal value As AdConnection)
        DbConnection = value
      End Set
    End Property

    ''' <summary>
    ''' Gets the collection of DbParameter objects.
    ''' </summary>
    ''' <remarks></remarks>
    Protected Overrides ReadOnly Property DbParameterCollection As System.Data.Common.DbParameterCollection
      Get
        If _Parameters Is Nothing Then _Parameters = New AdParameterCollection
        Return _Parameters
      End Get
    End Property
    Private _Parameters As AdParameterCollection

    ''' <summary>
    ''' Gets the collection of AdParameter objects.
    ''' </summary>
    ''' <remarks></remarks>
    Public Shadows ReadOnly Property Parameters As AdParameterCollection
      Get
        Return DirectCast(MyBase.Parameters, AdParameterCollection)
      End Get
    End Property

    ''' <summary>
    ''' Gets or sets the DbTransaction within which this DbCommand object executes.
    ''' </summary>
    ''' <remarks></remarks>
    Protected Overrides Property DbTransaction As System.Data.Common.DbTransaction

    ''' <summary>
    ''' Gets or sets a value indicating whether the command object should be visible in a Windows Form Designer control.
    ''' </summary>
    ''' <remarks></remarks>
    Public Overrides Property DesignTimeVisible As Boolean

    ''' <summary>
    ''' Executes the command text against the connection.
    ''' </summary>
    ''' <param name="behavior">
    ''' One of the CommandBehavior values.
    ''' </param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Protected Overrides Function ExecuteDbDataReader(ByVal behavior As System.Data.CommandBehavior) As System.Data.Common.DbDataReader
      Return ExecuteReader(behavior)
    End Function

    ''' <summary>
    ''' Sends the CommandText to the Connection and builds an AdDataReader.
    ''' </summary>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Shadows Function ExecuteReader() As AdDataReader
      Return ExecuteReader(CommandBehavior.Default)
    End Function

    ''' <summary>
    ''' Sends the CommandText to the Connection and builds an AdDataReader.
    ''' </summary>
    ''' <param name="behavior">
    ''' One of the CommandBehavior values.
    ''' </param>
    ''' <returns>
    ''' A SqlDataReader object.
    ''' </returns>
    ''' <remarks></remarks>
    Public Shadows Function ExecuteReader(ByVal behavior As System.Data.CommandBehavior) As AdDataReader
      Prepare()
      Return New AdDataReader(Me, behavior)
    End Function

    ''' <summary>
    ''' Executes a Transact-SQL statement against the connection and returns the number of objects affected.
    ''' </summary>
    ''' <returns>
    ''' The number of objects affected.
    ''' </returns>
    ''' <remarks></remarks>
    Public Overrides Function ExecuteNonQuery() As Integer
      Dim reader As AdDataReader = Me.ExecuteReader
      Dim recordsAffected As Integer = 0
      Dim returnCode As Boolean
      Dim errorThrown As Boolean = False

      Try
        If Not _CancelAction Then
          Do
            Dim commandTextParser As AdCommandTextParser = InnerCommandSets(reader.DatasetIndex)
            Dim deleteTreeSwitch As Boolean = commandTextParser.DeleteTree
            Dim dnIndex As Integer = -1

            'Replace named parameters with provided parameter values
            Dim parmValues As AdParameterCollection = ReplaceNamedParameters(reader.DatasetIndex)

            'Need to know which properties are multi-valued attributes to correctly manage insert, update and deletes.
            For Each propertyItem As AdParameter In parmValues
              propertyItem.IsMultiValued = reader.IsFieldMultiValued(propertyItem.ParameterName)
            Next

            If reader.HasRows Then
              While reader.Read AndAlso Not _CancelAction
                If dnIndex < 0 Then dnIndex = reader.GetOrdinal("adsPath")

                Select Case commandTextParser.CommandType
                  Case StatementTypes.Delete
                    If deleteTreeSwitch Then
                      returnCode = DeleteTree(reader.GetString(dnIndex))
                    Else
                      returnCode = DeleteObject(reader.GetString(dnIndex))
                    End If
                    If returnCode Then recordsAffected += 1 Else errorThrown = True
                  Case StatementTypes.Update
                    returnCode = SaveObject(reader.GetString(dnIndex), parmValues)
                    If returnCode Then recordsAffected += 1 Else errorThrown = True
                End Select

                If Not returnCode Then _InnerException.IncrementRecordsAffected()
              End While
            ElseIf commandTextParser.CommandType = StatementTypes.Insert Then
              returnCode = CreateObject(commandTextParser.SearchRoot, parmValues("name").Value.ToString, commandTextParser.ObjectCategory, parmValues)
              If returnCode Then recordsAffected += 1 Else errorThrown = True
            End If
          Loop While Not reader.IsClosed AndAlso reader.NextResult AndAlso Not _CancelAction
        End If
      Catch ex As Exception
        _InnerException.Errors.Add(New AdException("Error occurred in ExecuteNonQuery.", ex))
        errorThrown = True
      End Try

      If errorThrown Then
        Connection.OnInfoMessage("One or more errors were thrown while executing the command.", _InnerException)
        Throw _InnerException
      End If

      Return recordsAffected
    End Function

    ''' <summary>
    ''' Executes the query, and returns the first property of the first object in the result set returned by the query.
    ''' Additional properties or objects are ignored.
    ''' </summary>
    ''' <returns>
    ''' The first property of the first object in the result set, or a null reference (Nothing in Visual Basic) if the result set is empty.
    ''' </returns>
    ''' <remarks></remarks>
    Public Overrides Function ExecuteScalar() As Object
      Try
        Dim reader As AdDataReader = Me.ExecuteReader
        If reader.HasRows AndAlso reader.Read Then Return reader.Item(0)
      Catch ex As Exception
        _InnerException.Errors.Add(ex)
        Throw _InnerException
      End Try
      Return Nothing
    End Function

    ''' <summary>
    ''' Executes the Transact-SQL statement returning the results as an XML document.
    ''' </summary>
    ''' <returns>A string value of the XML document.</returns>
    ''' <remarks></remarks>
    Public Function ExecuteXml() As String
      Return ExecuteXml(System.Data.CommandBehavior.Default)
    End Function

    ''' <summary>
    ''' Executes the Transact-SQL statement returning the results as an XML document.
    ''' </summary>
    ''' <param name="behavior">
    ''' One of the CommandBehavior values.
    ''' </param>
    ''' <returns>A string value of the XML document.</returns>
    ''' <remarks></remarks>
    Public Function ExecuteXml(ByVal behavior As System.Data.CommandBehavior) As String
      Dim xmlBuilder As New System.Text.StringBuilder
      Dim stringWriter As New System.IO.StringWriter(xmlBuilder)

      Dim xmlSettings As New System.Xml.XmlWriterSettings
      xmlSettings.ConformanceLevel = System.Xml.ConformanceLevel.Document
      xmlSettings.Encoding = System.Text.Encoding.UTF8
      xmlSettings.Indent = False

      Dim xmlWriter As System.Xml.XmlWriter = Xml.XmlWriter.Create(stringWriter, xmlSettings)

      Dim reader As AdDataReader = DirectCast(Me.ExecuteReader, AdDataReader)
      If reader.HasRows AndAlso Not _CancelAction Then
        xmlWriter.WriteStartDocument()
        If InnerCommandSets.Count > 1 Then xmlWriter.WriteStartElement("adResults")

        Do
          Dim className As String = Me.InnerCommandSets(reader.DatasetIndex).ObjectCategory
          Dim value As Object

          xmlWriter.WriteStartElement(className & "List")

          Do While reader.Read AndAlso Not _CancelAction
            xmlWriter.WriteStartElement(className & "Item")

            'Write Attributes
            For fieldIndex As Integer = 0 To reader.FieldCount - 1
              value = reader.Item(fieldIndex)

              If Not reader.IsFieldMultiValued(fieldIndex) _
              AndAlso value IsNot Nothing _
              AndAlso Not String.IsNullOrWhiteSpace(value.ToString) Then
                xmlWriter.WriteAttributeString(reader.GetName(fieldIndex), value.ToString.Trim)
              End If
            Next

            'Write Child Elements
            For fieldIndex As Integer = 0 To reader.FieldCount - 1
              value = reader.Item(fieldIndex)

              If reader.IsFieldMultiValued(fieldIndex) AndAlso TypeOf value Is IEnumerable Then
                xmlWriter.WriteStartElement(reader.GetName(fieldIndex))
                For Each itemValue As Object In DirectCast(value, IEnumerable)
                  xmlWriter.WriteStartElement("item")
                  xmlWriter.WriteAttributeString("value", itemValue.ToString)
                  xmlWriter.WriteEndElement()
                Next
                xmlWriter.WriteEndElement()
              End If
            Next

            xmlWriter.WriteEndElement()
          Loop

          xmlWriter.WriteEndElement()
        Loop While Not reader.IsClosed AndAlso reader.NextResult AndAlso Not _CancelAction

        If InnerCommandSets.Count > 1 Then xmlWriter.WriteEndElement()
        xmlWriter.WriteEndDocument()
      End If

      xmlWriter.Flush()
      stringWriter.Flush()
      stringWriter.Dispose()

      'Some reason encoding setting only works when saving to a file...
      Return xmlBuilder.ToString
    End Function

    ''' <summary>
    ''' Executes the Transact-SQL statement returning the results as an XML document.
    ''' </summary>
    ''' <returns>An XmlDocument.</returns>
    ''' <remarks></remarks>
    Public Function ExecuteXmlDocument() As Xml.XmlDocument
      Return ExecuteXmlDocument(System.Data.CommandBehavior.Default)
    End Function

    ''' <summary>
    ''' Executes the Transact-SQL statement returning the results as an XML document.
    ''' </summary>
    ''' <param name="behavior">
    ''' One of the CommandBehavior values.
    ''' </param>
    ''' <returns>An XmlDocument.</returns>
    ''' <remarks></remarks>
    Public Function ExecuteXmlDocument(ByVal behavior As System.Data.CommandBehavior) As Xml.XmlDocument
      Dim xmlText As String = ExecuteXml(behavior)
      Dim xDoc As New Xml.XmlDocument
      xDoc.LoadXml(xmlText)
      Return xDoc
    End Function

    ''' <summary>
    ''' Creates a prepared version of the command on an instance of SQL Server.
    ''' </summary>
    ''' <remarks></remarks>
    Public Overrides Sub Prepare()
      _CancelAction = False
      _RowsAffected = 0
      _InnerException = New AdException
    End Sub

    ''' <summary>
    ''' Gets or sets how command results are applied to the DataRow when used by the Update method of the DbDataAdapter.
    ''' </summary>
    ''' <remarks></remarks>
    Public Overrides Property UpdatedRowSource As System.Data.UpdateRowSource
#End Region
  End Class
End Namespace
Advertisements

Leave a Comment »

No comments yet.

RSS feed for comments on this post. TrackBack URI

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out /  Change )

Google+ photo

You are commenting using your Google+ account. Log Out /  Change )

Twitter picture

You are commenting using your Twitter account. Log Out /  Change )

Facebook photo

You are commenting using your Facebook account. Log Out /  Change )

w

Connecting to %s

Create a free website or blog at WordPress.com.

%d bloggers like this: