Module de classe fichier
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
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.
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.
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.