Requin | Voici le code que j'avais utilisé, de mémoire pour changer el mot de passe en connaissant l'ancien (simple accès utilisateur), remettre à zéro un mot de passe d'un compte donné (nécessite u ncomtpe administrateur) et pour vérifier l'appartenance à un groupe :
Code :
- ' to change password
- ' parameters :
- ' - strContainer = AD path to object (without object name)
- ' - strUsername = user account
- ' - strOldPassword = old password
- ' - strNewPassword = new password
- ' returns an error code (binary sum) :
- ' - 0 = no error
- ' - 1 = bad container
- ' - 2 = bad username
- ' - 4 = bad old password
- ' - 8 = bad new password
- ' - 16 = unable to change password
- ' - 32 = unable to authenticate user
- Function LDAPChangePW( _
- strContainer , _
- strUsername , _
- strOldPassword , _
- strNewPassword _
- )
- ' error handling
- On Error Resume Next
- intReturnCode = 0
-
- ' check parameters
- If (VarType(strContainer) = vbError OR strContainer = "" ) Then
- intReturnCode = intReturnCode + 1
- End If
- If (VarType(strUsername) = vbError OR strUserName = "" ) Then
- intReturnCode = intReturnCode + 2
- End If
- If (VarType(strOldPassword) = vbError) Then
- intReturnCode = intReturnCode + 4
- End If
- If (VarType(strNewPassword) = vbError) Then
- intReturnCode = intReturnCode + 8
- End If
-
- ' create path
- strLDAPUsername = "cn=" & strUsername & "," & strContainer
- ' open connection to LDAP
- Set adsNameSpace = GetObject("LDAP:" )
- ' attempt to authenticate the user in the tree using the username and
- ' the current password
- Err.Clear
- Set adsUser = adsNamespace.OpenDSObject( _
- "LDAP://" & strLDAPUsername , _
- strLDAPUsername , _
- strOldPassword , _
- 0 _
- )
- If (Err = 0) Then
- ' attempt to change password
- Err.Clear
- adsUser.ChangePassword CStr(strOldPassword), CStr(strNewPassword)
- If Err <> 0 Then
- intReturnCode = intReturnCode + 16
- End If
- Else
- intReturnCode = intReturnCode + 32
- End If
-
- ' return code
- LDAPChangePW = intReturnCode
- End Function
- ' to reset password (user MUST have administrative privilege)
- ' parameters :
- ' - strContainer = AD path to object (without object name)
- ' - strUsername = Account username
- ' - strNewPassword = New password to set
- ' - strAdmin = AD path to an administrator user
- ' - strAdminPass = Aministrator's password
- ' returns an error code (binary sum) :
- ' - 0 = no error
- ' - 1 = bad container
- ' - 2 = bad username
- ' - 4 = bad new password
- ' - 8 = unable to set password
- ' - 16 = unable to authenticate user
- Function LDAPSetPW( _
- strContainer , _
- strUsername , _
- strNewPassword , _
- strAdmin , _
- strAdminPass _
- )
- ' error handling
- On Error Resume Next
- intReturnCode = 0
- ' check parameters
- If (VarType(strContainer) = vbError OR strContainer = "" ) Then
- intReturnCode = intReturnCode + 1
- End If
- If (VarType(strUsername) = vbError OR strUsername = "" ) Then
- intReturnCode = intReturnCode + 2
- End If
- If (VarType(strNewPassword) = vbError) Then
- intReturnCode = intReturnCode + 4
- End If
- ' create path
- strLDAPUsername = "LDAP://cn=" & strUsername & "," & strContainer
- ' open connection to LDAP
- Set adsNameSpace = GetObject("LDAP:" )
- ' attempt to authenticate the user in the tree using the username and
- ' the current password
- Err.Clear
- Set adsUser = adsNamespace.OpenDSObject( _
- CStr(strLDAPUsername) , _
- strAdmin , _
- strAdminPass , _
- 0 _
- )
- If (Err = 0) Then
- ' attempt to change password
- Err.Clear
- adsUser.SetPassword CStr(strNewPassword)
- If Err <> 0 Then
- intReturnCode = intReturnCode + 8
- End If
- Else
- intReturnCode = intReturnCode + 16
- End If
-
- ' return code
- LDAPSetPW = intReturnCode
- End Function
- ' to check member's appartenance
- ' parameters :
- ' - strContainer = AD path to object (without object name)
- ' - strUsername = Account username
- ' - strPassword = New password to set
- ' - strGroup = AD path to a group
- ' returns an error code (binary sum) :
- ' - 0 = no error, user is a member of this group
- ' - 1 = bad container
- ' - 2 = bad username
- ' - 4 = bad password
- ' - 8 = bad group
- ' - 16 = unable to authenticate user
- ' - 32 = no error, user isn't a member of this group
- Function LDAPIsMember( _
- strContainer , _
- strUserName , _
- strPassword , _
- strGroup _
- )
- ' error handling
- On Error Resume Next
- intReturnCode = 0
- ' check parameters
- If (VarType(strContainer) = vbError OR strContainer = "" ) Then
- intReturnCode = intReturnCode + 1
- End If
- If (VarType(strUsername) = vbError OR strUsername = "" ) Then
- intReturnCode = intReturnCode + 2
- End If
- If (VarType(strPassword) = vbError) Then
- intReturnCode = intReturnCode + 4
- End If
- If (VarType(strGroup) = vbError OR strGroup = "" ) Then
- intReturnCode = intReturnCode + 8
- End If
- ' create path
- strLDAPUsername = "LDAP://cn=" & strUsername & "," & strContainer
- ' open connection to LDAP
- Set adsNameSpace = GetObject("LDAP:" )
- ' attempt to authenticate the user in the tree using the username and
- ' the current password
- Err.Clear
- Set adsGroup = adsNamespace.OpenDSObject( _
- CStr(strGroup) , _
- strUsername , _
- strPassword , _
- 0 _
- )
- If (Err = 0) Then
- ' try if user is a member of the group
- Err.Clear
- If adsGroup.IsMember(strLDAPUsername) Then
- ' reset previous errors if sucessfull
- intReturnCode = 0
- Else
- intReturnCode = intReturnCode + 32
- End If
- Else
- intReturnCode = intReturnCode + 16
- End If
-
- ' return code
- LDAPIsMember = intReturnCode
- End Function
|
Message édité par Requin le 18-02-2004 à 16:04:46
|