1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95
|
Option Base 1
Option Explicit
Private Sub Form_Load()
Dim NomUtilisateur As String
NomUtilisateur = Environ("USERNAME")
Tquadri.Text = NomUtilisateur
'Debug.Print NomUtilisateur
End Sub
Private Sub Bchanger_Click()
Dim objCommand, objConnection, objRecordSet, objUser
Dim strFilter, strAttributes, strQuery, strBase, strRootDomain As String
Dim chang, verif, quadri, strName, strCN, DN, strnmdp, nmdp, cmdp, amdp As String
'
' Recuperation des informations du formulaire
'
quadri = Tquadri.Text
nmdp = Tnmdp.Text
cmdp = Tcmdp.Text
strnmdp = Len(nmdp) 'Compte le nombre de caractéres
' Recherche du nom de l'utilisateur dans les variable d'environement
quadri = Environ("USERNAME")
Debug.Print "Quadri :" & quadri
If nmdp <> "" Or cmdp <> "" Then
If strnmdp < 6 Then
MsgBox ("Nouveau mots passe trop court")
chang = 0
Else
chang = 1
End If
If nmdp <> cmdp Then
MsgBox ("Mauvaise confirmation du MDP")
verif = 0
Else
verif = 1
End If
If chang = 1 And verif = 1 Then
' Connexion à l'annuaire LDAP
' http://www.computerperformance.co.uk/ezine/ezine11.htm
strRootDomain = "dc=test,dc=test,dc=fr"
Set objCommand = CreateObject("ADODB.Command")
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Provider = "ADsDSOObject"
objConnection.Properties("User Id") = "NTNSI\usrdiff"
objConnection.Properties("Password") = "usrdiff"
objConnection.Open "Active Directory Provider"
objCommand.ActiveConnection = objConnection
strBase = "<LDAP://" & strRootDomain & ">"
strFilter = "(&(objectCategory=person)(objectClass=user)(sAMAccountName=" & quadri & "))"
strAttributes = "sAMAccountName,cn,distinguishedName"
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
Debug.Print strQuery
objCommand.CommandText = strQuery
objCommand.Properties("Page Size") = 100
objCommand.Properties("Timeout") = 30
objCommand.Properties("Cache Results") = False
Set objRecordSet = objCommand.Execute
Do Until objRecordSet.EOF
strName = objRecordSet.Fields("sAMAccountName").Value
strCN = objRecordSet.Fields("cn").Value
DN = objRecordSet.Fields("distinguishedName").Value
'Wscript.Echo "NT Name: " & strName & ", Common Name: " & strCN & ", UserAccountControl: " & strUserAccountControl & ", strEmailAddress: " & strEmailAddress & ", strpwdLastSet: " & strpwdLastSet
amdp = "12345678"
Set objUser = GetObject("LDAP://" & DN & "")
objUser.Provider = "ADsDSOObject"
objUser.ChangePassword amdp, nmdp 'fonctionne qu'avec des MDP complexe
'objUser.SetPassword nmdp
MsgBox ("Votre mot de passe a été changé")
objRecordSet.MoveNext
Loop
objConnection.Close
End If
End If
End Sub |
Partager