car les documents de verrouillage comportent le nom du serveur verrouillé. la mise en cluster de la base ne fait que publier l'information mais pas le verrouillage. pour résoudre le problème en attendant qu'IBM le gère nativement. il faut un agent déclenché à chaque nouveau document ou a chaque changement de document faisant appel à cette fonction
- Code : Tout sélectionner
Function InetLockOutSynchroCluster(wServer As String, wnbLog As Boolean) As integer
REM wServer : nom du serveur pour la duplication (par défaut prend le nom du serveur en court)
Dim Collection As NotesDocumentCollection
Dim CollectionTalon As NotesDocumentCollection
Dim Doc As NotesDocument
Dim DocRef As NotesDocument
Dim DocTalon As NotesDocument
Dim nmServer As NotesName
Dim nmServerRef As NotesName
Dim nmUser As NotesName
Dim lstDocRef List As NotesDocument
Dim nbOk As Boolean
Dim i As Integer
Dim nbTime As Currency
Dim nbTimeRef As Currency
On Error GoTo CatchError
InetLockOutSynchroCluster = 0
If Session Is Nothing Or DB Is Nothing Then
Set Session = New NotesSession
Set DB = Session.Currentdatabase
End If
If Trim(wServer) = "" Then
Set nmServer = New NotesName(DB.Server)
Else
Set nmServer = New NotesName(Trim(wServer))
End If
REM Parcourr tous les documents talon si leur pendant (UserLogin) n'existe pas (user & server identique) on supprime tous les documents et talon pour l'utilisateur
Set CollectionTalon = DB.Search({Form = "UserTalon" & @name([CANONICALIZE];ILServerName)="}+nmServer.Canonical+{"},Nothing,0)
If Not CollectionTalon Is Nothing Then
If CollectionTalon.Count = 0 Then
If wnbLog = True Then
MsgBox Structure_Log+" : Purge des documents abandonné : pas de Talon trouvé"
End If
else
If wnbLog = True Then
MsgBox Structure_Log+" : Purge des documents, "+CStr(CollectionTalon.Count)+" talon trouvé"
End If
Set DocTalon = CollectionTalon.Getfirstdocument()
While Not DocTalon Is Nothing
nbOk = True
Set nmUser = New NotesName(DocTalon.Getitemvalue("ILUserName")(0))
Set DocTalon = CollectionTalon.Getnextdocument(DocTalon)
Set Collection = DB.Search({Form = "UserLogin" & @name([CANONICALIZE];ILServerName)="}+nmServer.Canonical+{" & @name([CANONICALIZE];ILUserName)="}+nmUser.Canonical+{"},Nothing,0)
If Not Collection Is Nothing Then
If Collection.count > 0 Then
nbOk = false
End If
Set Collection = Nothing
End If
If wnbLog = True Then
If nbOk = True Then
MsgBox Structure_Log+" : Purge "+nmUser.Abbreviated+" : Pas de document failure trouvé pour le serveur en cours"
Else
MsgBox Structure_Log+" : Purge "+nmUser.Abbreviated+" : document failure trouvé pour le serveur en cours"
End If
End If
If nbOk = True Then
i= 0
Set Collection = DB.Search({Form = "UserLogin":"UserTalon" & @name([CANONICALIZE];ILUserName)="}+nmUser.Canonical+{"},Nothing,0)
If Not Collection Is Nothing Then
If Collection.count > 0 Then
i = Collection.count
Call Collection.Removeall(True)
End If
Set Collection = Nothing
End If
If wnbLog = True Then
MsgBox Structure_Log+" : Purge "+nmUser.Abbreviated+" : "+CStr(i)+" document(s) supprimé(s) (talon & failure) tout serveur confondu"
End If
End If
Set nmUser = Nothing
Wend
End If
Set CollectionTalon = Nothing
Else
If wnbLog = True Then
MsgBox Structure_Log+" : Purge des documents abandonné : pas de Talon trouvé"
End If
End If
REM récupere les documents a traiter
Set Collection = DB.Search({Form = "UserLogin"},Nothing,0)
If Collection Is Nothing Then
If wnbLog = True Then
MsgBox Structure_Log+" : Synchronisation abandonné, pas de document failure à traiter"
End If
Exit Function
Else
If Collection.Count = 0 Then
If wnbLog = True Then
MsgBox Structure_Log+" : Synchronisation abandonné, pas de document failure à traiter"
End If
Set Collection = Nothing
Exit Function
Else
If wnbLog = True Then
MsgBox Structure_Log+" : Synchronisation prête pour "+CStr(Collection.Count)+" document(s) failure"
End If
End if
End If
REM détermine le document le plus ayant été le plus récement modifié
i=0
If wnbLog = True Then
MsgBox Structure_Log+" : Synchronisation : Détermination des documents de référence"
End If
Set Doc = Collection.Getfirstdocument()
While Not Doc Is Nothing
Set nmUser = New NotesName(Doc.Getitemvalue("ILUserName")(0))
If IsElement(lstDocRef(nmUser.Canonical)) = False Then
Set lstDocRef(nmUser.Canonical)=Doc
i=i+1
Else
If Trim(CStr(Doc.Getitemvalue("ILLastFailureTime")(0))) = "" Then
nbTime = CCur(Format(Doc.Getitemvalue("ILFirstFailureTime")(0),"YYYYMMDDHHNNSS"))
Else
nbTime = CCur(Format(Doc.Getitemvalue("ILLastFailureTime")(0),"YYYYMMDDHHNNSS"))
End If
If Trim(CStr(lstDocRef(nmUser.Canonical).Getitemvalue("ILLastFailureTime")(0))) = "" Then
nbTimeRef = CCur(Format(lstDocRef(nmUser.Canonical).Getitemvalue("ILFirstFailureTime")(0),"YYYYMMDDHHNNSS"))
Else
nbTimeRef = CCur(Format(lstDocRef(nmUser.Canonical).Getitemvalue("ILLastFailureTime")(0),"YYYYMMDDHHNNSS"))
End If
If nbTimeRef < nbTime Then
Set lstDocRef(nmUser.Canonical)=Doc
End If
nbTime = 0
nbTimeRef = 0
End If
Set nmUser = Nothing
Set Doc = Collection.Getnextdocument(Doc)
Wend
Set Collection = Nothing
If wnbLog = True Then
MsgBox Structure_Log+" : Nombre de documents de références "+CStr(i)
End If
If i > 0 Then
REM recherche les document du serveur en cours pour les créé ou les mettre à jours
ForAll valueRef In lstDocRef
Set DocRef = valueRef
If Not DocRef Is Nothing Then
Set nmServerRef = New NotesName(DocRef.Getitemvalue("ILServerName")(0))
Set nmUser = New NotesName(DocRef.Getitemvalue("ILUserName")(0))
REM vérifie qu'il existe un doc talon pour l'utilisateur et le serveur en cours s'il nexiste pas, le créé
Set DocTalon = Nothing
Set CollectionTalon = DB.Search({Form = "UserTalon" & @name([CANONICALIZE];ILServerName)="}+nmServer.Canonical+{" & @name([CANONICALIZE];ILUserName)="}+nmUser.Canonical+{"},Nothing,0)
If Not CollectionTalon Is Nothing Then
If CollectionTalon.Count > 0 Then
Set DocTalon = CollectionTalon.Getfirstdocument()
End If
Set CollectionTalon = Nothing
End If
If DocTalon Is Nothing Then
Set DocTalon = DB.Createdocument()
Call DocTalon.Replaceitemvalue("Form","UserTalon")
Call DocTalon.Replaceitemvalue("ILServerName",nmServer.Canonical)
Call DocTalon.Replaceitemvalue("ILUserName",nmUser.Canonical)
Call DocTalon.save(True,False)
If wnbLog = True Then
MsgBox Structure_Log+" : Création d'un talon pour "+nmUser.Abbreviated+" Serveur : "+nmServer.Abbreviated
End If
Else
If wnbLog = True Then
MsgBox Structure_Log+" : Talon déjà existant pour "+nmUser.Abbreviated+" Serveur : "+nmServer.Abbreviated
End If
End If
Set DocTalon = Nothing
REM si le server du document le plus est récent est celui du serveur en cours on ne fait rien
If nmServer.Canonical <> nmServerRef.Canonical Then
REM recherche le doc de la persone sur le serveur en cours
Set Doc = Nothing
Set Collection = DB.Search({Form = "UserLogin" & @name([CANONICALIZE];ILServerName)="}+nmServer.Canonical+{" & @name([CANONICALIZE];ILUserName)="}+nmUser.Canonical+{"},Nothing,0)
If Not Collection Is Nothing Then
If Collection.count > 0 Then
Set Doc = Collection.Getfirstdocument()
End If
Set Collection = Nothing
End If
If Doc Is Nothing Then
REM si pas de doc on le créé
Set Doc = DocRef.Copytodatabase(DB)
Call Doc.Replaceitemvalue("ILServerName",nmServer.Canonical)
Call Doc.save(True,False)
InetLockOutSynchroCluster=InetLockOutSynchroCluster+1
If wnbLog = True Then
MsgBox Structure_Log+" : Synchronisation de "+nmUser.Abbreviated+" : Document failure créé"
End If
Else
REM si le doc est trouvé on vérifi que les informations maj sont différente sinon on fait rien
nbOk = False
If Trim(CStr(Doc.Getitemvalue("ILAttempts")(0))) <> Trim(CStr(DocRef.Getitemvalue("ILAttempts")(0))) Then
If DocRef.Getitemvalue("ILAttempts")(0) > Doc.Getitemvalue("ILAttempts")(0) then
If wnbLog = True Then
MsgBox Structure_Log+" : Synchronisation de "+nmUser.Abbreviated+", MAJ du champ ILAttempts ( "+Trim(CStr(Doc.Getitemvalue("ILAttempts")(0)))+" => "+Trim(CStr(DocRef.Getitemvalue("ILAttempts")(0)))+" )"
End If
Call Doc.Replaceitemvalue("ILAttempts",DocRef.Getitemvalue("ILAttempts"))
End if
nbOk = True
End If
If Trim(CStr(Doc.Getitemvalue("ILLockedOut")(0))) <> Trim(CStr(DocRef.Getitemvalue("ILLockedOut")(0))) Then
If wnbLog = True Then
MsgBox Structure_Log+" : Synchronisation de "+nmUser.Abbreviated+", MAJ du champ ILLockedOut ( "+Trim(CStr(Doc.Getitemvalue("ILLockedOut")(0)))+" => "+Trim(CStr(DocRef.Getitemvalue("ILLockedOut")(0)))+" )"
End If
Call Doc.Replaceitemvalue("ILLockedOut",DocRef.Getitemvalue("ILLockedOut"))
nbOk = True
End If
If Trim(CStr(Doc.Getitemvalue("ILFirstFailureTime")(0))) <> Trim(CStr(DocRef.Getitemvalue("ILFirstFailureTime")(0))) Then
If ccur(Format(DocRef.Getitemvalue("ILFirstFailureTime")(0),"YYYYMMDDHHNNSS")) < Ccur(Format(Doc.Getitemvalue("ILFirstFailureTime")(0),"YYYYMMDDHHNNSS")) then
If wnbLog = True Then
MsgBox Structure_Log+" : Synchronisation de "+nmUser.Abbreviated+", MAJ du champ ILFirstFailureTime ( "+Trim(CStr(Doc.Getitemvalue("ILFirstFailureTime")(0)))+" => "+Trim(CStr(DocRef.Getitemvalue("ILFirstFailureTime")(0)))+" )"
End If
Call Doc.Replaceitemvalue("ILFirstFailureTime",DocRef.Getitemvalue("ILFirstFailureTime"))
nbOk = True
End If
End If
If Trim(CStr(Doc.Getitemvalue("ILLastFailureTime")(0))) <> Trim(CStr(DocRef.Getitemvalue("ILLastFailureTime")(0))) Then
If Ccur(Format(DocRef.Getitemvalue("ILLastFailureTime")(0),"YYYYMMDDHHNNSS")) > Ccur(Format(Doc.Getitemvalue("ILLastFailureTime")(0),"YYYYMMDDHHNNSS")) Then
If wnbLog = True Then
MsgBox Structure_Log+" : Synchronisation de "+nmUser.Abbreviated+", MAJ du champ ILLastFailureTime ( "+Trim(CStr(Doc.Getitemvalue("ILLastFailureTime")(0)))+" => "+Trim(CStr(DocRef.Getitemvalue("ILLastFailureTime")(0)))+" )"
End If
Call Doc.Replaceitemvalue("ILLastFailureTime",DocRef.Getitemvalue("ILLastFailureTime"))
nbOk = True
End if
End If
If nbOk = True Then
Call Doc.save(True,False)
InetLockOutSynchroCluster=InetLockOutSynchroCluster+1
Else
If wnbLog = True Then
MsgBox Structure_Log+" : Synchronisation de "+nmUser.Abbreviated+", pas de MAJ car les champs on des valeurs identiques au document de référence"
End If
End If
End If
Set Doc = Nothing
Else
If wnbLog = True Then
MsgBox Structure_Log+" : Synchronisation de "+nmUser.Abbreviated+" Abandonné le document de référence est le document failure du serveur en cours"
End If
End If
Set nmUser = Nothing
Set nmServerRef = Nothing
Set DocRef = Nothing
End If
End ForAll
Erase lstDocRef
End If
If wnbLog = True Then
MsgBox Structure_Log+" : Synchronisation de "+CStr(InetLockOutSynchroCluster)+" document(s) failure"
End If
Set nmServer = Nothing
Exit Function
CatchError:
Msgbox "("+Cstr(Getthreadinfo (1))+" Call by "+Cstr(Getthreadinfo(10))+")"+Chr(10)+"Erreur " + Str(Err) + " : "+Chr(10) + Cstr(Error)+". "+Chr(10)+"Ligne N° "+Cstr(Erl),16," ERREUR !"
InetLockOutSynchroCluster = -1
Exit Function
End Function
