Contrôle de l'intégrité d'un fichier balisé

Version imprimable

17/11/2020, 23h27
steph78630

Contrôle de l'intégrité d'un fichier balisé
Bonjour,

j'ai besoin de créer un script en VBS permettant de vérifier l'intégrité d'un fichier balisé de plusieurs centaines / milliers de lignes et je ne sais pas trop comment m'y prendre...

A l'exécution de ce script, celui-ci doit ouvrir un fichier TXT ou XML et en lire chaque ligne :

- Identifier une balise d'ouverture (par ex. : <Mon_exemple>)
- Mettre en mémoire le nom de cette balise ainsi que la ligne ou elle se trouve
- Continuer à lire le fichier et identifier une balise de fermeture (par ex. : </Mon_exemple>)
- Si le nom des balises d'ouverture et de fermeture est identique, supprimer le nom de la balise (Mon_exemple) en mémoire ainsi que la ligne ou elle se trouve

En fin de lecture du fichier, afficher le nom des balises "orphelines" (qu'elles soient d'ouverture ou de fermeture) ainsi que les lignes ou elle se trouvent.

Dans cet exemple, les balises "Info_2" - ligne 3 et "Info_4" - ligne 5 sont orphelines :
Code:

1 2 3 4 5 6 7 8 <Balise_1> <Info_1>Mon info 1</Info_1> <Info_2>Mon info 2 <Info_3>Mon info 3</Info_3> Mon info 4</Info_4> <Info_5>Mon info 5</Info_5> </Balise_1> <Balise_1>Mon info 6</Balise_1>
Note : Une balise du même nom peut être déclarée plusieurs fois dans le fichier à condition qu'elle soit refermée avant qu'elle soit ouverte de nouveau (lignes 1, 7 et 8)

SVP, avez-vous des pistes / idées à me proposer ?
22/11/2020, 19h23
steph78630

Personne que cela inspire ? Ma demande n'est pas assez claire ?
23/11/2020, 09h44
omen999

bonjour,

Citation:

Ma demande n'est pas assez claire ?

très claire au contraire mais j'ai besoin encore d'un peu de temps
pour te proposer quelque chose car je suis assez occupé
et la gestion des lignes complique pas mal l'algo :aie:
23/11/2020, 20h36
steph78630

Super, merci... :D

Salut

Moi j'en suis là, mais je pense que algorithme n'est pas très solide, il faudrait plus de ligne pour améliorer et peut être passer par un RegExp avec Pattern = "(<[A-Za-z0-9_]*>)" 'pour trouver toutes les balises d'ouverture et Pattern = "(</[A-Za-z0-9_]*>)" 'pour trouver toutes les balises de fermeture.
En attendant ...

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
Dim LeFichier 'pour simuler le contenu du fichier
LeFichier = "<Balise_1>" & vbnewline _
& "<Info_1>Mon info 1</Info_1>" & vbnewline _
& "<Info_2>Mon info 2" & vbnewline _
& "<Info_3>Mon info 3</Info_3>" & vbnewline _
& "Mon info 4</Info_4>" & vbnewline _
& "<Info_5>Mon info 5</Info_5>" & vbnewline _
& "</Balise_1>" & vbnewline _
& "<Balise_1>Mon info 6</Balise_1>"
 
Dim Memo
Call(Trier)
MsgBox "Balise(s) orpheline(s) " & vbnewline & vbnewline & Memo
 
'*******************************************************************************
Sub Trier()
Dim Cpt, PosDeb, PosFin, PoS
Dim TblLg, TblCol, BaliseDeb, BaliseFin
 
TblLg = split(LeFichier,vbnewline)
For Cpt = 0 to Ubound(TblLg)
        PosDeb = Instr(1,TblLg(Cpt),"<",0)+ 1
        PosFin = Instr(PosDeb,TblLg(Cpt),">",0)
        BaliseDeb = Mid(TblLg(Cpt),PosDeb,PosFin-PosDeb)
        'MsgBox "BaliseDeb = " & BaliseDeb,,"première recherche"
        If Left(BaliseDeb,1) ="/" Then
                'MsgBox "balise fermente: " & BaliseDeb
                BaliseFin = "<" & BaliseDeb & ">"
                BaliseDeb = "<" & replace(BaliseDeb,"/","") & ">"
                Pos = InStrRev(LeFichier,BaliseDeb,PosFin,0)
                If Pos=0 Then
                        Memo = Memo & "ligne " & Cpt+1 & ": " & BaliseFin & vbnewline
                End If
                Else
                'MsgBox "balise ouvrente: " & BaliseDeb
                BaliseFin = "</" & BaliseDeb & ">"
                BaliseDeb = "<" & BaliseDeb & ">"
                Pos = Instr(PosFin,LeFichier,BaliseFin,0)
                If Pos=0 Then
                        Memo = Memo & "ligne " & Cpt+1 & ": " & BaliseDeb & vbnewline
                End If
        End If
Next
End Sub
'*******************************************************************************

24/11/2020, 21h52
steph78630

@ProgElecT, pour un premier jet, c'est déjà super...

ça correspond tout à fait à mon besoin :-) :-)
24/11/2020, 23h11
ProgElecT

Citation:

Envoyé par steph78630

...vérifier l'intégrité d'un fichier balisé de plusieurs centaines / milliers de lignes....

Citation:

Envoyé par steph78630

....ça correspond tout à fait à mon besoin :-) :-)

Cela fonctionne sur les centaines de lignes? alors là, ça m'épate, en tout cas tant mieux si cela a réglé ton problème.
24/11/2020, 23h24
steph78630

Citation:

Envoyé par ProgElecT

Cela fonctionne sur les centaines de lignes?...

Oups ! Désolé, on s'est mal compris :?

Je voulais dire que ton code est pile ce que j'espérais et déjà super content de cet essai.

Je l'ai maintenant testé sur l'un de mes fichiers de 24 000 lignes - en résultat :

- J'ai de nombreuses balises d'ouverture et de fermeture qui passent bien,
- J'ai aussi des balises de fermeture déclarées "orphelines" alors qu'elles ne le sont pas dans le fichier
- Je n'ai aucune balise d'ouverture déclarée orpheline

- Demain, je vais analyser de plus près le contenu du fichier balisé pour voir ce qui ne fonctionne pas

Autrement, je m'interroge sur la concaténation des infos de balises orphelines dans MEMO (lignes 32 et 40), vérifié à chaque ligne lue du fichier avec la boucle For :

> N'est-il pas un peu tôt pour déclarer une balise orpheline ? (ceci dit, cela fonctionne très bien pour certaines)

bonjour,
problème assez complexe donc intéressant :)
ça tombe bien car je cherchais justement un exemple pour illustrer
un projet d'article sur la pratique des expressions régulières
mais je ne savais pas comment devaient être traitées les balises
réciproquement imbriquées de même niveau
ex :

Code:

<A><B></A></B>

il y a 3 possibilités : aucun tag orphelin, tous les tags sont orphelins ou seuls <B> et <\B> le sont...
le présent code va au plus simple...(si on peut dire) c'est à dire qu'il considère que toutes les paires de tag sont valides
à tester :aie:

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
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
' ************************************************************************
' GetOrphanTags - omen999 - https://omen999.developpez.com - november 2020
' ************************************************************************
Dim reg, crlfmatches, tagmatches, orphmatches
Dim atags(), apos(), aline(), adata, lstags, lsrep
Dim strict : strict = 0
Dim result
 
 
stext = "<Info_999><Balise_1>infoXX" & vbCrLf &_
"<Info_1>Mon info 1</Info_1>" & vbCrLf &_
"<Info_2>Mon info 2" & vbCrLf &_
"<Info_3>Mon info 3<Info_3>Info3_imbriquée</Info_3></Info_3>" & vbCrLf &_
"Mon info 4</Info_4>" & vbCrLf &_
"<Info_5>Mon info 5</Info_5>" & vbCrLf &_
"</Balise_1>szer</Info_10>" & vbCrLf &_
"<Balise_1>Mon info 6</Info_2></Balise_1><Info_9>"
 
Function cbReplaceProc(match, sub1, pos, source)
  cbReplaceProc = String(Len(match), "#") ' renvoi du nombre magique
End Function
Function cbReplaceInvProc(match, sub1, sub2, pos, source) ' à réviser ultérieurement
  ' strict interdit la validation de tags orphelins validés a posteriori par des suppressions de paire de tags conformes
  ' pas efficace pour les tags réciproquement imbriqués
  If strict > pos Then
    cbReplaceInvProc = match 
  Else
    strict = pos
   cbReplaceInvProc = String(Len(sub1) + 2, "#") & sub2 & String(Len(sub1) + 3,"#")
  End If
End Function
 
Set reg = New RegExp : reg.IgnoreCase = True: reg.Global = True
 
' repérage des lignes
reg.Pattern = "\r\n"
Set crlfmatches = reg.Execute(stext)
' extraction de tous les tags
reg.Pattern = "<(?:|\/).+?>"
Set tagmatches = reg.Execute(stext)
ReDim atags(tagmatches.Count - 1)
ReDim apos(tagmatches.Count - 1)
ReDim aline(tagmatches.Count - 1)
adata = Array(atags,apos,aline) ' regroupe 3 tableaux simple dimension sans perdre la fonction Join
For n = 0 To tagmatches.Count - 1
  adata(0)(n) = tagmatches(n)
  adata(2)(n) = 1
  For i = 0 To crlfmatches.Count - 1
    If tagmatches(n).FirstIndex > crlfmatches(i).FirstIndex Then adata(2)(n) = i + 2
  Next
Next
 ' tous les tags extraits regroupés en une nouvelle chaine cible
lstags = Join(adata(0),"")
 ' maj des index des tags de la nouvelle cible
Set tagmatches = reg.Execute(lstags)
For n = 0 To tagmatches.Count - 1
  adata(1)(n) = tagmatches(n).FirstIndex
Next
' élimination des tags sans tag orphelin imbriqué
' pour ne pas modifier le tableau des index tags, on remplacera les tags éliminés par un "nombre magique" de même taille (chaine de #)
reg.Pattern = "<(.+)>#*?<\/\1>"   ' maj pattern pour gérer nombre magique 
lsrep = lstags
Do
  lstags = lsrep
  lsrep = reg.Replace(lstags,GetRef("cbReplaceProc"))
Loop Until lsrep = lstags
 ' élimination des tags avec tag orphelin imbriqué
reg.Pattern = "<(.+)>(.+?)<\/\1>"
Do
  lstags = lsrep
  lsrep = reg.Replace(lstags,GetRef("cbReplaceInvProc"))
Loop Until lsrep = lstags
reg.Pattern = "<(?:|\/).+?>"
Set orphmatches = reg.Execute(lsrep)
' collection de tous les tags orphelins
' un traitement supplémentaire est nécessaire pour ramener le numéro de ligne stocké dans adata(2)
result = ""
For n = 0 to orphmatches.Count - 1
  For i = 0 to UBound(adata(1))
    If orphmatches(n).FirstIndex = adata(1)(i) Then result = result & orphmatches(n) & vbTab & " n° de ligne : " & adata(2)(i) & vbCrLf
  Next
Next
MsgBox result

25/11/2020, 13h55
ProgElecT
Salut

J'ai refait le fichier d'omen999 à la main en l'intentant
```
<Info_999>
      <Balise_1>infoXX
            <Info_1>Mon info 1</Info_1>
            <Info_2>Mon info 2
            <Info_3>Mon info 3<Info_3>Info3_imbriquée</Info_3></Info_3>
            Mon info 4</Info_4>
            <Info_5>Mon info 5</Info_5>
      </Balise_1>
      szer</Info_10>
<Balise_1>
      Mon info 6</Info_2>
</Balise_1>
<Info_9>
```
En rouge les balises orphelines, en vert et bleu balises non orphelines
d'accord avec moi ou pas ?
Si oui,
<Info_999>
<Info_2>
</Info_4>
</Info_10>
</Info_2>
<Info_9>
doivent être considérées comme balises orphelines.

Ben s'est pas de la tarte pour trouver l'algorithme, moi je n'y suis pas parvenu.

:hola: omen999 , :hola: , ton algorithme a bien l'air d'être solide :ccool:
25/11/2020, 14h18
omen999

Citation:

ton algorithme a bien l'air d'être solide

solide mais pas bulletproof :aie: il y a un cas limite peut-être rare qui pose problème
en ce qui concerne les tags imbriqués un contrôle de validité pourrait être ajouté
avec le parser du composant "xml dom document" ProgID : "Microsoft.XMLDOM.1.0"
pour lever le doute
08/12/2020, 22h05
steph78630

Citation:

Envoyé par ProgElecT

...d'accord avec moi ou pas ?
Si oui,
<Info_999>
<Info_2>
</Info_4>
</Info_10>
</Info_2>
<Info_9>
doivent être considérées comme balises orphelines.
...

Salut @ProgElecT

Oui, c'est presque ça : A part l'imbrication d'Info_3 en ligne 5 qui serait déclaré comme une erreur pour mon besoin (2ème ouverture d'une balise avant sa 1ère fermeture).

Citation:

Envoyé par omen999

...à tester :aie:

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
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
' ************************************************************************
' GetOrphanTags - omen999 - https://omen999.developpez.com - november 2020
' ************************************************************************
Dim reg, crlfmatches, tagmatches, orphmatches
Dim atags(), apos(), aline(), adata, lstags, lsrep
Dim strict : strict = 0
Dim result
 
 
stext = "<Info_999><Balise_1>infoXX" & vbCrLf &_
"<Info_1>Mon info 1</Info_1>" & vbCrLf &_
"<Info_2>Mon info 2" & vbCrLf &_
"<Info_3>Mon info 3<Info_3>Info3_imbriquée</Info_3></Info_3>" & vbCrLf &_
"Mon info 4</Info_4>" & vbCrLf &_
"<Info_5>Mon info 5</Info_5>" & vbCrLf &_
"</Balise_1>szer</Info_10>" & vbCrLf &_
"<Balise_1>Mon info 6</Info_2></Balise_1><Info_9>"
 
Function cbReplaceProc(match, sub1, pos, source)
  cbReplaceProc = String(Len(match), "#") ' renvoi du nombre magique
End Function
Function cbReplaceInvProc(match, sub1, sub2, pos, source) ' à réviser ultérieurement
  ' strict interdit la validation de tags orphelins validés a posteriori par des suppressions de paire de tags conformes
  ' pas efficace pour les tags réciproquement imbriqués
  If strict > pos Then
    cbReplaceInvProc = match 
  Else
    strict = pos
   cbReplaceInvProc = String(Len(sub1) + 2, "#") & sub2 & String(Len(sub1) + 3,"#")
  End If
End Function
 
Set reg = New RegExp : reg.IgnoreCase = True: reg.Global = True
 
' repérage des lignes
reg.Pattern = "\r\n"
Set crlfmatches = reg.Execute(stext)
' extraction de tous les tags
reg.Pattern = "<(?:|\/).+?>"
Set tagmatches = reg.Execute(stext)
ReDim atags(tagmatches.Count - 1)
ReDim apos(tagmatches.Count - 1)
ReDim aline(tagmatches.Count - 1)
adata = Array(atags,apos,aline) ' regroupe 3 tableaux simple dimension sans perdre la fonction Join
For n = 0 To tagmatches.Count - 1
  adata(0)(n) = tagmatches(n)
  adata(2)(n) = 1
  For i = 0 To crlfmatches.Count - 1
    If tagmatches(n).FirstIndex > crlfmatches(i).FirstIndex Then adata(2)(n) = i + 2
  Next
Next
 ' tous les tags extraits regroupés en une nouvelle chaine cible
lstags = Join(adata(0),"")
 ' maj des index des tags de la nouvelle cible
Set tagmatches = reg.Execute(lstags)
For n = 0 To tagmatches.Count - 1
  adata(1)(n) = tagmatches(n).FirstIndex
Next
' élimination des tags sans tag orphelin imbriqué
' pour ne pas modifier le tableau des index tags, on remplacera les tags éliminés par un "nombre magique" de même taille (chaine de #)
reg.Pattern = "<(.+)>#*?<\/\1>"   ' maj pattern pour gérer nombre magique 
lsrep = lstags
Do
  lstags = lsrep
  lsrep = reg.Replace(lstags,GetRef("cbReplaceProc"))
Loop Until lsrep = lstags
 ' élimination des tags avec tag orphelin imbriqué
reg.Pattern = "<(.+)>(.+?)<\/\1>"
Do
  lstags = lsrep
  lsrep = reg.Replace(lstags,GetRef("cbReplaceInvProc"))
Loop Until lsrep = lstags
reg.Pattern = "<(?:|\/).+?>"
Set orphmatches = reg.Execute(lsrep)
' collection de tous les tags orphelins
' un traitement supplémentaire est nécessaire pour ramener le numéro de ligne stocké dans adata(2)
result = ""
For n = 0 to orphmatches.Count - 1
  For i = 0 to UBound(adata(1))
    If orphmatches(n).FirstIndex = adata(1)(i) Then result = result & orphmatches(n) & vbTab & " n° de ligne : " & adata(2)(i) & vbCrLf
  Next
Next
MsgBox result

Salut @omen999,

j'ai exécuté ton code sur l'un de mes fichiers (~25 000 lignes)... ça mouline, ça mouline... mais j'ai dû l'arrêter après 15 mns env. car ça prenait beaucoup de ressources proc. et je n'en voyais pas la fin.

Re,

j'ai essayé de mon côté, ça a l'air de pas trop mal fonctionner... (testé avec l'un de mes fichiers)

> Il y a tout de même des balises d'ouverture orphelines qui manquent, et je pense que mon code est loin d'être optimisé, alors vos avis, commentaires et remarques seront les bienvenus ! :D

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
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
Option Explicit
 
Dim objFSO, objFile, tabTags, countLine, strLine, DeleteTag
 
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile("my_tagged_file.txt", 1)
 
tabTags = array()
countLine = 1
 
Do Until objFile.AtEndOfStream
	strLine = objFile.ReadLine  
	RegEx_SearchTag strLine, "(<[A-Za-z0-9_]*>)"	' Recherche balise d'ouverture
	RegEx_SearchTag strLine, "(</[A-Za-z0-9_]*>)"	' Recherche balise de fermeture
	' WScript.Echo "Ligne en cours : " & countLine & VbCrLf & VbCrLf & ListTags
	countLine = countLine + 1
Loop
 
WScript.Echo "Balise(s) orpheline(s) :" & VbCrLf & VbCrLf & ListTags
 
' On ferme le fichier et on libère l'objet
objFile.Close
Set objFile = Nothing
 
 
' ******** Fonctions ********
 
Function RegEx_SearchTag(strLine, strPattern)
	Dim objRegEx, colMatches, objMatch, TempOpeningTag
	Set objRegEx		= New RegExp
	objRegEx.Pattern	= strPattern
	objRegEx.IgnoreCase	= True
	objRegEx.Global		= True
	Set colMatches		= objRegEx.Execute(strLine)
	For Each objMatch In colMatches
		If Mid(objMatch.Value, 2, 1) = "/" Then	' Balise de fermeture
			TempOpeningTag = Replace(objMatch.Value, "/", "")
			RemoveTag tabTags, TempOpeningTag
			If DeleteTag <> TempOpeningTag Then	' Si pas de balise d'ouverture correspondant
				AddTag tabTags, objMatch.Value & ";" & countLine
			End If
		Else ' Balise d'ouverture
			AddTag tabTags, objMatch.Value & ";" & countLine
		End If
	Next
	Set objRegEX = Nothing
End Function
 
Function RemoveTag(tabTags, strTag)	' Suppression d'une balise en memoire
	Const DeleteIndicator = "DELETEME"
	Dim i, tabItem
	DeleteTag = ""
	For i = 0 to UBound(tabTags)
		tabItem = Split(tabTags(i), ";")
		If tabItem(0) = strTag Then
			tabTags(i) = DeleteIndicator
			DeleteTag = strTag
		'	Exit For
		End If
	Next
	tabTags = Filter(tabTags, DeleteIndicator, False, 1)
End Function
 
Function AddTag(tabTags, strTag)	' Ajout d'une balise en memoire
	ReDim Preserve tabTags(UBound(tabTags) + 1)
	tabTags(UBound(tabTags)) = strTag
End function
 
Function ListTags	' Liste des balises en memoire
	Dim InfoTag, i, tabItem
	InfoTag = "Nom balise" & VbTab & "Ligne" & VbCrLf & VbCrLf
	For i = 0 to UBound(tabTags)
		tabItem = Split(tabTags(i), ";")
		InfoTag = InfoTag & tabItem(0) & VbTab & tabItem(1) & VbCrLf
	Next
	If UBound(tabTags) = -1 Then
		ListTags = "Aucun probleme d'integrite"
	Else
		ListTags = InfoTag
	End If
	InfoTag = ""
End Function

17/12/2020, 01h14
steph78630

Plutôt que de créer un tableau, ce serait peut-être plus simple d'utiliser l'objet Dictionary qui semble fait pour ça ?