vb.net 操作域用户

wkfdir 2008-11-10 04:03:12

#Region "引用"

Imports System.IO

Imports System.DirectoryServices



#End Region

Public Class LDAPUser

#Region "变量信息，必须在使用前赋值"

    Public Shared ADName As String = "ad.ns"

    Public Shared ADLoginName As String = "administrator"

    Public Shared ADLoginPassword As String = ""

    Public Shared LdapPath As String = "LDAP://" & ADName

#End Region

#Region "Directory"

       Public Function Directory() As DirectoryEntry

        Dim userContainerDE As DirectoryEntry

        userContainerDE = New DirectoryEntry(LdapPath, ADLoginName, ADLoginPassword, AuthenticationTypes.Secure)

        Return userContainerDE

    End Function 'Directory

    Public Function Directories() As DirectoryEntries

        Return Directory.Children

    End Function

             Public Overloads Function GetPathByobject(ByVal Name As String) As String

        Try

            Dim de As DirectoryEntry = Directory()

            Dim deSearch As New DirectorySearcher(de)

            deSearch.Filter = "((name=" & Name & "))"

            deSearch.SearchScope = SearchScope.Subtree

            Dim result As SearchResult = deSearch.FindOne()

            If result Is Nothing Then

                Return Nothing

            Else

                Return result.Path

            End If

        Catch

            Return Nothing

        End Try

    End Function

    Public Overloads Function GetparentPathByobject(ByVal Name As String) As String

        Try

            Dim de As DirectoryEntry = Directory()

            Dim deSearch As New DirectorySearcher(de)

            deSearch.Filter = "((name=" & Name & "))"

            deSearch.SearchScope = SearchScope.Subtree

            Dim result As SearchResult = deSearch.FindOne()

            If result Is Nothing Then

                Return Nothing

            Else

                Return result.GetDirectoryEntry.Parent.Path

            End If

        Catch

            Return Nothing

        End Try

    End Function

#End Region

#Region "域用户 user"



       Public Overloads Function UserCreate(ByVal ouname As String, ByVal userName As String, ByVal userPassword As String, ByVal displayname As String, ByVal description As String, ByVal mail As String) As String

        Dim oGUID As String = String.Empty

        Try

            Dim dirEntry As New DirectoryEntry(GetPathByObject(ouname), adLoginName, adLoginPassword)

            Dim newUser As DirectoryEntry = dirEntry.Children.Add("CN=" & userName, "User")

            newUser.Properties("samAccountName").Value = userName

            newUser.Properties("userPrincipalName").Value = userName & "@" & adname

            newUser.Properties("displayName").Value = displayname

            newUser.Properties("description").Value = description

            newUser.Properties("mail").Value = mail

            newUser.Properties("name").Value = userName

            newUser.Properties("userAccountControl").Value = CInt(newUser.Properties("userAccountControl").Value) And Not &H2

            newUser.CommitChanges()

            oGUID = newUser.Guid.ToString()

            newUser.Invoke("SetPassword", New Object() {userPassword})

            newUser.CommitChanges()

            dirEntry.Close()

            newUser.Close()

        Catch E As System.DirectoryServices.DirectoryServicesCOMException

            MsgBox(Err.Description)

        End Try

        Return oGUID

    End Function 

        Public Sub UserResetPassword(ByVal username As String, ByVal password As String)

        Try

            Dim de As DirectoryEntry = Directory()

            Dim deSearch As New DirectorySearcher(de)

            deSearch.Filter = "(&(objectClass=User)(sAMAccountName=" & username & "))"

            deSearch.SearchScope = SearchScope.Subtree

            Dim result As SearchResult = deSearch.FindOne()

            If Not result Is Nothing Then

                Dim dirEntry As DirectoryEntry = result.GetDirectoryEntry

                dirEntry.Invoke("SetPassword", New Object() {password})

                dirEntry.Properties("LockOutTime").Value = 0

                dirEntry.CommitChanges()

                dirEntry.Close()

            Else

                MsgBox("对象不存在！")

            End If

        Catch ex As Exception

            MsgBox(Err.Description)

        End Try

    End Sub 'ResetPassword

    Public Function UesrAuthenticate(ByVal userName As String, ByVal password As String, ByVal domain As String) As Boolean

        Try

            Dim domainADsPath As String = "LDAP://" & domain

            Dim searcher As New DirectorySearcher()

            searcher.SearchRoot = New DirectoryEntry(domainADsPath, userName, password)

            searcher.Filter = "(objectClass=" & userName & ")"

            searcher.SearchScope = System.DirectoryServices.SearchScope.Subtree

            Dim results As SearchResult = searcher.FindOne

            Return True

        Catch ex As Exception

            MsgBox("请输入正确的 域用户名、密码、域名，然后重试！", MsgBoxStyle.Critical, "域服务器验证错误")

            Return False

        End Try

    End Function 'Authenticate

#End Region

End Class