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 |
Partager