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
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
| 'A pour but d'analyser le code et de retourner un dictionnaire qui contient
'le contenu du code à analyser (en fonction des paramètres de recherche)
'@Param lngRegExpParameter : permet de sélectionner le type d'analyse à faire
'@Param blnOnlyDeclarationLines : Mettre à True pour analyser uniquement les lignes de code en déclaration seules
'@Param strProjectName : Nom du Projet (si inconnu, celui-ci cherchera dans tous les projets)
'Resultat : Retourne un objet Dictionnary qui contient :
'- eImplements : Pour chaque Modules, contient la liste des interfaces implémentées par le module
'- eEnumMembers : Pour chaque énumération, contient la liste des membres de l'énumération
Public Function AnalyserCode(lngRegExpParameter As gv_enumRegExp, Optional ByVal blnOnlyDeclarationLines As Boolean, Optional ByVal strProjectName As String) As Scripting.Dictionary
Dim objVBProject As VBProject
Dim objVBComponent As VBComponent
Dim objCodeModule As CodeModule
Dim dicResultat As Scripting.Dictionary
Dim objRegExpEnum As RegExp
Dim objColMatches As MatchCollection
Dim objMatch As Match
Dim strMatchExtraction As String
Dim strVBProjectFileName As String
Dim strCodeModule As String
Dim vntSplittedProjectName As Variant
Dim dicEnumerations As Scripting.Dictionary
Dim dicEnumMembers As Scripting.Dictionary
Dim objMatchesEnumMembers As MatchCollection
Dim strListEnumMembers As String
Dim lngEnumMemberValue As Long
Dim vntLigneEnum As Variant
Dim vntCoupleKV As Variant
Dim dicModuleImplements As Scripting.Dictionary
Dim dicInterface As Scripting.Dictionary
Select Case lngRegExpParameter
Case eEnumMembers
Set dicEnumerations = New Scripting.Dictionary
Set dicResultat = dicEnumerations
Case eImplements
Set dicModuleImplements = New Scripting.Dictionary
Set dicResultat = dicModuleImplements
End Select
Set objRegExpEnum = New RegExp 'On instancie la RegExp
With objRegExpEnum 'On parametre RegExp
.Global = True
.MultiLine = False
.IgnoreCase = True
End With
If strProjectName <> vbNullString Then
vntSplittedProjectName = Split(strProjectName, ".")
strProjectName = vntSplittedProjectName(0)
End If
For Each objVBProject In Application.VBE.VBProjects
If strProjectName <> vbNullString Then
vntSplittedProjectName = Split(objVBProject.Filename, "\") 'Découpe le chemin d'accès du FileName avec le séparateur "\"
vntSplittedProjectName = Split(vntSplittedProjectName(UBound(vntSplittedProjectName)), ".") 'Récupère le nom de fichier en retirant l'extension
strVBProjectFileName = vntSplittedProjectName(0) 'Ecrit le nom de fichier dans la variable pour comparaison avec celui demandé
End If
If strVBProjectFileName = strProjectName Or strProjectName = vbNullString Then 'Si le projet demandé est le même que celui scruté ou si aucun projet n'est spécifié en paramètre
For Each objVBComponent In objVBProject.VBComponents 'Boucle pour chaque Composant du projet VB (Sheets, ThisWorkbook, Userforms, Modules, Modules de classe)
Set objCodeModule = objVBComponent.CodeModule 'Permet d'accéder au code contenu dans le composant du projet VB
With objCodeModule
If blnOnlyDeclarationLines Then 'Limite le code du module à examiner aux lignes de déclaration ou à la totalité
strCodeModule = .Lines(1, .CountOfDeclarationLines)
Else
strCodeModule = .Lines(1, .CountOfLines)
End If
'On supprime les commentaires si ils sont trouvés
If RegExpExecute(objRegExpEnum, strCodeModule, "((\t| )*REM|')(\s*(.*)(\n(\t| )*?.*( _\n\s*.*))?)", objColMatches) Then
strCodeModule = objRegExpEnum.Replace(strCodeModule, Chr(13))
End If
Select Case lngRegExpParameter
Case eEnumMembers
'On recherche et exécute RegExp pour retrouver notre Enum
If RegExpExecute(objRegExpEnum, strCodeModule, "(\t| )*(Public |Private ).?Enum ((\w)*)", objColMatches) Then
'On prend en compte la liste des enum
For Each objMatch In objColMatches
strMatchExtraction = objMatch.SubMatches(2)
If RegExpExecute(objRegExpEnum, strCodeModule, "(\t| )*(Public |Private )?Enum " & strMatchExtraction & "((.|\n)*?)End Enum", objMatchesEnumMembers) Then
'Logiquement un seul ou pas de résultat
'On prend en compte la liste des enum
'On supprime les tabulations, espaces, chr(10) éventuel(les)
strListEnumMembers = Replace(Replace(Replace(objMatchesEnumMembers(0).SubMatches(2), Chr(9), vbNullString), " ", vbNullString), Chr(10), "")
'Initialisation
lngEnumMemberValue = -1
Set dicEnumMembers = New Scripting.Dictionary
'On boucle sur chaque ligne (membre d'énumération)
For Each vntLigneEnum In Split(strListEnumMembers, Chr(13))
If vntLigneEnum <> "" Then
'On découpe pour trouver le couple key / valeur
vntCoupleKV = Split(vntLigneEnum, "=")
If UBound(vntCoupleKV) > 0 Then
'On retire les " et converti en Long (en cas de valeur Hexadécimale)
vntCoupleKV(1) = Replace(vntCoupleKV(1), """", vbNullString)
lngEnumMemberValue = CLng(vntCoupleKV(1))
Else
'On détermine la valeur attribuée par VB
lngEnumMemberValue = lngEnumMemberValue + 1
End If
'On note le couple dans le dico
If dicEnumMembers.Exists(lngEnumMemberValue) Then
dicEnumMembers.Item(lngEnumMemberValue) = dicEnumMembers.Item(lngEnumMemberValue) & "," & vntCoupleKV(0) 'Replace(dicEnumMembers.Item(lngEnumMemberValue), " ou", ",") & " ou " & vntCoupleKV(0)
Else
dicEnumMembers.Add lngEnumMemberValue, vntCoupleKV(0)
End If
End If
Next
dicEnumerations.Add strMatchExtraction, dicEnumMembers
End If
Next
End If
Case eImplements
'On recherche et exécute RegExp pour retrouver nos Implements
If RegExpExecute(objRegExpEnum, strCodeModule, "(\s)(Implements).((\w)*)", objColMatches) Then
Set dicInterface = New Scripting.Dictionary
'On prend en compte la liste des Implementations
For Each objMatch In objColMatches
strMatchExtraction = objMatch.SubMatches(2)
dicInterface.Add strMatchExtraction, strMatchExtraction
Next
dicModuleImplements.Add objVBComponent.Name, dicInterface
End If
End Select
End With
Next
End If
Next
Set AnalyserCode = dicResultat
End Function
'Permet de tester et exécuter un RegExp (Expression Régulière)
'@Param objRegExp : Instance de RegExp à exécuter
'@Param strText : Texte à tester
'@Param strPattern : Pattern à utiliser
'@Param objMatches : MatchsCollection (résultats de la requête RegExp)
Public Function RegExpExecute(ByRef objRegExp As RegExp, ByVal strText As String, ByVal strPattern As String, ByRef objMatches As MatchCollection) As Boolean
With objRegExp
.Pattern = strPattern
If .test(strText) Then
Set objMatches = .Execute(strText) 'On lance la requête
RegExpExecute = Not objMatches Is Nothing
End If
End With
End Function |
