VB Change Password program

[BADSBRD]

I am trying to cerate a VB program that will allow the user in AD to change their password. We are using Terminal Services and have disabled the ctrl-alt-del function. Basically I have some code from a VB Script I wrote that will get the user information from the system and use that information to connect to LDAP. I have seen code using similiar commands in use around the net so I think I have it right. I just believe that I am missing a reference library. Below is the code from my Change Password button. Most of the code that is giving me problems is remarked out. Do I need to use a certain reference library in order for this to work?

Thanks,
Rick

Dim strUserDN

Dim objUser

Dim strOldPass, strNewPass1, strNewPass2

'strUserDN = objSysInfo.userName

'objUser = GetObject("LDAP://" & strUserDN)

strOldPass = TextBox1.Text

strNewPass1 = TextBox2.Text

strNewPass2 = TextBox3.Text

If strNewPass1 = strNewPass2 Then

'objUser.ChangePassword(strOldPass, strNewPass1)

'objUser.pwdLastSet = 0

'objUser.lockoutTime = 0

'objUser.SetInfo

MessageBox.Show("Passwords Match, Way to go Skippy!!")

'Reset Variables

strOldPass = ""

strNewPass1 = ""

strNewPass2 = ""

'End the program

Me.Dispose()

End If

If strNewPass1 <> strNewPass2 Then

MessageBox.Show("Passwords do not match. Please enter again.")

End If

 

[Antithott]

Hi,

I think you miss alot of stuff in your code..

Below is a example of how to change a user, if you know their DistinguishedName.

The code will set the users password to blank, and have them choose a new one at next login.

Try


Dim strdnsdomain
Dim objRootDSE, objitem, navn

navn = <Inser DistinguiedName here>

objRootDSE = GetObject("LDAP://rootDSE")
strdnsdomain = objRootDSE.Get("DefaultNamingContext")

objitem = GetObject("LDAP://" & navn)

objitem.setpassword(String.Empty)
objitem.SetInfo()


If objitem.class = "user" Then
objitem.Setpassword(String.Empty)
objitem.userAccountControl = "512"
objitem.PwdLastSet = "0"
objitem.setinfo()
End If

' MessageBox.Show("Færdig")
Catch ex As Exception
MsgBox(ex.ToString)
End Try

 

[BADSBRD]

I was actually only missing 1 line of code. I have it workign correctly now. I was running into some error problems so I used the set password command rather than the change passwrod command. I was receiving the same debug errors for both an invalid password and a incorrect existing password.

The problem I am having now is that my users do not have enough permissions to run this program. Does anyone have any suggestions for this?

I have attached my final code below:

Dim strUserDN, strUser
Dim objUser
Dim strOldPass, strNewPass1, strNewPass2
Dim objSysInfo

objSysInfo = CreateObject("ADSystemInfo")

strUser = objSysInfo.userName
'MessageBox.Show(strUser)

objUser = GetObject("LDAP://" & strUser)

If TextBox2.Text = TextBox3.Text Then
Try
objUser.SetPassword(TextBox2.Text)
'objUser.ChangePassword(TextBox1.Text, TextBox2.Text)
Catch When Err.Number = -2147016651
MessageBox.Show("Password does not meet security requirments")
TextBox2.Text = ""
TextBox3.Text = ""
Exit Sub
Catch temp As Exception
MessageBox.Show("An error has occured. Please contact Technical Support at 4357")
Exit Sub
End Try
objUser.lockoutTime = 0
objUser.SetInfo()

MessageBox.Show("Password has been changed")
'Reset Text Boxes
TextBox2.Text = ""
TextBox3.Text = ""
'End the program
Me.Dispose()
End If

If TextBox2.Text <> TextBox3.Text Then
MessageBox.Show("Passwords do not match. Please enter again.")
TextBox2.Text = ""
TextBox3.Text = ""
End If



End Sub

 

[Antithott]

Dont remember where i got this from.. Change domain user and password to a user with enough rights, then call Changerunas sub.

call Endimpersonation() sub to change back to normal user account




Imports System.security.Principal
Module RunAs

Private Declare Auto Function LogonUser Lib "advapi32.dll" _
(ByVal lpszUsername As String, ByVal lpszDomain As String, _
ByVal lpszPassword As String, ByVal dwlogonType As Integer, _
ByVal dwLogonProvider As Integer, ByRef phToken As IntPtr) As Integer

Private Enum Logon
Interactive = 2
NetworkCleartext = 8
End Enum

Private Enum Provider
[Default] = 0
WindowsNT25 = 1
WindowsNT40 = 2
Windows2000 = 3
End Enum

'This API function duplicates a security token so you can use it.
Private Declare Auto Function DuplicateToken Lib "advapi32.dll" _
(ByVal ExistingTokenHandle As IntPtr, _
ByVal ImpersonationLevel As Integer, _
ByRef DuplicateTokenHandle As IntPtr) As Integer

Public NewContext As WindowsImpersonationContext

Public Sub changeRunas()
Dim UserName, Domain, Password As String

Domain = "test.test.dk"
UserName = "Administrator"
Password = "test"


Dim NewIdentity As WindowsIdentity

NewIdentity = GetWindowsIdentity(UserName, Domain, Password)

If NewIdentity Is Nothing Then
Form1.Label1.Text = "Invalid Credentials"
Else

NewContext = NewIdentity.Impersonate
DisplayIdentityInfo()

End If


End Sub

Public Sub DisplayIdentityInfo()
Dim Identity As WindowsIdentity = WindowsIdentity.GetCurrent()
Form1.Label1.Text = Identity.Name
End Sub


Private Function GetWindowsIdentity(ByVal UserName As String, _
ByVal Domain As String, ByVal Password As String) As WindowsIdentity
Dim SecurityToken, TokenDuplicate As IntPtr

If LogonUser(UserName, Domain, Password, _
Logon.Interactive, Provider.Default, SecurityToken) > 0 Then
DuplicateToken(SecurityToken, 2, TokenDuplicate)
Return New WindowsIdentity(TokenDuplicate)
Else

Return Nothing
End If
End Function

Public Sub Endimpersonation()
NewContext.Undo()
End Sub
End Module