16,550
社区成员
发帖
与我相关
我的任务
分享
''' <summary>
''' 用户帐号属性
''' </summary>
<Flags()> _
Public Enum ADS_UF
''' <summary>
''' 将执行登录脚本
''' </summary>
SCRIPT = &H1
''' <summary>
''' 禁用帐户
''' </summary>
ACCOUNTDISABLE = &H2
''' <summary>
''' 帐户需要主目录
''' </summary>
HOMEDIR_REQUIRED = &H8
''' <summary>
''' 锁定帐户
''' </summary>
LOCKOUT = &H10
''' <summary>
''' 帐户不需要密码
''' </summary>
PASSWD_NOTREQD = &H20
''' <summary>
''' 用户不能更改密码
''' </summary>
PASSWD_CANT_CHANGE = &H40
''' <summary>
''' 允许加密文本密码
''' </summary>
ENCRYPTED_TEXT_PASSWORD_ALLOWED = &H80
''' <summary>
''' 帐户密码永不过期
''' </summary>
DONT_EXPIRE_PASSWD = &H10000
''' <summary>
''' 登录需要使用智能卡
''' </summary>
SMARTCARD_REQUIRED = &H40000
''' <summary>
''' 密码已过期
''' </summary>
PASSWORD_EXPIRED = &H800000
End Enum
Public Function GetUserPrincipalBySamAccountName(ByVal samAccountName As String) As UserPrincipal
Dim context As PrincipalContext = Me.GetPrincipalContext(Me.DepartmentContainer)
Dim user As New UserPrincipal(context)
user.SamAccountName = samAccountName
Dim search As New PrincipalSearcher(user)
Dim result As UserPrincipal = CType(search.FindOne, UserPrincipal)
search.Dispose()
user.Dispose()
Return result
End Function
Public Function GetUserPrincipalAll() As UserPrincipal()
Return GetUserPrincipalAll("*")
End Function
Public Function GetUserPrincipalAll(ByVal name As String) As UserPrincipal()
Dim context As PrincipalContext = Me.GetPrincipalContext(Me.DepartmentContainer)
Dim user As New UserPrincipal(context)
user.Name = name
Dim search As New PrincipalSearcher(user)
Dim list As New List(Of UserPrincipal)
For Each p As Principal In search.FindAll
list.Add(CType(p, UserPrincipal))
Next
search.Dispose()
user.Dispose()
Return list.ToArray
End Function
Public Function IsExistsUserByName(ByVal name As String) As Boolean
Return Me.GetUserPrincipalByName(name) IsNot Nothing
End Function
Public Function IsExistsUserBySamAccountName(ByVal samAccountName As String) As Boolean
Return Me.GetUserPrincipalBySamAccountName(samAccountName) IsNot Nothing
End Function
Public Function UserAdd(ByVal samAccountName As String, ByVal name As String, ByRef resultMsg As String, Optional ByVal pass As String = "5354") As Boolean
If String.IsNullOrEmpty(Company) Then
resultMsg = "须指定公司"
Return False
End If
If String.IsNullOrEmpty(Me.Department) Then
resultMsg = "须指定部门"
Return False
End If
If String.IsNullOrEmpty(samAccountName) Then
resultMsg = "须指定帐号"
Return False
End If
If String.IsNullOrEmpty(name) Then
resultMsg = "须指定登录名称"
Return False
End If
If IsExistsUserByName(name) Then
resultMsg = "帐号已存在。"
Return False
End If
If IsExistsUserBySamAccountName(samAccountName) Then
resultMsg = "帐号已存在。"
Return False
End If
resultMsg = ""
Dim context As PrincipalContext = Me.GetPrincipalContext(Me.DepartmentContainer)
Dim newUser As New UserPrincipal(context, name, pass, True)
With newUser
.SamAccountName = samAccountName
.Surname = .Name.Substring(0, 1)
.GivenName = .Name.Substring(1)
.Description = String.Concat(Me.Company, "\", Me.Department)
.DisplayName = .Name
.UserPrincipalName = String.Concat(.SamAccountName, "@", zqDoamin)
End With
Try
newUser.Save()
newUser.ExpirePasswordNow()
Catch ex As Exception
resultMsg = ex.Message
End Try
Dim result As Boolean = newUser.Sid IsNot Nothing
newUser.Dispose()
context.Dispose()
Return result
End Function
Public Function OutputUserMessage(ByVal user As UserPrincipal) As String
If user Is Nothing Then Return "无此人"
Dim b As New StringBuilder
For Each p1 As Reflection.PropertyInfo In GetType(UserPrincipal).GetProperties
If p1.CanRead Then
Try
b.AppendLine(String.Format("{0}:{1}", p1.Name, p1.GetValue(user, Nothing).ToString))
Catch ex As Exception
End Try
End If
Next
Return b.ToString
End Function
Public Function GetDomainControllerInformation() As String
Dim controller As DomainController = Nothing
Try
controller = DomainController.FindOne(New DirectoryContext(DirectoryContextType.Domain, zqDoamin, Me.LogonUser, Me.LogonPass))
Catch ex As Exception
End Try
If controller Is Nothing Then Return "域服务器不存在" & vbCrLf
Dim b As New StringBuilder
For Each p As PropertyInfo In GetType(DomainController).GetProperties
If p.PropertyType Is GetType(String) OrElse p.PropertyType.IsValueType Then
b.AppendLine(String.Format("{0}:{1}", p.Name, p.GetValue(controller, Nothing)))
End If
Next
Return b.ToString
End Function
End Class
Public Class XXXXXXEmployeeContainer
Private Const zqDoamin As String = "xx.xxxx.local"
Private Const Server As String = "XXXXXX.xx.xxxx.local"
Private Const LdapHead As String = "LDAP://XXXXXX.xx.xxxx.local"
Private Const ContainerBase As String = "OU=XXXXXX员工账户,DC=xx,DC=xxxx,DC=local"
Private gCompany As String
Private gDepartment As String
Public Property Company() As String
Get
Return gCompany
End Get
Set(ByVal value As String)
gCompany = value
If gCompany IsNot Nothing Then gCompany = gCompany.Trim
End Set
End Property
Public Property Department() As String
Get
Return gDepartment
End Get
Set(ByVal value As String)
gDepartment = value
If gDepartment IsNot Nothing Then gDepartment = gDepartment.Trim
End Set
End Property
Private ReadOnly Property CompanyContainer() As String
Get
If String.IsNullOrEmpty(Me.Company) Then
Return ContainerBase
Else
Return String.Format("OU={0},{1}", Me.Company, ContainerBase)
End If
End Get
End Property
Private ReadOnly Property DepartmentContainer() As String
Get
If String.IsNullOrEmpty(Me.Company) Then
Return ContainerBase
ElseIf String.IsNullOrEmpty(Me.Department) Then
Return Me.CompanyContainer
Else
Return String.Format("OU={0},{1}", Me.Department, Me.CompanyContainer)
End If
End Get
End Property
Private Function GetLdapExpress(ByVal container As String) As String
If String.IsNullOrEmpty(container) Then Return LdapHead
Return String.Concat(LdapHead, "/", container)
End Function
Private Function GetLdapCompany() As String
Return Me.GetLdapExpress(Me.CompanyContainer)
End Function
Private Function GetLdapDepartment() As String
Return Me.GetLdapExpress(Me.DepartmentContainer)
End Function
Private gLogonUser As String
Private gLogonPass As String
Public Property LogonUser() As String
Get
Return gLogonUser
End Get
Set(ByVal value As String)
gLogonUser = value
End Set
End Property
Public Property LogonPass() As String
Protected Get
Return gLogonPass
End Get
Set(ByVal value As String)
gLogonPass = value
End Set
End Property
Private Function GetDirectoryEntry(ByVal ldapExpress As String) As DirectoryEntry
Return New DirectoryEntry(ldapExpress, Me.LogonUser, Me.LogonPass)
End Function
Private Function LdapIsValid(ByVal ldapExpress As String) As Boolean
Dim entry As DirectoryEntry = Me.GetDirectoryEntry(ldapExpress)
Dim valid As Boolean = True
Try
entry.RefreshCache()
Catch ex As Exception
valid = False
End Try
entry.Dispose()
Return valid
End Function
Public Function IsExistsCompany() As Boolean
If String.IsNullOrEmpty(Me.Company) Then Return False
Return LdapIsValid(Me.GetLdapCompany)
End Function
Public Function IsExistsDepartment() As Boolean
If String.IsNullOrEmpty(Me.Department) Then Return False
If Not IsExistsCompany() Then
Return False
Else
Return LdapIsValid(Me.GetLdapDepartment)
End If
End Function
Private Function GetPrincipalContext(ByVal container As String) As PrincipalContext
Return New PrincipalContext(ContextType.Domain, Server, container, LogonUser, LogonPass)
End Function
Public Function GetUserPrincipalByName(ByVal name As String) As UserPrincipal
Dim context As PrincipalContext = Me.GetPrincipalContext(Me.DepartmentContainer)
Dim user As New UserPrincipal(context)
user.Name = name
Dim search As New PrincipalSearcher(user)
Dim result As UserPrincipal = CType(search.FindOne, UserPrincipal)
search.Dispose()
user.Dispose()
Return result
End Function