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.
- First Post: Active Directory Data Access Layer
- Second Post: Active Directory Connection Strings
- Third Post: AdConnection: Enforcing Active Directory Communication Best Practices
- Fourth Post: AdCommandTextParser: Parsing SQL Statements
- Fifth Post: AdCommand: Running Active Directory Queries
- Sixth Post: AdDataReader: Providing Controlled Access to AD Values
- Seventh Post: AdDataAdapter: Managing Active Directory Data
- Eighth Post: AD Query: Putting it All Together
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
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
Larry Steinle 
Leave a Reply