Modifier le PSW internet dans une fiche d'un utilisateur

[Michael DELIQUE]

Cette fonction placé dans un bouton et envoyé a un utilisateur via un mail, permet de modifier sont psw internet sans qu'il est a ouvrir le NAB et rechercher sa fiche.

Code : Tout sélectionner

Public Sub SetInternetPSW(wnbChar As Integer)
   
   'Modifie le psw internet dans le NAB
   
   'déclaration Variable
   Dim DBNab As NotesDatabase
   Dim NewPSW As String
   Dim NewPSW2 As String
   Dim nmUser As NotesName
   Dim vwNAB As NotesView
   Dim Doc As NotesDocument
   Dim vrValue As Variant
   
   On Error Goto ErreurHandle
   
   If DB Is Nothing Or Session Is Nothing Then
      Set Session = New NotesSession
      Set DB = Session.CUrrentdatabase
   End If
   
   Set DBNab = DBCAPublic
   
   If DBNab Is Nothing Then
      Error 9999,"NAB Database is Nothing"
      Exit Sub
   End If
   
   NewPSW = ""
   NewPSW2 = ""
   
   If Abs(wnbChar) < 2 Then
      NewPSW = Inputbox("Specify your password (More than one character minimun ) : " , " INTERNET PASSWORD")
      While Len(NewPSW) < 1
         
         If Len(NewPSW) = 0 Then  ' Bail Out if they hit the cancel button
            Set DBNab = Nothing
            Exit Sub
         End If
         
         NewPSW = Inputbox("Specify your password (More than one character minimun ) : " , " INTERNET PASSWORD")
      Wend
   Else
      NewPSW = Inputbox("Specify your password (More than "+Cstr(Abs(wnbChar))+" characters minimun ) : " , " INTERNET PASSWORD")
      While Len(NewPSW) < Abs(wnbChar)
         
         If Len(NewPSW) = 0 Then  ' Bail Out if they hit the cancel button
            Set DBNab = Nothing
            Exit Sub
         End If
         
         NewPSW = Inputbox("Specify a password more than "+Cstr(Abs(wnbChar))+" characters minimun :" , " INTERNET PASSWORD")
      Wend
   End If
   
   NewPSW2 = Inputbox("Please reconfirm your password : " , " INTERNET PASSWORD")
   
   While NewPSW <> NewPSW2
      
      If Len(NewPSW2) = 0 Then ' Bail out if they hit the cancel button
         NewPSW = ""
         NewPSW2 = ""
         Set DBNab = Nothing
         Exit Sub
      End If
      
      NewPSW2 = Inputbox("Please reconfirm your password : " , " INTERNET PASSWORD")
   Wend
   
   NewPSW2 = ""
   Set nmUser = New NotesName(Session.UserName)
   
   Set vwNAB = DBNAb.GetView("($VIMPeople)")
   
   If vwNAB Is Nothing Then
      Error 9999,"vwNAB is Nothing"
      Exit Sub
   End If
   
   Set Doc = vwNAB.GetDocumentByKey(nmUser.Abbreviated,True)
   
   If Doc Is Nothing Then
      Error 9999,"Votre fiche est introuvable dans le ''Notes Adresse Book''"
      Exit Sub
   End If
   
   vrValue = Evaluate_LS({@Password("}+NewPSW+{")},Nothing)
   
   If Trim(vrValue(0)) = "" Then
      Error 9999,"Error during evaluate : No result"
   Else
      Call Doc.ReplaceItemValue("HTTPPassword", vrValue)
      Call Doc.save(True,True)
   End If   
   
   NewPSW = ""
   vrValue = Null
   Set Doc = Nothing
   Set vwNAB = Nothing
   Set DBNab = Nothing
   
   Exit Sub
ErreurHandle:
   Msgbox "("+Cstr(Getthreadinfo (1))+")"+Chr(10)+"Erreur " + Str(Err) + " : "+Chr(10) + Cstr(Error)+". "+Chr(10)+"Ligne N° "+Cstr(Erl),16," ERREUR !"
   Exit Sub
End Sub

Code : Tout sélectionner

Public Function DBCAPublic As Notesdatabase
   'renvois un variable de type NotesDatabase contenant le carnet d'adresse public
   
   'Déclaration des Variables   
   Dim dbCAP As NotesDatabase
   
   On Error Goto ErreurDBCAPublic
   
   If session Is Nothing Then
      Set session = New notesSession
   End If
   
   Forall ValueAB In session.AddressBooks   
      If ValueAB.IsPublicAddressBook Then
         Set dbCAP = ValueAB
         Exit Forall
      End If   
   End Forall
   
   If DBExists_LS(dbCAP) = False Then
      Call dbCAP.Open("","")
   End If
   
   If DBExists_LS(dbCAP)= False Then
   '   Msgbox "Le Carnet d'Adresse Public est introuvable.",16," ERREUR !"
      Set DBCAPublic = Nothing
   Else
      Set DBCAPublic = dbCAP
   End If
   
   Set dbCAP = Nothing
   
   Exit Function
ErreurDBCAPublic:
   Msgbox "("Cstr(Getthreadinfo (1))+")"+Chr(10)+"Erreur " + Str(Err) + " : "+Chr(10) + Cstr(Error)+". "+Chr(10)+"Ligne N° "+Cstr(Erl),16," ERREUR !"
   Set dbCAP = Nothing
   Set DBCAPublic = Nothing
   Exit Function
End Function

Code : Tout sélectionner

Public Function DBExists_LS(wdb As NotesDatabase) As Integer
   'teste si une base de donnée est accéssible
'   renvoi true si elle est accéssible
' renvoi false si elle n'est pas accessible
   
   On Error Goto ErreurDBExists_LS
   
   'teste si la variable est renseigné
   If wDB Is Nothing Then
      DBExists_LS = False
      Exit Function
   Else
      'teste si la base est ouverte
      If wDB.IsOpen = True Then
      'teste si la base existe réelement il faut que la date de crétation existe ainsi que l'id de réplique
         If Trim(Cstr(wDB.Created)) = "" Or Trim(Cstr(wDB.ReplicaID)) = "" Then
            DBExists_LS = False
            Exit Function
         End If
      Else
         DBExists_LS = False
         Exit Function
      End If
   End If
   
   DBExists_LS = True
   
   Exit Function
ErreurDBExists_LS:
   Msgbox "("+Cstr(Getthreadinfo (1))+")"+Chr(10)+"Erreur " + Str(Err) + " : "+Chr(10) + Cstr(Error)+". "+Chr(10)+"Ligne N° "+Cstr(Erl),16," ERREUR !"
   DBExists_LS = False
   Exit Function
End Function