Změna uživatelského hesla

Funkce:
V deklarační části formuláře zapište:

Private Function ChangePassword(UserName As String, _
NewPassword As String) As Boolean

   'POŽADAVKY: ADSI, LDAP provider
   'Uživatel pracující s touto funkcí musí mít právo na změnu hesla

   'PARAMETERY:
   'UserName: Přihlašovací jméno uživatele, kterému budeme měnit heslo
   'NewPassword: Nové heslo uživatele

   Dim conn As New ADODB.Connection
   Dim rs As ADODB.Recordset
   Dim oRoot As IADs
   Dim oDomain As IADs
   Dim sBase As String
   Dim sFilter As String
   Dim sDomain As String

   Dim sAttribs As String
   Dim sDepth As String
   Dim sQuery As String

   Dim user As IADsUser

   On Error GoTo errhandler:

   Set oRoot = GetObject("LDAP://rootDSE")
   'práce s defaultní doménou
   sDomain = oRoot.Get("defaultNamingContext")
   Set oDomain = GetObject("LDAP://" & sDomain)
   sBase = "<" & oDomain.ADsPath & ">"

   'Zjištění požadovaného uživatele
   sFilter = "(&(objectCategory=person)(objectClass=user)(name=" _
         & UserName & "))"
   sAttribs = "adsPath"
   sDepth = "subTree"

   sQuery = sBase & ";" & sFilter & ";" & sAttribs & ";" & sDepth

   conn.Open _
   "Data Source=Active Directory Provider;Provider=ADsDSOObject"

   Set rs = conn.Execute(sQuery)

   With rs
      If Not .EOF Then
         Set user = GetObject(rs("adsPath"))
         user.SetPassword NewPassword
         ChangePassword = True
      End If
   End With

errhandler:
   On Error Resume Next
   If Not rs Is Nothing Then
      If rs.State <> 0 Then rs.Close
      Set rs = Nothing
   End If

   If Not conn Is Nothing Then
      If conn.State <> 0 Then conn.Close
      Set conn = Nothing
   End If

   Set oRoot = Nothing
   Set oDomain = Nothing

End Function

Příklad volání:
ChangePassword "Administrator", "adminpassword"

Zpět

Autor: The Bozena