Imports LzmTW.DirectoryServices ''' <summary> ''' PathService结合ldapPath专为简化AD域组织单元、<a href="/tag/yonghu/" target="_blank" class="keywords">用户</a>、计算机、网络打印机的节点管理而设计。 ''' PathService将PathService与DirectoryEntry、Princial紧密结合在一起。 ''' 此为示例。示例后贴出主要<a href="/tag/daima/" target="_blank" class="keywords">代码</a>，全部<a href="/tag/daima/" target="_blank" class="keywords">代码</a>计划以资源下载提供。 ''' ''' 仅供参考。水如烟(http://www.cnblogs.com/LzmTW,http://blog.csdn.net/lzmtw) ''' 20090310 ''' </summary> Public Class PathServiceDemo Public Sub Test() Dim service As PathService service = (New <a href="/tag/logo/" target="_blank" class="keywords">logo</a>n).CreateDomainService.CreatePathService service.Path = "CN=水如烟,OU=VB,OU=NET,OU=CSDN<a href="/tag/yonghu/" target="_blank" class="keywords">用户</a>" output(service) '对象路径:LDAP://myServer.myDomain.local/CN=水如烟,OU=CSDN<a href="/tag/yonghu/" target="_blank" class="keywords">用户</a>,DC=myDomain,DC=local 存在否:True service.Name = "lzmtw" output(service) '对象路径:LDAP://myServer.myDomain.local/CN=lzmtw,DC=local 存在否:False service.Add() output(service) '对象路径:LDAP://myServer.myDomain.local/CN=lzmtw,DC=local 存在否:True Dim parent As PathService = service.GetParentService output(parent) '对象路径:LDAP://myServer.myDomain.local/OU=VB,DC=local 存在否:True parent.Name = "CSharp" output(parent) '对象路径:LDAP://myServer.myDomain.local/OU=CSharp,DC=local 存在否:True service.MoveTo(parent.Path) output(service) '对象路径:LDAP://myServer.myDomain.local/CN=lzmtw,OU=CSharp,DC=local 存在否:True service.Delete() output(service) '对象路径:LDAP://myServer.myDomain.local/CN=lzmtw,DC=local 存在否:False End Sub Private Sub output(ByVal service As PathService) Console.WriteLine("对象路径:{0} 存在否:{1}",service.Path,service.IsExists) End Sub End Class

主要代码:

Public Class PathService Inherits ldapPath Private gEntry As DirectoryEntry = Nothing Private gPrincipal As Principal = Nothing Private gIsExists As Boolean Private gDomainService As DomainService Private gSchemaClassName As String Private gobjectCategory As String Private gWhenCreated As Nullable(Of DateTime) Friend Sub New(ByVal service As DomainService) MyBase.New(service.<a href="/tag/logo/" target="_blank" class="keywords">logo</a>n.ConnectedServerName) Me.gDomainService = service Me.OnPathChanged() End Sub Public ReadOnly Property DomainService() As DomainService Get Return gDomainService End Get End Property Protected ReadOnly Property Entry() As DirectoryEntry Get Return gEntry End Get End Property Protected ReadOnly Property Principal() As Principal Get Return gPrincipal End Get End Property ''' <summary> ''' <a href="/tag/huoqu/" target="_blank" class="keywords">获取</a>一个值，表示节点对象是否存在 ''' </summary> Public ReadOnly Property IsExists() As Boolean Get Return gIsExists End Get End Property ''' <summary> ''' <a href="/tag/huoqu/" target="_blank" class="keywords">获取</a>或设置节点对象的架构类的<a href="/tag/mingcheng/" target="_blank" class="keywords">名称</a> ''' </summary> ''' <remarks >仅当节点不存在时才能够设置架构类<a href="/tag/mingcheng/" target="_blank" class="keywords">名称</a>(<a href="/tag/tianjia/" target="_blank" class="keywords">添加</a>节点时用到)</remarks> Public Property SchemaClassName() As String Get Return gSchemaClassName End Get Set(ByVal value As String) If Me.IsExists Then Return If Me.DomainService.FindActiveDirectorySchemaClass(value) Is Nothing Then Throw New Exception("域中无此架构类。") gSchemaClassName = value End Set End Property ''' <summary> ''' <a href="/tag/huoqu/" target="_blank" class="keywords">获取</a>节点对象的架构类 ''' </summary> Public ReadOnly Property SchemaClass() As ActiveDirectorySchemaClass Get Return Me.DomainService.FindActiveDirectorySchemaClass(Me.SchemaClassName) End Get End Property ''' <summary> ''' <a href="/tag/huoqu/" target="_blank" class="keywords">获取</a>节点对象类别 ''' </summary> Public ReadOnly Property ObjectCategory() As String Get Return gobjectCategory End Get End Property ''' <summary> ''' <a href="/tag/huoqu/" target="_blank" class="keywords">获取</a>节点<a href="/tag/duixiangchuangjian/" target="_blank" class="keywords">对象创建</a>时间 ''' </summary> Public ReadOnly Property WhenCtreated() As Nullable(Of Date) Get Return gWhenCreated End Get End Property ''' <summary> ''' <a href="/tag/huoqu/" target="_blank" class="keywords">获取</a>节点对象<a href="/tag/shuxing/" target="_blank" class="keywords">属性</a> ''' </summary> ''' <param name="propertyName"><a href="/tag/shuxing/" target="_blank" class="keywords">属性</a><a href="/tag/mingcheng/" target="_blank" class="keywords">名称</a></param> Public ReadOnly Property PropertyObject(ByVal propertyName As String) As PropertyValueCollection Get Return Me.Entry.Properties(propertyName) End Get End Property ''' <summary> ''' <a href="/tag/huoqu/" target="_blank" class="keywords">获取</a>节点对象<a href="/tag/shuxing/" target="_blank" class="keywords">属性</a>值 ''' </summary> ''' <param name="propertyName"><a href="/tag/shuxing/" target="_blank" class="keywords">属性</a><a href="/tag/mingcheng/" target="_blank" class="keywords">名称</a></param> Public ReadOnly Property PropertyValue(ByVal propertyName As String) As Object Get Return Me.PropertyObject(propertyName).Value End Get End Property ''' <summary> ''' <a href="/tag/huoqu/" target="_blank" class="keywords">获取</a>与当前节点对象相符的DirectoryEntry实例 ''' </summary> Public Function GetCurrentDirectoryEntry() As DirectoryEntry Return Me.Entry End Function ''' <summary> ''' <a href="/tag/huoqu/" target="_blank" class="keywords">获取</a>与当前节点对象相符的Principal实例 ''' </summary> Public Function GetCurrentPrincipal() As Principal Return Me.Principal End Function ''' <summary> ''' 从域中重新检索当前节点对象 ''' </summary> Public Sub Reload() Me.Path = Me.Path End Sub ''' <summary> ''' <a href="/tag/tianjia/" target="_blank" class="keywords">添加</a>节点至节点父级对象成为一个新对象。由SchemaClassName指定新对象的架构类名。 ''' </summary> ''' <param name="keyValues"><a href="/tag/shuxing/" target="_blank" class="keywords">属性</a>值集合。如果需要，<a href="/tag/shengcheng/" target="_blank" class="keywords">生成</a>对象后更新对象<a href="/tag/shuxing/" target="_blank" class="keywords">属性</a></param> Public Sub Add(Optional ByVal keyValues As List(Of KeyValuePair(Of String,Object)) = Nothing) If Me.IsExists Then Throw New Exception("节点对象已存在") Dim parentPathService As PathService = Me.GetParentService If Not parentPathService.IsExists Then parentPathService.Dispose() Throw Me.ObjectNotExistsException(True) End If Dim tmpEntry As DirectoryEntry = parentPathService.Entry.Children.Add(Me.NameForLdap,Me.SchemaClassName) If keyValues IsNot Nothing Then For Each pair As KeyValuePair(Of String,Object) In keyValues tmpEntry.Properties(pair.Key).Value = pair.Value Next End If tmpEntry.CommitChanges() Me.Path = tmpEntry.Path tmpEntry.Dispose() tmpEntry = Nothing parentPathService.Dispose() End Sub ''' <summary> ''' <a href="/tag/shanchu/" target="_blank" class="keywords">删除</a>当前节点对象 ''' </summary> Public Sub Delete() If Not Me.IsExists Then Throw ObjectNotExistsException() Me.Entry.Parent.Children.Remove(Me.Entry) Me.Reload() End Sub ''' <summary> ''' 移动当前节点对象至与指定路径标识相符的父级 ''' </summary> ''' <param name="parentDistinguishedName">父级路径标识</param> ''' <remarks></remarks> Public Sub MoveTo(ByVal parentDistinguishedName As String) If Not Me.IsExists Then Throw ObjectNotExistsException() Dim parentService As PathService = Me.CreateNewInstance parentService.Path = parentDistinguishedName If Not parentService.IsExists Then parentService.Dispose() Throw ObjectNotExistsException() End If Me.Entry.MoveTo(parentService.Entry) Me.Path = Me.Entry.Path parentService.Dispose() End Sub ''' <summary> ''' 更改当前节点对象的<a href="/tag/mingcheng/" target="_blank" class="keywords">名称</a> ''' </summary> ''' <param name="newName">新<a href="/tag/mingcheng/" target="_blank" class="keywords">名称</a></param> Public Sub Rename(ByVal newName As String) If Not Me.IsExists Then Throw ObjectNotExistsException() Dim tmp As ldapPath = Me.Clone tmp.Name = newName Me.Entry.Rename(tmp.NameForLdap) Me.Path = Me.Entry.Path tmp.Dispose() End Sub ''' <summary> ''' 更新当前节点对象<a href="/tag/shuxing/" target="_blank" class="keywords">属性</a> ''' </summary> Public Sub Update() If Not Me.IsExists Then Throw ObjectNotExistsException() Me.Entry.CommitChanges() Me.Reload() End Sub ''' <summary> ''' 创建PathService新实例 ''' </summary> ''' <remarks >指向根节点</remarks> Public Function CreateNewInstance() As PathService Return New PathService(Me.DomainService) End Function ''' <summary> ''' <a href="/tag/huoqu/" target="_blank" class="keywords">获取</a>当前节点对象的父级PathService实例 ''' </summary> Public Function GetParentService() As PathService Dim instance As PathService = Me.CreateNewInstance instance.Path = Me.ParentDistinguishedName Return instance End Function Private Function ObjectNotExistsException(Optional ByVal IsParent As Boolean = False) As Exception If IsParent Then Return New Exception("父节点对象不存在。") End If Return New Exception("节点对象不存在。") End Function Protected Overrides Sub OnPathChanged() gEntry = Me.DomainService.CreateDirectoryEntry(Me.Path) Try gSchemaClassName = Me.Entry.SchemaClassName gPrincipal = Me.DomainService.DirectoryEntryToPrincipal(Me.Entry) gWhenCreated = CType(Me.PropertyValue("whenCreated"),Date?) gobjectCategory = Me.PropertyValue("objectCategory").ToString gIsExists = True Catch ex As Exception gIsExists = False gobjectCategory = Nothing gWhenCreated = New Nullable(Of DateTime) If Principal IsNot Nothing Then gPrincipal.Dispose() gPrincipal = Nothing End If End Try MyBase.OnPathChanged() End Sub '对DomainService不作处理。 Protected Overrides Sub Dispose(ByVal disposing As Boolean) If disposing Then If Me.IsExists Then Me.gPrincipal.Dispose() Me.gPrincipal = Nothing Me.gEntry.Dispose() Me.gEntry = Nothing End If End If MyBase.Dispose(disposing) End Sub End Class