爱华网用户自己修改Windows域账号密码 的VB2010代码，如下是我专研的结果，以下代码适用于Windows2000以上任何域环境下，而且任何任何域名下，生成应用程序之后在任何域名任何WindowsAD域环境下都可以用，包括最新的Windows Server 2012域环境下都可以用。
Imports System.DirectoryServices
Public Class Form1
Public ErrAs String
PublicPWD_Changed As Boolean = False
PublicP_Rund As Boolean = False
PublicDomainName As String = ""
PrivateSub Button3_Click(ByVal sender As System.Object, ByVal e AsSystem.EventArgs) Handles Button3.Click
If Me.OldPassword.Text = "" And Me.NewPassword.Text = "" AndMe.ComfirmPassword.Text = "" Then
Err = "旧密码不能为空！"
Me.OldPassword.Focus()
ElseIf Me.OldPassword.Text = "" And Me.NewPassword.Text <> ""And Me.ComfirmPassword.Text <> "" Then
Err = "旧密码不能为空！"
Me.OldPassword.Focus()
ElseIf Me.OldPassword.Text <> "" And Me.NewPassword.Text = ""And Me.ComfirmPassword.Text = "" Then
Err = "新密码不能为空！"
Me.NewPassword.Focus()
ElseIf Me.OldPassword.Text <> "" And Me.NewPassword.Text<> "" And Me.ComfirmPassword.Text = "" Then
Err = "新密码不能为空！"
Me.ComfirmPassword.Focus()
Else
If Me.ComfirmPassword.Text <> Me.NewPassword.Text AndMe.OldPassword.Text <> "" Then
Me.NewPassword.Text = ""
Me.ComfirmPassword.Text = ""
Me.NewPassword.Focus()
Err = "您两次输入的新密码不一样！"
Else
Call Change_Password()
End If
End If
PWD_Status.Clear()
If PWD_Changed = True Then
PWD_Status.Text = Err
Me.Button3.Enabled = False
Exit Sub
End If
If P_Rund = True Then
PWD_Status.Text = Err
Me.OldPassword.Text = ""
Me.NewPassword.Text = ""
Me.ComfirmPassword.Text = ""
Me.OldPassword.Focus()
P_Rund = False
Exit Sub
End If
PWD_Status.Text = Err
End Sub
PrivateSub Form1_Load(ByVal sender As Object, ByVal e As System.EventArgs)Handles Me.Load
TxtAccount.Text = System.Environment.UserName
TxtAccount.Enabled = False
End Sub
PrivateSub Button1_Click(ByVal sender As System.Object, ByVal e AsSystem.EventArgs) Handles Button1.Click
'当关闭程序的时候释放资源
Me.Close()
Me.Dispose()
End
EndSub
Private SubChange_Password()
Dim UserName As String = TxtAccount.Text
Dim Oldpassword As String = Me.OldPassword.Text
Dim NewPassword As String = Me.NewPassword.Text
Dim Domain_IP As String =System.DirectoryServices.ActiveDirectory.Domain.GetCurrentDomain.Forest.Name'PDC Server IP Address Or Domain Name
Dim Domain As String =GetDomainName(System.DirectoryServices.ActiveDirectory.Domain.GetCurrentDomain.Forest.Name)
Dim Ds_Path As String = "LDAP://" & Domain_IP & "/" &Domain
P_Rund = True
Try
'Login AD by userid
Dim AD As New DirectoryEntry(Ds_Path, UserName, Oldpassword)
Dim DeSearch As DirectorySearcher = New DirectorySearcher
DeSearch.SearchRoot = AD
DeSearch.Filter = "(&(objectClass=user)(sAMAccountName=" +UserName + "))"
DeSearch.SearchScope = SearchScope.Subtree
Dim Results As SearchResult = DeSearch.FindOne()
If Not (Results Is Nothing) Then
AD = New DirectoryEntry(Results.Path, UserName, Oldpassword,AuthenticationTypes.Secure)
'Change Password
AD.Invoke("ChangePassword", New Object() {Oldpassword,NewPassword})
AD.CommitChanges()
Err = "密码更改成功，请记住您的新密码！"
PWD_Changed = True
AD.Dispose()
DeSearch.Dispose()
AD.Close()
End If
Catch ex As Exception
If Not (ex.InnerException Is Nothing) Then
'Err += ex.Message & " " & ex.InnerException.Message
Err = ex.InnerException.Message
Else
Err = ex.Message
End If
'Return
'Throw New Exception("User Password cannot be set" &ex.Message)
'err = de.InvokeGet("ChangePassword").ToString & " "
End Try
EndSub
PrivateFunction GetDomainName(ByVal Domain As String) As String
Dim SplitStr As String() = Nothing
Dim DomainName As String = ""
'Domain
If Domain.Contains(".") Then
SplitStr = Domain.Split("."c)
For Each item As String In SplitStr
If DomainName = "" Then
DomainName += "DC=" & item
Else
DomainName += "," & "DC=" & item
End If
Next
Else
DomainName = "DC=" & Domain
End If
Return DomainName
EndFunction
End Class
