DominoArea.org [Archive]

Remplace l'utilitaire de comparaison de document qui etait disponible sous Notes 4.6

Code : Tout sélectionner

Dim session As notessession
Dim db As notesdatabase
Dim premier_doc As notesdocument
Dim deuxieme_doc As notesdocument
Dim col As notesdocumentcollection
Dim doc As notesdocument
Dim p_item As Variant
Dim d_item As Variant

Type enregistrement_item
   strnom As String
   inttype As Integer
End Type

Type combiner
   strnom As String
   intpremiertype As Integer
   intdeuxiemetype As Integer
   vrtpremiersortie As Variant
   vrtdeuxiemesortie As Variant
   intentreesortie As Integer
End Type

Dim premier_items() As enregistrement_item
Dim deuxieme_items() As enregistrement_item
Dim combiner_items() As combiner

Sub Initialize
   Set session = New notessession
   Set db = session.currentdatabase
   Set col = db.unprocesseddocuments
   
   If col.count <> 2 Then
      Print "Veuillez sélectionner deux documents."
   Else
      Set premier_doc = col.getfirstdocument
      Set deuxieme_doc = col.getnextdocument(premier_doc)
      ' Vérifie tous les champs de premier_doc et les classes
      ' par ordre alphabétique
      tableau_des_champs premier_doc, premier_items
      classe_items premier_items
      ' Vérifie tous les champs de deuxieme_doc et les classes
      ' par ordre alphabétique
      tableau_des_champs deuxieme_doc, deuxieme_items
      classe_items deuxieme_items
      ' Combine les deux listes de champs dans une liste unique
      ' et vérifie leur équivalence
      combine premier_items, deuxieme_items, combiner_items
      For x = 0 To Ubound(combiner_items)
         equivalence_item combiner_items(x)
      Next
      ' Créer le document et le rapport pour l'utilisateur
      Set doc = db.createdocument
      propriete_document premier_doc, deuxieme_doc
      ecrire_rapport combiner_items
   End If
End Sub

Sub tableau_des_champs(doc As notesdocument, tableau() As enregistrement_item)
   Redim tableau(Ubound(doc.items))
   x = 0
   Forall i In doc.items
      tableau(x).strnom = i.name
      tableau(x).inttype = i.type
      x = x + 1
   End Forall
End Sub

Sub classe_items(tableau() As enregistrement_item)
   Dim temp As enregistrement_item
   x = 0
   bouger = True
   Do Until Not bouger
      bouger = False
      For x = 0 To Ubound(tableau) - 1
         If tableau(x).strnom > tableau(x + 1).strnom Then
            temp = tableau(x)
            tableau(x) = tableau(x + 1)
            tableau(x + 1) = temp
            bouger = True
         End If
      Next
   Loop
End Sub

Sub combine(tableau1() As enregistrement_item, _
tableau2() As enregistrement_item, combi() As combiner)
   x1 = 0
   x2 = 0
   i = 0
   Do Until x1 = Ubound(tableau1) And x2 = Ubound(tableau2)
      Redim Preserve combi(i)
      Select Case True
      Case tableau1(x1).strnom = tableau2(x2).strnom
         combi(i).strnom = tableau1(x1).strnom
         combi(i).intpremiertype = tableau1(x1).inttype
         combi(i).intdeuxiemetype = tableau2(x2).inttype
         x1 = x1 + 1
         x2 = x2 + 1
      Case tableau1(x1).strnom > tableau2(x2).strnom
         combi(i).strnom = tableau2(x2).strnom
         combi(i).intpremiertype = - 1
         combi(i).intdeuxiemetype = tableau2(x2).inttype
         x2 = x2 + 1
      Case tableau1(x1).strnom < tableau2(x2).strnom
         combi(i).strnom = tableau1(x1).strnom
         combi(i).intpremiertype = tableau1(x1).inttype
         combi(i).intdeuxiemetype = - 1
         x1 = x1 + 1
      End Select
      i = i + 1
   Loop
End Sub

Sub equivalence_item(item As combiner)
   Dim vrtpremieritem As Variant
   Dim vrtdeuxiemeitem As Variant
   Select Case True
   Case item.intpremiertype = - 1   ' Pas d'équivalence de champs
      item.vrtpremiersortie = "-Pas d'équivalence-"
      Set vrtdeuxiemeitem = deuxieme_doc.getfirstitem(item.strnom)
      item.vrtdeuxiemesortie = vrtdeuxiemeitem.values
      item.intentreesortie = True
   Case item.intdeuxiemetype = - 1   ' Pas d'équivalence de champs
      Set vrtpremieritem = premier_doc.getfirstitem(item.strnom)
      item.vrtpremiersortie = vrtpremieritem.values
      item.vrtdeuxiemesortie = "-Pas d'équivalence-"
      item.intentreesortie = True
   Case item.intpremiertype = 1      ' Rich Texte
      Set vrtpremieritem = premier_doc.getfirstitem(item.strnom)
      Set vrtdeuxiemeitem = deuxieme_doc.getfirstitem(item.strnom)
      If vrtpremieritem.text <> vrtdeuxiemeitem.text Then
         p_sortie = "- Texte : " + vrtpremieritem.text
         d_sortie = "- Texte : " + vrtdeuxiemeitem.item
      End If
      p_attribut = tableau_attribut(vrtpremieritem)
      d_attribut = tableau_attribut(vrtdeuxiemeitem)
      If p_attribut <> d_attribut Then
         If p_sortie = "" Then
            p_sortie = "-Attachement(s) : " + p_attribut
         Else
            p_sortie = p_sortie + Chr(13) + " -Attachement(s) : " + p_attribut
         End If
         If d_sortie = "" Then
            d_sortie = "-Attachement(s) : " + d_attribut
         Else
            d_sortie = d_sortie + Chr(13) + " -Attachement(s) : " + d_attribut
         End If
      End If
      If p_sortie <> "" Or d_sortie <> "" Then
         item.vrtpremiersortie = p_sortie
         item.vrtdeuxiemesortie = d_sortie
         item.intentreesortie = True
      Else
         item.intentreesortie = False
      End If
   Case Else   ' Texte normal
      Set vrtpremieritem = premier_doc.getfirstitem(item.strnom)
      Set vrtdeuxiemeitem = deuxieme_doc.getfirstitem(item.strnom)
      test_equivalence item, vrtpremieritem, vrtdeuxiemeitem
   End Select
End Sub

Sub test_equivalence(item As combiner, vrt_p As Variant, vrt_d As Variant)
   Dim flag As Integer
   flag = True
   Forall vp In vrt_p.values
      trouver = False
      Forall vd In vrt_d.values
         If vp = vd Then
            trouver = True
         End If
      End Forall
      If Not trouver Then
         flag = False
      End If
   End Forall
   If flag Then
      item.intentreesortie = False
   Else
      item.vrtpremiersortie = vrt_p.values
      item.vrtdeuxiemesortie = vrt_d.values
      item.intentreesortie = True
   End If
End Sub

Function tableau_attribut(i As Variant) As String
   attributs = ""
   If Isarray(i.embeddedobjects) Then
      Forall e In i.embeddedobjects
         attributs = attributs + " " + e.name
      End Forall
   Else
      attributs = ""
   End If
   tableau_attribut = attributs
End Function

Sub ecrire_rapport(c() As combiner)
   Dim p_debut() As Integer
   Dim p_longueur() As Integer
   Dim d_debut() As Integer
   Dim d_longueur() As Integer
   Dim p_contient() As String
   Dim d_contient() As String
   Dim i_contient() As String
   Dim index As Integer
   Redim p_debut(0)
   Redim p_longueur(0)
   Redim d_debut(0)
   Redim d_longueur(0)
   Redim p_contient(0)
   Redim d_contient(0)
   
   Forall i In c
      If i.intentreesortie Then
         Redim Preserve i_contient(index)
         i_contient(index) = i.strnom
         Redim Preserve p_debut(index)
         Redim Preserve p_longueur(index)
         If index = 0 Then
            p_debut(index) = 0
         Else
            p_debut(index) = p_debut(index - 1) + p_longueur(index - 1)
         End If
         If Isarray(i.vrtpremiersortie) Then
            p_longueur(index) = Ubound(i.vrtpremiersortie) + 1
            Redim Preserve p_contient(p_longueur(index) + p_debut(index))
            new_p = p_debut(index)
            Forall v In i.vrtpremiersortie
               p_contient(new_p) = v
               new_p = new_p + 1
            End Forall
         Else
            p_longueur(index) = 1
            Redim Preserve p_contient(p_longueur(index) + p_debut(index))
            new_p = p_debut(index)
            p_contient(new_p) = i.vrtpremiersortie
         End If
         Redim Preserve d_debut(index)
         Redim Preserve d_longueur(index)
         If index = 0 Then
            d_debut (index) = 0
         Else
            d_debut(index) = d_debut(index - 1) + d_longueur(index - 1)
         End If
         If Isarray(i.vrtdeuxiemesortie) Then
            d_longueur(index) = Ubound(i.vrtdeuxiemesortie) + 1
            Redim Preserve d_contient(d_longueur(index) + d_debut(index))
            new_d = d_debut(index)
            Forall v In i.vrtdeuxiemesortie
               d_contient(new_d) = v
               new_d = new_d + 1
            End Forall
         Else
            d_longueur(index) = 1
            Redim Preserve d_contient(d_longueur(index) + d_debut(index))
            new_d = d_debut(index)
            d_contient(new_d) = i.vrtdeuxiemesortie
         End If
         index = index + 1
      End If
   End Forall
   doc.deuxieme_debut = d_debut
   doc.deuxieme_longueur = d_longueur
   doc.deuxieme_contient = d_contient
   doc.premier_debut = p_debut
   doc.premier_longueur = p_longueur
   doc.premier_contient = p_contient
   doc.liste_champs = i_contient
   Dim ws As New notesuiworkspace
   x = ws.dialogbox("VoirResultats", True, True, False, False, False, False,"Conflits de Réplication",doc,True,False)
End Sub

Sub propriete_document(p As notesdocument, d As notesdocument)
   Dim strpremier(6) As String
   Dim strdeuxieme(6) As String
   
   strpremier(0) = "Créé le : " & Format(p.created, "ddd dd mmm yyyy hh:nn")
   strpremier(1) = "Notes ID : " & p.noteid
   If p.issigned Then
      strpremier(2) = "Signer : " & p.signer & " Accorder par " & p.verifier
   Else
      strpremier(2) = "Signer : Document NON signer"
   End If
   strpremier(3) = "Taille : " & p.size
   strpremier(4) = "UNID : " & p.universalid
   strpremier(5) = "Dernière modification : " & Format(p.lastmodified, "ddd dd mmm yyyy hh:nn")
   strpremier(6) = "Modifier par : " & p.authors(Ubound(p.authors))
   
   strdeuxieme(0) = "Créé le : " & Format(d.created, "ddd dd mmm yyyy hh:nn")
   strdeuxieme(1) = "Notes ID : " & d.noteid
   If p.issigned Then
      strdeuxieme(2) = "Signer : " & d.signer & " Accorder par " & d.verifier
   Else
      strdeuxieme(2) = "Signer : Document NON signer"
   End If
   strdeuxieme(3) = "Taille : " & d.size
   strdeuxieme(4) = "UNID : " & d.universalid
   strdeuxieme(5) = "Dernière modification : " & Format(d.lastmodified, "ddd dd mmm yyyy hh:nn")
   strdeuxieme(6) = "Modifier par : " & d.authors(Ubound(d.authors))
   
   doc.p_doc = strpremier
   doc.d_doc = strdeuxieme
   doc.d_unid = d.universalid
   doc.p_unid = p.universalid
End Sub

Base exemple