Suivit des erreurs

Soyez le premier à donner votre avis sur cette source.

Vue 4 085 fois - Téléchargée 280 fois

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.

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

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

Messages postés
33
Date d'inscription
jeudi 27 septembre 2001
Statut
Membre
Dernière intervention
4 octobre 2003

y a plus simple : l'objet err
pour générer une erreur utilisateur :
Err.raise NumUserErreur
err.description UserDescription
Y a plus qu'à tester l'objet pour savoir si il y a eu une erreur rattrappée par un sub ou une classe
if err.number <> 0 then
msgbox err.description
end if
Messages postés
15814
Date d'inscription
jeudi 8 août 2002
Statut
Modérateur
Dernière intervention
4 mars 2013
102
Ca y'est, j'ai eu le temps de convertir une partie de cette source en dll. Il s'agit du module de gestion de fichier. Vous pouvez retrouver le fichier dll ici :

http://www.vbfrance.com/article.aspx?Val=6233

DARK SIDIOUS
Messages postés
15814
Date d'inscription
jeudi 8 août 2002
Statut
Modérateur
Dernière intervention
4 mars 2013
102
Pour la dll, ca ne va pas tarder : Je suis en train de bosser dessus.

DARK SIDIOUS
Messages postés
35
Date d'inscription
jeudi 13 juin 2002
Statut
Membre
Dernière intervention
5 décembre 2011

Pas de Pb pour une DLL DARKSIDIOUS. Je mets une condition a ce que tu diffuse la DLL sur le site. Histoire que tout le monde en profite .

A+
Spip
Messages postés
127
Date d'inscription
lundi 8 juillet 2002
Statut
Membre
Dernière intervention
4 janvier 2007
1
Super utile, et en plus félicitation pour le commentaire ...

Quand a DarkSiDious, as tu eu le temps de faire ta DLL ??????
Afficher les 8 commentaires

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.