'
-----------------------------------------------------------------------------
' 说明:操作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
' 说明:操作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