MAJ ActiveDirectoy sur postes avec cartes à puces

[mugwump]

Bonjour,
J'ai un souci sur un programme VB qui s'exécute sur des postes XP.
* sur les postes sans cartes ç puces, tout est OK,
* Sur les postes avec cartes à puces, j'ai l'apparition de fenêtre "Veuillez saisir votre code pin" à chaque connexion, recherche ou changement de mot de passe dans l'AD (ActiveDirectory) au travers de mon code source, ce qui est génant.

Il faut savoir que le compte de connexion windows est le même que le compte utilisateur dans l'AD et mon programme ci-dessous utilise le compte de l'utilisateur et son mot de passe (saisi par lui-même) pour se connecter à l'AD.

Quelqu'un peut-il me dire pourquoi Windows (au travers de la carte à puces) fait apparaitre cette fenêtre et s'il n'y a pas un moyen de l'éviter ?

Code :

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
 
Private Sub Sub_Test()
 
     Dim Str_ADsPath                As String
 
     Dim objDSO                     As IADsOpenDSObject    ' Objet de 
connexion au domaine sélectionné (vérification des identifiants)
     Dim Container                  As IADsContainer    ' Objet de 
connexion au domaine sélectionné (vérification des identifiants)
     Dim objuser                    As IADsUser    ' Objet utilisateur ADSI
     Dim uid_adm_win_AD             As String
     Dim cpt_search                 As String
     Dim Str_New_PassWord           As String
     Dim Str_Retour                 As String
     Dim i                          As Integer
     cpt_search = "T0001041"
     uid_adm_win_AD = "AREA01\" & cpt_search
 
     pwd_adm_win_AD = "ancien_motdepasse"
     Str_New_PassWord = "nouveau_motdepasse"
 
     Str_ADsPath = "LDAP://monserverActiveDirectory:636"
 
     Set objDSO = GetObject("LDAP:")    ' On établi la connexion au domaine
     Set Container = objDSO.OpenDSObject(Str_ADsPath, _
                                         uid_adm_win_AD, _
                                         pwd_adm_win_AD, _
                                         ADS_SECURE_AUTHENTICATION +
ADS_USE_SSL)    ''''''''' LA POP-UP APPARAIT
 
 
     Str_Retour = Fct_Parcours(Container, "CN=" & cpt_search, objuser)
 
     ' modification du mot de passe
     objuser.ChangePassword pwd_adm_win_AD, Str_New_PassWord
         ' '''''''' LA POP-UP APPARAIT
 
     objuser.SetInfo
 
     Set objuser = Nothing
     Set Container = Nothing
     Set objDSO = Nothing
 
 
End Sub
 
Private Function Fct_Parcours(Container As Object, ByRef Str_Recherche 
As String, Obj_Usr As IADsUser)
     Dim Obj_S As IADs
     Dim Str_Emplacement As String
 
     For Each Obj_S In Container
         If Str_Emplacement = "" Then
             If UCase(Obj_S.Name) = Str_Recherche Then
                 Set Obj_Usr = Obj_S
                 Str_Emplacement = Obj_S.distinguishedName
             Else
                 Str_Emplacement = Fct_Parcours(Obj_S, Str_Recherche, 
Obj_Usr)
             End If
         End If
     Next Obj_S
     Fct_Parcours = Str_Emplacement
End Function

Merci de votre aide.