Module de classe fichier

Soyez le premier à donner votre avis sur cette source.

Vue 6 463 fois - Téléchargée 566 fois

Description

Je m'attèle actuellement a m'écrire un module de classe gérant l'accès et le traitement de données de type fichier qui me sont les plus utile au quotidien. Pour le moment les fonctions équivalent VB transposé sont Input, Output, Append, Line Input, Print, Close. Egalement 2 fonctions ayant pour finalité d'écrire dans un fichier texte le contenu d'un tableau a 1 ou 2 dimensions et inversement de stocker les données d'un fichier dans un tableau dynamique à 1 ou 2 dimensions, en fonction du formatage des données contenues dans le fichier. Egalement présente une fonction qui détermine le nombre de dimension d'un tableau.

Je propose cette source principalement pour la soumettre à la critique afin d'obtenir de vous des remarques concernant l'efficacité, la propreté et l'optimisation de ce code afin de me permettre de progresser idéalement dans la voie de la POO en VB6. N'hésitez donc pas a y aller de vos conseil et astuces.
Egalement, cette source pourra éventuellement aider les non initiés dans mon genre a démarrer dans la programmation orienté objet.

D'avance merci

Source / Exemple :


Option Explicit 'force a déclarer les variables

'Definition des propriétés principales de la clase

Private lChemin As String 'le chemin d'accès du fichier
Private lIndex As Integer 'l'index numerique du fichier (communément "Nf")
Private lMethode As String 'la méthode de lock sur le fichier
Private lBoucle As Integer 'le nombre de tentative d'ouverture en cas d'erreur
Private lErr As Integer 'l'erreur généré s'il y a
Private lTabDim As Integer

Public Property Let Chemin(ByVal Chaine As String)
    'la propriété chemin est déclarée ici comme public
    'et accessible en lecture depuis l'exterieur de la classe
    lChemin = Chaine
    
End Property

Public Property Get Chemin() As String
    'la propriété chemin est déclarée ici comme public
    'et accessible en écriture depuis l'exterieur de la classe
    Chemin = lChemin
    
End Property

Public Property Get Dimension() As Integer

    Dimension = lTabDim
    
End Property

Public Property Get LapEOF() As Boolean
    'EOF permet de tester si le fichier correspondant à l'index
    'est en fin de lecture.
    If lErr <> 0 Then
        LapEOF = True
    Else
        If EOF(lIndex) Then LapEOF = True Else LapEOF = False
    End If

End Property

Public Property Get Erreur() As Integer
    'la propriété Erreur est déclarée ici comme public
    'et accessible en lecture depuis n'importe l'exterieur de la classe
    'elle ne sera pas déclarée en écriture pour eviter que l'on puisse
    'founir un code erreur erronée depuis l'exterieur de la classe
    Erreur = lErr
    
End Property

Public Sub LapInput(Optional NomDuFichier As String = vbNullString, _
    Optional TypeDeLock As String = vbNullString, _
        Optional NombreDeBoucle As Integer = 5)
                
    Dim Tentative As Integer
    Dim sTimer As Variant
    
    '***************************************************************
    'si le paramètre NomDuFichier n'est pas renseigné
    'on se tourne vers la propriété lChemin
    'si elle n'est pas renseigné alors on sort du traitement
    'si NomDuFichier est renseigné, on écrit lchemin
    'NomDuFichier est donc prioritaire sur la propriété lChemin
    If NomDuFichier = vbNullString Then
        If lChemin <> vbNullString Then
            NomDuFichier = lChemin
        Else
            MsgBox "Aucun chemin de fichier renseigné.", vbCritical
            Exit Sub
        End If
    Else
        lChemin = NomDuFichier
    End If
    '****************************************************************
    
    lIndex = FreeFile 'on recupere l'identificateur de fichier pour l'inscrire dans l'objet
    lMethode = TypeDeLock 'on recupere la methode de lock pour l'inscrire dans l'objet
    
    Screen.MousePointer = 11
    'on commence a boucler
    Do While Tentative < NombreDeBoucle
        On Error Resume Next
        Select Case lMethode
            Case "R" 'lock en lecture
                Open NomDuFichier For Input Lock Read As #lIndex
            Case "W" 'lock en ecriture
                Open NomDuFichier For Input Lock Write As #lIndex
            Case "RW" 'lock en lecture et en ecriture
                Open NomDuFichier For Input Lock Read Write As #lIndex
            Case "WR" 'lock en lecture et en ecriture
                Open NomDuFichier For Input Lock Read Write As #lIndex
            Case "" 'pas de lock
                Open NomDuFichier For Input As #lIndex
            Case Else
                MsgBox "Erreur sur le paramètre de Lock." & vbCrLf & "Fichier concerné:" & vbTab & lChemin
                Exit Sub
        End Select
        
        If Err = 0 Then Exit Do 'si pas d'erreur on sort du traitement...
        If Err = 53 Then Exit Do 'le fichier n'existe pas, pas la peine d'insister
        If Err = 75 Then Exit Do 'pareil que err 53 mais adresse de type reseau
        
        sTimer = Timer + 1 '...sinon on incremente la boucle et on retente l'accès au fichier
        Do While sTimer > Timer
            DoEvents
        Loop
        Tentative = Tentative + 1
        
    Loop
    
    Screen.MousePointer = 0
    
    If Err <> 0 Then
        'si à l'issue de la boucle on a toujours une erreur
        'alors on abandonne et on affiche un message d'erreur
        lErr = Err 'on ecrit l'erreur au sein de l'objet
        MsgBox MsgErr, vbCritical, "Erreur sur fichier."
        Close #lIndex
    End If
    
End Sub

Public Sub LapOutput(Optional NomDuFichier As String = vbNullString, _
    Optional TypeDeLock As String = vbNullString, _
        Optional NombreDeBoucle As Integer = 5)

    Dim Tentative As Integer
    Dim sTimer As Variant

    Screen.MousePointer = 11
    
    If NomDuFichier = vbNullString Then
        If lChemin <> vbNullString Then
            NomDuFichier = lChemin
        Else
            MsgBox "Aucun chemin de fichier renseigné.", vbCritical
            Exit Sub
        End If
    Else
        lChemin = NomDuFichier
    End If
    
    lIndex = FreeFile
    lMethode = TypeDeLock
    
    
    Do While Tentative < NombreDeBoucle
        On Error Resume Next
        Select Case lMethode
            Case "R"
                Open NomDuFichier For Output Lock Read As #lIndex
            Case "W"
                Open NomDuFichier For Output Lock Write As #lIndex
            Case "RW"
                Open NomDuFichier For Output Lock Read Write As #lIndex
            Case "WR"
                Open NomDuFichier For Output Lock Read Write As #lIndex
            Case ""
                Open NomDuFichier For Output As #lIndex
            Case Else
                MsgBox "Erreur sur le paramètre de Lock." & vbCrLf & "Fichier concerné:" & vbTab & lChemin
                Exit Sub
        End Select
        
        If Err = 0 Then Exit Do
    
        sTimer = Timer + 1
        Do While sTimer > Timer
            DoEvents
        Loop
        Tentative = Tentative + 1
        
    Loop
    
    Screen.MousePointer = 0
    
    If Err <> 0 Then
        lErr = 0
        MsgBox MsgErr, vbCritical, "Erreur sur fichier."
        Close #lIndex
    End If
    
End Sub

Public Sub LapAppend(Optional NomDuFichier As String = vbNullString, _
    Optional TypeDeLock As String = vbNullString, _
        Optional NombreDeBoucle As Integer = 5)

    Dim Tentative As Integer
    Dim sTimer As Variant

    Screen.MousePointer = 11
    
    If NomDuFichier = vbNullString Then
        If lChemin <> vbNullString Then
            NomDuFichier = lChemin
        Else
            MsgBox "Aucun chemin de fichier renseigné.", vbCritical
            Exit Sub
        End If
    Else
        lChemin = NomDuFichier
    End If
    
    lIndex = FreeFile
    lMethode = TypeDeLock
    
    
    Do While Tentative < NombreDeBoucle
        On Error Resume Next
        Select Case lMethode
            Case "R"
                Open NomDuFichier For Append Lock Read As #lIndex
            Case "W"
                Open NomDuFichier For Append Lock Write As #lIndex
            Case "RW"
                Open NomDuFichier For Append Lock Read Write As #lIndex
            Case "WR"
                Open NomDuFichier For Append Lock Read Write As #lIndex
            Case ""
                Open NomDuFichier For Append As #lIndex
            Case Else
                MsgBox "Erreur sur le paramètre de Lock." & vbCrLf & "Fichier concerné:" & vbTab & lChemin
                Exit Sub
        End Select
        
        If Err = 0 Then Exit Do
    
        sTimer = Timer + 1
        Do While sTimer > Timer
            DoEvents
        Loop
        Tentative = Tentative + 1
        
    Loop
    
    Screen.MousePointer = 0
    
    If Err <> 0 Then
        lErr = Err
        MsgBox MsgErr, vbCritical, "Erreur sur fichier."
        Close #lIndex
    End If
    
End Sub

Public Function LireLigne() As String

    Dim lect As String
    
    If lErr <> 0 And lIndex <> 0 Then Exit Function
    'si d'emblée on entre dans cette fonction avec une erreur au sein de l'ojjet
    'ou avec un identificateur nul, on abandonne le traitement
    
    lect = vbNullString
    
    On Error Resume Next
    Line Input #lIndex, lect 'on stocke d'abord la ligne dans une variable tampon
    If Err <> 0 Then
        lErr = Err
        MsgBox MsgErr, vbCritical, "Erreur en lecture."
    Else
        LireLigne = lect 'si pas d'erreur on retourne la ligne
    End If
    
End Function

Public Sub EcrireLigne(ByVal sData As Variant)

    If lErr <> 0 And lIndex <> 0 Then Exit Sub
    'si d'emblée on entre dans cette fonction avec une erreur au sein de l'ojjet
    'ou avec un identificateur nul, on abandonne le traitement
    
    sData = CStr(sData)
    'pour le moment j'ai décidé de paramétrer la variable a ecrire en variant
    'ainsi on peut envoyer a écrire n'importe quelle type de données
    'la fonction fait ensuite la conversion en String grâce à Cstr
    'et on ecrit la donnée dans le fichier.
    'Je ne sais pas si la méthode est la meilleure et je crois même que ce traitement est fait
    'en automatique dans VB
    'A aprronfondir
    
    On Error Resume Next
    Print #lIndex, sData
    If Err <> 0 Then
        lErr = Err
        MsgBox MsgErr, vbCritical, "Erreur en écriture."
    End If
    
End Sub

Public Function Denombre_Dimension(ByRef sArray As Variant) As Integer
    'cette fonction permet de retourner le nombre de dimension d'un tableau
    'concrètement on interroge chaque dimension jusqu'à obtenir une erreur
    'sur la premiere dimension inexistante. on compte les précécédentes qui n'ont pas
    'générées d'erreur, et on obtient le nombre de dimension valide.
    
    Dim i As Integer, Nbdim As Integer
    Dim test As Integer
    
    Nbdim = 0
    
    'on test d'abord si la variable traitée est de type array (un tableau donc)
    'sinon on sort
    If Not IsArray(sArray) Then
        MsgBox "Cette variable n'est pas un tableau", vbCritical, "Denombre_Dimension"
        Nbdim = -1
        Exit Function
    End If
    
    On Error Resume Next
    For i = 1 To 33
        test = UBound(sArray, i) 'on test chaque dimension avec Ubound jusqu'à obtenir un erreur
        If Err Then
            Denombre_Dimension = i - 1
            Exit For
        End If
    Next i
    
    'NB: je ne sais pas exactement à ce jour combien on peut attribuer de dimension à un tableau
    'il me semble avoir lu quelque part que ce nombre max est 32
    'a confirmer
    
End Function

Public Sub ConstruireTableau(ByRef UserArray() As String, Optional Separateur As String = "|")
    'cette fonction va stocker dans un tableau les données contenues dans un fichier
    'il faut lui passer en paramètre le tableau dans lequel on veut stocker les données
    'ATTENTION!  La fonction va écraser le tableau. s'il contenait des données à l'entrée
    'elle seront écrasées et donc, de par le fait, perdues :p
    
    'la fonction peut créer des tableaux jusqu'à 2 dimensions.
    'chaque ligne du fichier créera une ligne dans votre tableau.
    'si les données de chaque ligne du fichier sont séparées par le separateur
    'que vous aurez indiqué (le pipe par défaut, soit "|")
    'chaque données créera une colonne
    
    'exemple, si les données de votre fichier sont : 1|2|3|4
    '                                                5|6|7|8
    'la fonction créera un tableau de 2 sur 4
    
    Dim lect As String
    Dim TypeTab As String
    Dim NbCol As Long, i As Long, j As Long
    Dim NbColTmp As Long
    Dim tabtmp() As String, TabSplit() As String
    
    If lErr <> 0 And lIndex <> 0 Then Exit Sub
    
    'Ici on lit la 1ere ligne du fichier
    'Si on trouve le séparateur indiqué, on considérera un tableau a 2 dimension
    'Sinon un tableau a 1 dimension
    lect = LireLigne
    If InStr(1, lect, Separateur, 1) Then
        TypeTab = "2D"
    Else
        TypeTab = "1D"
    End If
    
    Select Case TypeTab
    
        Case "1D"
            'si on crée un tableau a 1 dimension, on crée a chaque ligne lu dans le fichier
            'une nouvelle ligne dans le tableau et on y affecte la donnée lu
            ReDim UserArray(0)
            
            Do While Not EOF(lIndex)
                UserArray(UBound(UserArray)) = lect
                ReDim Preserve UserArray(UBound(UserArray) + 1)
                lect = LireLigne
            Loop
            
        Case "2D"
            'dans le cas d'un tableau a 2 dimension:
            'on va utiliser un tableau temporaire pour stocker les colonnes:
            ReDim tabtmp(0)
            
            'd'abord on détermine le nombre de colonne grâce a split
            'qui va compter le nombre d'occurence "separateur"
            NbCol = UBound(Split(lect, Separateur))
         
            'ensuite on va stocker toute les lignes du fichier dans
            'le tableau temporaire
            Do While Not EOF(lIndex)
                tabtmp(UBound(tabtmp)) = lect
                ReDim Preserve tabtmp(UBound(tabtmp) + 1)
                lect = LireLigne
                'on trouve la ligne comprenant le plus grand nombre d'occurence seprateur
                'pour déterminer le nombre de colonne max necessaire
                NbColTmp = UBound(Split(lect, Separateur))
                If NbColTmp > NbCol Then NbCol = NbColTmp
            Loop
            
            'on peut alors définir la taille de notre tableau
            'le nombre de ligne correspond au nombre de ligne stockées dans le tableau temporaire
            '(ubound(tabtmp)
            'le nombre de colonne a été déterminé plus haut
            ReDim UserArray(UBound(tabtmp), NbCol)
            
            'ensuite on décompose le tableau temporaire avec Split
            'pour stocker chaque donnée dans les bonnes colonnes
            For i = LBound(tabtmp) To UBound(tabtmp)
                TabSplit = Split(tabtmp(i), Separateur)
                For j = LBound(TabSplit) To UBound(TabSplit)
                    UserArray(i, j) = TabSplit(j)
                Next j
            Next i
                
    End Select
    
    lTabDim = Denombre_Dimension(UserArray)
    
    'cette fonction a des applications limitées et n'est pas bien complète pour le moment
    'concrètement elle me sert surtout a stocker rapidement dans un tableau le contenu
    'd'un fichier de type .csv
End Sub

Public Sub EcrireTableau(ByVal sTableau As Variant, Optional Separateur As String = "|")
    'cette fonction va écrire le tableau envoyé en paramètre
    'dans un fichier texte
    
    Dim Nbdim As Integer
    Dim i As Long, j As Long
    Dim Aecrire As String
    
    If lErr <> 0 And lIndex <> 0 Then Exit Sub
    
    'd'abord on détermine le nombre de dimension du tableau
    'pour le moment la cette fonction gère jusqu'à 2 dimensions
    lTabDim = Denombre_Dimension(sTableau)
    If lTabDim = -1 Then Exit Sub
    
    Select Case Nbdim
        
        Case 1
            'si le tableau n'a qu'une dimension
            'on va ecrire dans le fichier autant de ligne qu'en possède le tableau
            For i = LBound(sTableau) To UBound(sTableau)
                EcrireLigne (sTableau(i))
            Next i
            
        Case 2
            'si le fichier comporte 2 dimensions
            'on lit chaque ligne du tabelau...
            For i = LBound(sTableau, 1) To UBound(sTableau, 1)
                Aecrire = vbNullString
                'pour chaque ligne on extrait les données de chaque colonne
                'et on les sépare avec le séparateur paramétré
                '(le pipe par défaut soit: "|")
                For j = LBound(sTableau, 2) To UBound(sTableau, 2)
                    Aecrire = Aecrire & sTableau(i, j)
                    'si on arrive a la derniere colonne on ne rajoute pas de séparateur:
                    If j < UBound(sTableau, 2) Then Aecrire = Aecrire & Separateur
                Next j
                
                'ensuite on ecrit la ligne dans le fichier
                Print #lIndex, Aecrire
            Next i
        
        Case Else
            'si plus de 2 dimensions alors on sort:
            MsgBox "La fonction ne gère pas plus de 2 dimensions.", vbCritical, "Tableau trop grand."
            
    End Select
    
End Sub

Public Sub Fermer()
    'la fonction ferme le fichier ouvert
    'si fichier ouvert il y a
    
    On Error Resume Next
    Close #lIndex
    If Err <> 0 Then
        MsgBox MsgErr, vbCritical, "Erreur en fermeture."
        lErr = Err
    End If
    
End Sub

Private Function MsgErr() As String
    'la fonction retourne un message que j'utilise dans mes Msgbox
    
    MsgErr = vbNullString
    
    MsgErr = "Erreur de type:" & vbTab & Err & vbCrLf
    MsgErr = MsgErr & "Description:  " & vbTab & Err.Description & vbCrLf
    MsgErr = MsgErr & "Fichier concerné:  " & vbTab & lChemin
    
End Function

Conclusion :


Les applications de ses fonctions sont limités. je les ai écrite principalement pour m'aider dans mon travail a ne plus réécrire 100x le meme code.
Mais peut-être pourront elles vous etre utile également.

Codes Sources

A voir également

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.