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

http://www.cnblogs.com/freemantc/archive/2006/07/05/443008.html

'-----------------------------------------------------------------------------

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


Imports System
Imports System.DirectoryServices


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


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


#Region "帐户选项"
    'Identifier = Hexadecimal value
    Public Enum 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(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(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(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(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(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(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(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(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(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(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(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(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(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(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(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(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(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(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(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(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(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(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() As DirectoryEntry
        Return New DirectoryEntry(ADPath)
    End Function


    '判断用户帐号是否激活
    '返回FALSE说明用户帐号被禁用
    Private 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