一个简单的操作活动目录的类（ADHelper）

 

' -----------------------------------------------------------------------------
'  说明：操作AD用到了两种协议，WinNT和LDAP
'
'        WinNT —— 可以以较高的权限进行操作，但可操作的对象比较少。
'                   一般用来添加（删除）用户和组、修改密码、添加用户到组。
'
'        LDAP ——  以树形结构对AD进行访问，操作对象多，且更为灵活。
'                   但权限方面不如WinNT开放。
'
' -----------------------------------------------------------------------------

Imports  System
Imports  System.DirectoryServices

' '' -----------------------------------------------------------------------------
' '' Project     : ADService
' '' Class     : ADHelper
' '' 
' '' -----------------------------------------------------------------------------
' '' <summary>
' '' 一个简单的操作活动目录的类
' '' </summary>
' '' -----------------------------------------------------------------------------
Public   Class ADHelperClass Class ADHelperClass ADHelper

私有成员变量私有成员变量#Region "私有成员变量"
    'AD控制器的机器名（NetBIOS名称）
    Private ADServer As String
    'LDAP的访问路径（域的名字）
    Private ADPath As String
#End Region

帐户选项帐户选项#Region "帐户选项"
    'Identifier = Hexadecimal value
    Public Enum AccountOptionEnumEnum AccountOptionEnum AccountOption
        ADS_UF_SCRIPT = &H1                             '执行登录脚本
        ADS_UF_ACCOUNTDISABLE = &H2                     '用户帐号禁用
        ADS_UF_HOMEDIR_REQUIRED = &H8                   '主目录是必需的
        ADS_UF_LOCKOUT = &H10                           '该帐户当前被锁定
        ADS_UF_PASSWD_NOTREQD = &H20                    '用户密码不是必须的
        ADS_UF_PASSWD_CANT_CHANGE = &H40                '用户不能改变密码(只读，不能设置)
        ADS_UF_ENCRYPTED_TEXT_PASSWORD_ALLOWED = &H80   '使用者允许发送加密的口令
        ADS_UF_TEMP_DUPLICATE_ACCOUNT = &H100           '本地帐号标志
        ADS_UF_NORMAL_ACCOUNT = &H200                   '默认帐号类型
        ADS_UF_INTERDOMAIN_TRUST_ACCOUNT = &H800        '跨域的信任帐号
        ADS_UF_WORKSTATION_TRUST_ACCOUNT = &H1000       '工作站信任帐号
        ADS_UF_SERVER_TRUST_ACCOUNT = &H2000            '服务器信任帐号
        ADS_UF_DONT_EXPIRE_PASSWD = &H10000             '密码永不过期
        ADS_UF_MNS_LOGON_ACCOUNT = &H20000              'MNS登录帐号
        ADS_UF_SMARTCARD_REQUIRED = &H40000             '必须使用智能卡登录
        ADS_UF_TRUSTED_FOR_DELEGATION = &H80000         '服务帐号（用户或计算机帐号）将通过Kerberos委托信任
        ADS_UF_NOT_DELEGATED = &H100000                 '即使服务帐号是通过Kerberos委托信任的，敏感帐号不能被委托
        ADS_UF_USE_DES_KEY_ONLY = &H200000              '为此帐号使用DES加密类型
        ADS_UF_DONT_REQUIRE_PREAUTH = &H400000          '不要求Kerberos预身份验证
        ADS_UF_PASSWORD_EXPIRED = &H800000              '密码过期
        ADS_UF_TRUSTED_TO_AUTHENTICATE_FOR_DELEGATION = &H1000000   '该帐号可委派其他帐号

    End Enum
#End Region

构造函数构造函数#Region "构造函数"
    Public Sub New()Sub New()Sub New()Sub New(ByVal sADServer As String, ByVal sADPath As String)
        ADServer = "WinNT://" & sADServer & ",computer"
        ADPath = sADPath
    End Sub
#End Region

公共接口公共接口#Region "公共接口"
    ''' -----------------------------------------------------------------------------
    ''' <summary>
    ''' 检查组织单位（OU）是否存在
    ''' </summary>
    ''' <param name="sOU">组织单位名称</param>
    ''' <returns>成功返回True,否则返回False</returns>
    ''' -----------------------------------------------------------------------------
    Public Function CheckOU()Function CheckOU()Function CheckOU()Function CheckOU(ByVal sOU As String) As Boolean
        Try
            Dim de As DirectoryEntry = GetDirectoryObject()
            Dim deSearch As New DirectorySearcher
            deSearch.SearchRoot = de
            deSearch.Filter = "(&(objectClass=organizationalUnit)(ou=" & sOU & "))"
            deSearch.SearchScope = SearchScope.Subtree
            Dim results As SearchResult = deSearch.FindOne
            If Not results Is Nothing Then
                Return True
            Else
                Return False
            End If
        Catch
            Return False
        End Try
    End Function

    ''' -----------------------------------------------------------------------------
    ''' <summary>
    ''' 添加一个组织单位（OU）
    ''' </summary>
    ''' <param name="sOU">组织单位名称(iOffice.net Users)</param>
    ''' <returns>添加后的OU对象</returns>
    ''' -----------------------------------------------------------------------------
    Public Function AddOU()Function AddOU()Function AddOU()Function AddOU(ByVal sOU As String, ByVal sDescription As String) As DirectoryEntry
        Dim de As DirectoryEntry = GetDirectoryObject()
        Dim deOU As DirectoryEntry = de.Children.Add("ou=" & sOU, "organizationalUnit")
        deOU.Properties("Description").Value = sDescription
        deOU.CommitChanges()
        Return deOU
    End Function

    ''' -----------------------------------------------------------------------------
    ''' <summary>
    ''' 添加一个新组(WinNT)
    ''' </summary>
    ''' <param name="sGroupName">组名称</param>
    ''' <param name="sDescripion">描述</param>
    ''' <returns>返回创建组的DirecotryEntry对象</returns>
    ''' -----------------------------------------------------------------------------
    Public Function AddGroup()Function AddGroup()Function AddGroup()Function AddGroup(ByVal sGroupName As String, ByVal sDescripion As String) As DirectoryEntry
        Dim AD As New DirectoryEntry(ADServer)
        Dim deGroup As DirectoryEntry
        deGroup = AD.Children.Add(sGroupName, "group")
        deGroup.Invoke("Put", New Object() {"Description", sDescripion})
        deGroup.CommitChanges()
        Return deGroup
    End Function

    ''' -----------------------------------------------------------------------------
    ''' <summary>
    ''' 添加一个新组(LDAP)
    ''' </summary>
    ''' <param name="sLDAPDN">位置(例如：sLDAPDN="OU=组织单位")</param>
    ''' <param name="sGroupName">组名称</param>
    ''' <param name="sDescripion">描述</param>
    ''' <returns>返回创建组的DirecotryEntry对象</returns>
    ''' -----------------------------------------------------------------------------
    Public Function AddGroup()Function AddGroup()Function AddGroup()Function AddGroup(ByVal sLDAPDN As String, ByVal sGroupName As String, ByVal sDescripion As String) As DirectoryEntry
        Dim AD As DirectoryEntry = GetDirectoryObject()
        Dim subEntry As DirectoryEntry = AD.Children.Find(sLDAPDN)
        Dim deGroup As DirectoryEntry = subEntry.Children.Add("CN=" + sGroupName, "group")
        deGroup.Properties("sAMAccountName").Value = sGroupName
        deGroup.Properties("Description").Value = sDescripion
        deGroup.CommitChanges()
        Return deGroup
    End Function

    ''' -----------------------------------------------------------------------------
    ''' <summary>
    ''' 删除组
    ''' </summary>
    ''' <param name="sGroupName">组名称</param>
    ''' -----------------------------------------------------------------------------
    Public Sub DeleteGroup()Sub DeleteGroup()Sub DeleteGroup()Sub DeleteGroup(ByVal sGroupName As String)
        Dim AD As New DirectoryEntry(ADServer)
        Dim group As DirectoryEntry
        AD.Children.Remove(group)
        AD.Close()
    End Sub

    ''' -----------------------------------------------------------------------------
    ''' <summary>
    ''' 添加一个新用户(WinNT)
    ''' </summary>
    ''' <remark>
    ''' 利用WinNT协议只能将用户添加到Users节点下面，
    ''' 即：相当于LDAP中的CN=Users
    ''' </remark>
    ''' <param name="sUserName">用户名</param>
    ''' <param name="sPassword">密码</param>
    ''' <returns>返回创建用户的DirecotryEntry对象</returns>
    ''' -----------------------------------------------------------------------------
    Public Function AddUser()Function AddUser()Function AddUser()Function AddUser(ByVal sUserName As String, ByVal sPassword As String) As DirectoryEntry
        Dim AD As New DirectoryEntry(ADServer)
        Dim deUser As DirectoryEntry
        deUser = AD.Children.Add(sUserName, "user")
        deUser.Invoke("SetPassword", New Object() {sPassword})
        deUser.CommitChanges()
        Return deUser
    End Function

    ''' -----------------------------------------------------------------------------
    ''' <summary>
    ''' 添加一个新用户(LDAP)
    ''' </summary>
    ''' <remark>
    ''' 利用LDAP协议添加用户到指定位置。
    ''' 例如：sLDAPDN = "OU=组织单位名称"(或者"CN=Users")。
    ''' 注意：添加后的用户默认是账户禁用状态。
    ''' </remark>
    ''' <param name="sLDAPDN">位置</param>
    ''' <param name="sUserName">用户名</param>
    ''' <param name="sPassword">密码</param>
    ''' <returns>返回创建用户的DirecotryEntry对象</returns>
    ''' -----------------------------------------------------------------------------
    Public Function AddUser()Function AddUser()Function AddUser()Function AddUser(ByVal sLDAPDN As String, ByVal sUserName As String, ByVal sPassword As String) As DirectoryEntry
        Dim AD As DirectoryEntry = GetDirectoryObject()
        Dim subEntry As DirectoryEntry = AD.Children.Find(sLDAPDN)
        Dim deUser As DirectoryEntry = subEntry.Children.Add("CN=" + sUserName, "user")
        '添加帐号是必须的
        deUser.Properties("sAMAccountName").Value = sUserName
        deUser.CommitChanges()
        SetUserPassword(sUserName, sPassword)
        Return deUser
    End Function

    ''' -----------------------------------------------------------------------------
    ''' <summary>
    ''' 在组织单位中添加用户
    ''' </summary>
    ''' <param name="sOU">组织单位名称</param>
    ''' <param name="sUserName">用户名</param>
    ''' <param name="sPassword">密码</param>
    ''' <returns></returns>
    ''' -----------------------------------------------------------------------------
    Public Function AddUserIntoOU()Function AddUserIntoOU()Function AddUserIntoOU()Function AddUserIntoOU(ByVal sOU As String, ByVal sUserName As String, ByVal sPassword As String) As DirectoryEntry
        Dim ldapDN As String = "OU=" & sOU
        Return AddUser(sUserName, sPassword, sOU)
    End Function

    ''' -----------------------------------------------------------------------------
    ''' <summary>
    ''' 设置用户密码
    ''' </summary>
    ''' <param name="oUser"></param>
    ''' <param name="sPassword"></param>
    ''' -----------------------------------------------------------------------------
    Public Sub SetUserPassword()Sub SetUserPassword()Sub SetUserPassword()Sub SetUserPassword(ByVal sUserName As String, ByVal sPassword As String)
        Dim AD As New DirectoryEntry(ADServer)
        Dim oUser As DirectoryEntry
        oUser = AD.Children.Find(sUserName, "user")
        oUser.Invoke("SetPassword", New Object() {sPassword})
        oUser.CommitChanges()
        oUser.Close()
    End Sub

    ''' -----------------------------------------------------------------------------
    ''' <summary>
    ''' 添加用户到组
    ''' </summary>
    ''' <param name="oUserName">用户对象</param>
    ''' <param name="sGroupName">组名</param>
    ''' -----------------------------------------------------------------------------
    Public Sub AddUserToGroup()Sub AddUserToGroup()Sub AddUserToGroup()Sub AddUserToGroup(ByVal sUserName As String, ByVal sGroupName As String)
        Dim AD As New DirectoryEntry(ADServer)
        Dim oUser As DirectoryEntry = AD.Children.Find(sUserName, "user")
        Dim group As DirectoryEntry = AD.Children.Find(sGroupName, "group")
        If Not oUser Is Nothing Then
            group.Invoke("Add", New Object() {oUser.Path})
            group.CommitChanges()
        End If
        oUser.Close()
        group.Close()
    End Sub

    ''' -----------------------------------------------------------------------------
    ''' <summary>
    ''' 从组中移除用户
    ''' </summary>
    ''' <param name="oUserName">用户名</param>
    ''' <param name="sGroupName">组名</param>
    ''' -----------------------------------------------------------------------------
    Public Sub RemoveUserFromGroup()Sub RemoveUserFromGroup()Sub RemoveUserFromGroup()Sub RemoveUserFromGroup(ByVal sUserName As String, ByVal sGroupName As String)
        Dim AD As New DirectoryEntry(ADServer)
        Dim group As DirectoryEntry = AD.Children.Find(sGroupName, "group")
        Dim oUser As DirectoryEntry = AD.Children.Find(sUserName, "user")
        If Not oUser Is Nothing Then
            group.Invoke("Remove", New Object() {oUser.Path})
            group.CommitChanges()
        End If
        oUser.Close()
        group.Close()
    End Sub

    ''' -----------------------------------------------------------------------------
    ''' <summary>
    ''' 删除用户
    ''' </summary>
    ''' <param name="sUserName">用户名</param>
    ''' <returns>成功返回True,否则返回False</returns>
    ''' -----------------------------------------------------------------------------
    Public Sub DeleteUser()Sub DeleteUser()Sub DeleteUser()Sub DeleteUser(ByVal sUserName As String)
        Dim AD As New DirectoryEntry(ADServer)
        Dim User As DirectoryEntry = AD.Children.Find(sUserName, "user")
        AD.Children.Remove(User)
        AD.Close()
    End Sub

    ''' -----------------------------------------------------------------------------
    ''' <summary>
    ''' 根据用户名返回相应的DirectoryEntry对象
    ''' </summary>
    ''' <remarks>
    ''' 如果用户存在，则返回相应的对象，否则返回空对象(Nothing)
    ''' </remarks>
    ''' <param name="sUserName">用户名</param>
    ''' <returns>DirectoryEntry类的对象</returns>
    ''' -----------------------------------------------------------------------------
    Public Function GetUser()Function GetUser()Function GetUser()Function GetUser(ByVal sUserName As String) As DirectoryEntry
        Try
            Dim de As DirectoryEntry = GetDirectoryObject()
            Dim deSearch As New DirectorySearcher
            deSearch.SearchRoot = de
            deSearch.Filter = "(&(objectClass=user)(cn=" & sUserName & "))"
            deSearch.SearchScope = SearchScope.Subtree
            Dim results As SearchResult = deSearch.FindOne
            If Not results Is Nothing Then
                Return New DirectoryEntry(results.Path)
            Else
                Return Nothing
            End If
        Catch
            Return Nothing
        End Try
    End Function

    ''' -----------------------------------------------------------------------------
    ''' <summary>
    ''' 验证帐户是否禁用
    ''' </summary>
    ''' <param name="oDE">用户对象</param>
    ''' <returns>成功返回True,否则返回False</returns>
    ''' -----------------------------------------------------------------------------
    Public Function IsAccountDisable()Function IsAccountDisable()Function IsAccountDisable()Function IsAccountDisable(ByVal oDE As DirectoryEntry) As Boolean
        Dim userAccountControl As Integer = Convert.ToInt32(oDE.Properties("userAccountControl")(0))
        Return Not IsAccountActive(userAccountControl)
    End Function

    ''' -----------------------------------------------------------------------------
    ''' <summary>
    ''' 设置用户帐号可用
    ''' </summary>
    ''' <param name="oDE">用户对象</param>
    ''' -----------------------------------------------------------------------------
    Public Sub EnableUserAccount()Sub EnableUserAccount()Sub EnableUserAccount()Sub EnableUserAccount(ByRef oDE As DirectoryEntry)
        oDE.Properties("userAccountControl")(0) = AccountOption.ADS_UF_NORMAL_ACCOUNT _
                                               Or AccountOption.ADS_UF_DONT_EXPIRE_PASSWD
        oDE.CommitChanges()
    End Sub

    ''' -----------------------------------------------------------------------------
    ''' <summary>
    ''' 设置用户帐号不可用
    ''' </summary>
    ''' <param name="oDE">用户对象</param>
    ''' -----------------------------------------------------------------------------
    Public Sub DisableUserAccount()Sub DisableUserAccount()Sub DisableUserAccount()Sub DisableUserAccount(ByRef oDE As DirectoryEntry)
        oDE.Properties("userAccountControl")(0) = AccountOption.ADS_UF_NORMAL_ACCOUNT _
                                               Or AccountOption.ADS_UF_DONT_EXPIRE_PASSWD _
                                               Or AccountOption.ADS_UF_ACCOUNTDISABLE
        oDE.CommitChanges()
    End Sub

    ''' -----------------------------------------------------------------------------
    ''' <summary>
    ''' 设置属性值
    ''' </summary>
    ''' <param name="oDE">用户对象</param>
    ''' <param name="sPropertyName">属性名称</param>
    ''' <param name="sPropertyValue">属性值</param>
    ''' -----------------------------------------------------------------------------
    Public Sub SetProperty()Sub SetProperty()Sub SetProperty()Sub SetProperty(ByRef oDE As DirectoryEntry, ByVal sPropertyName As String, ByVal sPropertyValue As String)
        If sPropertyValue <> String.Empty Then
            If oDE.Properties.Contains(sPropertyName) Then
                oDE.Properties(sPropertyName)(0) = sPropertyValue
            Else
                oDE.Properties(sPropertyName).Add(sPropertyValue)
            End If
        End If
    End Sub

    ''' -----------------------------------------------------------------------------
    ''' <summary>
    ''' 提交更改
    ''' </summary>
    ''' <param name="oDE"></param>
    ''' -----------------------------------------------------------------------------
    Public Sub CommitChanges()Sub CommitChanges()Sub CommitChanges()Sub CommitChanges(ByRef oDE As DirectoryEntry)
        oDE.CommitChanges()
    End Sub

    ''' -----------------------------------------------------------------------------
    ''' <summary>
    ''' 得到属性值
    ''' </summary>
    ''' <remarks>
    ''' 如果没有这个属性则返回空值（string.Empty）
    ''' </remarks>
    ''' <param name="oDE">用户对象</param>
    ''' <param name="sPropertyName">属性名称</param>
    ''' <returns>属性值</returns>
    ''' -----------------------------------------------------------------------------
    Public Function GetProperty()Function GetProperty()Function GetProperty()Function GetProperty(ByVal oDE As DirectoryEntry, ByVal sPropertyName As String) As String
        If oDE.Properties.Contains(sPropertyName) Then
            Return Convert.ToString(oDE.Properties(sPropertyName)(0))
        Else
            Return String.Empty
        End If
    End Function

    ''' -----------------------------------------------------------------------------
    ''' <summary>
    ''' 得到用户信息
    ''' </summary>
    ''' <param name="oDE">用户对象</param>
    ''' <returns>包含用户属性信息的DataTable</returns>
    ''' -----------------------------------------------------------------------------
    Public Function GetUserInfo()Function GetUserInfo()Function GetUserInfo()Function GetUserInfo(ByVal oDE As DirectoryEntry) As DataTable
        Dim dt As DataTable = New DataTable
        Dim dr As DataRow
        Dim dc As DataColumn
        dc = New DataColumn("PropertyName", Type.GetType("System.String"))
        dt.Columns.Add(dc)
        dc = New DataColumn("Value", Type.GetType("System.String"))
        dt.Columns.Add(dc)

        Dim id As IDictionaryEnumerator = oDE.Properties.GetEnumerator
        While (id.MoveNext())
            dr = dt.NewRow()
            dr.Item("PropertyName") = id.Key
            dr.Item("Value") = oDE.Properties(id.Key)(0)
            dt.Rows.Add(dr)
        End While
        Return dt
    End Function

    ''' -----------------------------------------------------------------------------
    ''' <summary>
    ''' 得到用户信息
    ''' </summary>
    ''' <param name="sUserName">用户名</param>
    ''' <returns>包含用户属性信息的DataTable</returns>
    ''' -----------------------------------------------------------------------------
    Public Function GetUserInfo()Function GetUserInfo()Function GetUserInfo()Function GetUserInfo(ByVal sUserName As String) As DataTable
        Dim oDE As DirectoryEntry = GetUser(sUserName)
        Return GetUserInfo(oDE)
    End Function

#End Region

私有方法私有方法#Region "私有方法"
    '创建DE对象
    '根据ADUser和ADPassword创建的一个有相当权限(可以管理AD)的DE对象
    Private Function GetDirectoryObject()Function GetDirectoryObject()Function GetDirectoryObject()Function GetDirectoryObject() As DirectoryEntry
        Return New DirectoryEntry(ADPath)
    End Function

    '判断用户帐号是否激活
    '返回FALSE说明用户帐号被禁用
    Private Function IsAccountActive()Function IsAccountActive()Function IsAccountActive()Function IsAccountActive(ByVal userAccountControl As Integer) As Boolean
        Dim flagExists As Integer = userAccountControl And AccountOption.ADS_UF_ACCOUNTDISABLE
        If flagExists > 0 Then
            Return False
        Else
            Return True
        End If
    End Function
#End Region

End Class