Suivit des erreurs
Description
Ici un module basDebugPiste qui permet de savoir le fichier et la fonction qui a provoque une erreur dans vos programmes. Il rempli un tableau a chaque entree de fonction et le vide si tout c'est bien passé. En cas d'erreur un msg box vous affiche : Le Num et la description de l'erreur (banal), mais aussi les fonctions en cours. La premiere affichée est celle qui a produit l'erreur, mais elle provient peut etre d'une des autre fonction en cours.
Possibilité d'un fichier .log de suivit.
Dans le Zip un autre module (F_Fich_Dir.bas) utilise pour tester l'exitence du fichier de suivit. (la fonction fso peut etre integre au module principal pour le rendre autonome).
3 fonctions :
Push(infos sur le fichier et la fonction en cours) -> remplissage du tableau
Pop -> on vide un element du tableau
AfficheErreur -> en cas de Pb on affiches les infos concernant l'erreur.
Bug connu : le repertoire du fichier .log doit exister
Dite moi ce que vous en pensez
A+
Spip
Possibilité d'un fichier .log de suivit.
Dans le Zip un autre module (F_Fich_Dir.bas) utilise pour tester l'exitence du fichier de suivit. (la fonction fso peut etre integre au module principal pour le rendre autonome).
3 fonctions :
Push(infos sur le fichier et la fonction en cours) -> remplissage du tableau
Pop -> on vide un element du tableau
AfficheErreur -> en cas de Pb on affiches les infos concernant l'erreur.
Source / Exemple :
'|---------------------------------------------------------------
'| module : basDebugPiste
'|---------------------------------------------------------------
'| Description : Fonctions de suivit d'erreurs
'|
'| Contenu :
'|---------------------------------------------------------------
'| 1> Push(ByVal strNomProc As gudtSuivit)
'|
'| Remplissage du tableau
'| Cette SubRoutine doit etre appelee
'| au début de chaques fonction ou Sub
'|
'| on doit lui fournir un objet de type gudtSuivit
'| comportant :
'| .NomModule
'| .NomFonction
'|---------------------------------------------------------------
'| 2> Pop()
'|
'|on vide le tableau
'|
'| Doit etre présent en fin de fonction ou
'| SubRoutine
'|----------------------------------------------------------------
'| 3> Public Sub AfficheErreur(ByVal NumErreur As String, _
'| ByVal DescriptionErreur As String, _
'| Optional ByVal FichierErreur As String)
'|
'| affichage des informations concernant l'erreur
'|
'| Valeurs a fournir :
'| NumErreur Le N° de l'erreur (err.Number)
'| DescriptionErreur La description de l'erreur (err.description)
'| Optionel :
'| Un fichier d'erreur A decrire depuis la racine (ex : "C:\lulu\Erreur.log" )
'| Si le fichier n'existe pas -> Il est cree
'| Le fichier est mis en lecture seule (pas de manips manuelles)
'| Pas de test d'existence du répertoire -> le créer au préalable
'| -> sinon pb (vrai aussi pour un disque <>)
'|---------------------------------------------------------------------
'| Utilisation :
'|
'| ---------------------------------------------------
'| Lors de ma mise en place d'un programme
'| il faut initialiser la variable publique
'| glngIndex a -1 (pour Form_load ou Sub main)
'| ---------------------------------------------------
'|
'| Private Sub Form_Load()
'|
'| initialisation de la variable erreur
'| Dim Erreur As gudtSuivit
'| on met l'index du tableau a -1
'| glngIndex = -1
'| With Erreur
'| .NomModule = "frmDebug"
'| .NomFonction = "Form_Load"
'| End With
'|
'| on rempli le tableau
'| Push Erreur
'|
'| Si une erreur se produit :
'| On Error GoTo etqErreur
'|
'| Bla bla ..... le programme
'| avoir 'une SubRoutine
'| Bla bla.....
'|
'| sortie de la subroutine
'| etqSortie:
'| Pop 'on vide le tableau d'un élément
'| Exit Sub 'on sort
'|----
'| etqErreur: 'les erreurs sont traitées Ici
'| utilisation du suivit d'erreurs
'| AfficheErreur Err.Number, Err.Description
'| GoTo etqSortie 'on sort par etqSortie
'|
'| End Sub ' fin de form_load
'| ----------------------------------------------------------------
'| pour une fonction ou SubRoutine Lamba.....
'|
'| public sub (ou function) avoir()
'|
'| Dim lulu as gudtSuivit
'| with lulu
'| .NomModule = "Nom du fichier intégrant avoir"
'| .NomFonction = "avoir"
'| End With
'| Push lulu
'|
'| on error goto etqErreur
'|
'| Blabla.......................
'|
'| etqSortie:
'| pop
'| exit sub (ou exit function)
'|
'| etqErreur:
'| AfficheErreur Err.Number, Err.Description
'| GoTo etqSortie 'on sort par etqSortie
'|
'| end sub (ou end function)
'|---------------------------------------------------------------------
'| Eléments(s) utilisé(s) par ce module : Bib/Fichiers/F_Fich_Dir.bas
'|
'|---------------------------------------------------------------------
'| Versions :
'|
'| jim le : 25/09/2002 origine
'|
'|#--------------------------------------------------------------------
Option Explicit
'----------------------------------------------------------------
' Objet de suivit
' NomModule : Nom du fichier ou se trouve la fonction
' ou la SubRoutine
' NomFonction : Nom de la fonction ou subroutine
'----------------------------------------------------------------
Public Type gudtSuivit
NomModule As String
NomFonction As String
End Type
'----------------------------------------------------------------
Public gpstrTabTrace() As gudtSuivit 'Le tableau du suivit
Public glngIndex As Long 'Index du tableau
'----------------------------------------------------------------
'----------------------------------------------------------------
'Remplissage du tableau
' Cette SubRoutine doit etre appelee
' au début de chaques fonction ou Sub
'
' on doit lui fournir un objet de type gudtSuivit
' comportant :
' .NomModule
' .NomFonction
'----------------------------------------------------------------
Public Sub Push(strNomProc As gudtSuivit)
'On ajoute un case au tableau
'-----------------------------------
glngIndex = glngIndex + 1
ReDim Preserve gpstrTabTrace(glngIndex)
'On lui affecte le nom de la fonction ou la proc en cours
'---------------------------------------------------------
gpstrTabTrace(glngIndex) = strNomProc
End Sub
'---------------------------------------------------------------
'on vide le tableau
'
' Doit etre présent en fin de fonction ou
' SubRoutine
'----------------------------------------------------------------
Public Sub Pop()
'on vide la derniere case du tableau
'si on est pas sur la derniere case
'--------------------------------------------
If UBound(gpstrTabTrace) <> 0 Then
ReDim Preserve gpstrTabTrace(UBound(gpstrTabTrace) - 1)
glngIndex = glngIndex - 1
Else
'sinon on vide le fichier
Erase gpstrTabTrace
glngIndex = -1
End If
End Sub
'----------------------------------------------------------------------------
'affichage des informations concernant l'erreur
'
' Valeurs a fournir :
' NumErreur Le N° de l'erreur (err.Number)
' DescriptionErreur La description de l'erreur (err.description)
' Optionel :
' Un fichier d'erreur A decrire depuis la racine (ex : "C:\lulu\Erreur.log" )
' Si le fichier n'existe pas -> Il est cree
' Le fichier est mis en lecture seule (pas de manips manuelles)
'----------------------------------------------------------------------------
Public Sub AfficheErreur(ByVal NumErreur As String, _
ByVal DescriptionErreur As String, _
Optional ByVal FichierErreur As String)
'--------------------------------------------
Dim strMsgErreur As String 'le message a afficher
Dim i As Long 'un compteur
Dim retour As Boolean 'pour test d'existence du fichier d'erreurs
Dim xlog As Long 'Num du fichier erreur
strMsgErreur = ""
xlog = FreeFile
'-------------------------------------------
strMsgErreur = "--------------------------------------------" + vbCrLf _
+ "Erreur N° " & NumErreur + vbCrLf _
+ DescriptionErreur + vbCrLf _
+ "--------------------------------------------" + vbCrLf
'--------------------------------------------------
'affichage des différentes procédures actives
'en partant de la derniere en cours
'--------------------------------------------------
For i = UBound(gpstrTabTrace) To 0 Step -1
strMsgErreur = strMsgErreur & _
"Module : " & gpstrTabTrace(i).NomModule & " " & " <-> " & _
"Fonction : " & gpstrTabTrace(i).NomFonction & vbCrLf
Next i
'affichage de la boite de message
'---------------------------------------
MsgBox strMsgErreur
'---------------------------------------
'Fichier d'erreur
'---------------------------------------
'si le parametre existe
If FichierErreur <> "" Then
'on teste s'il existe déjà
retour = Test_Fichier(FichierErreur) '-> voir module F_Fich_Dir.bas
'integrer la fonction fso pour etre autonome
If retour = False Then 'il n'existe pas
Open FichierErreur For Output As xlog
Print #xlog, "--------------------------------------------"
Print #xlog, " Le : " & Date & " a " & Time
Print #xlog, strMsgErreur
Close #xlog
SetAttr FichierErreur, vbReadOnly
Else 'il existe
'Append
SetAttr FichierErreur, vbNormal
Open FichierErreur For Append As xlog
Print #xlog, "--------------------------------------------"
Print #xlog, " Le : " & Date & " a " & Time
Print #xlog, strMsgErreur
Close #xlog
SetAttr FichierErreur, vbReadOnly
End If
End If
End Sub
Conclusion :
Bug connu : le repertoire du fichier .log doit exister
Dite moi ce que vous en pensez
A+
Spip
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.