OVH Cloud OVH Cloud

Problème avec des E/S sur un fichier

7 réponses
Avatar
RAHOU
Bonjour,
je viens de cosntituer un petit programme qui permet =E0=20
partir des donn=E9es d'un fichier Texte de cr=E9er un=20
fichier .dat dont le contenu est le r=E9sultat des lignes du=20
fiches texte auxquelles on concat=E8ne une certaine chaine=20
de caract=E8res.
Mais le probl=E8me est que si les lignes du fichier texte=20
d=E9passe 7000, le programme se plante et ne peut plus=20
traiter les lignes restantes, alors que je dois traiter=20
plus de 20 000 lignes .

Je vous donne code source qui fait le traitement:


//d=E9but du code

Dim TextLine
Open LblTexte1.Caption For Input As #1 ' Ouvre le=20
fichier.
Do While Not EOF(1) ' Effectue la boucle jusqu'=E0 la fin=20
du fichier.
Line Input #1, TextLine ' Lit la ligne dans la=20
variable.
Concate =3D "REMACNT,HJGGHGG=3D" & TextLine & ";"
'concat=E8ne la ligne du fichier texte =E0 notre chaine
=20
=20
' Ouvre le fichier afin d'y entrer des donn=E9es.
Open LblBatch1.Caption For Append As #2
Do While Not EOF(2) ' V=E9rifie si la fin du fichier est=20
atteinte.
Loop
'on =E9crit =E0 la fin du fichier .dat
Print #2, Concate
Close #2 ' Ferme le fichier.
Loop
Close #2 ' Ferme le fichier.
MsgBox "Fichier Batch cr=E9=E9 avec succ=E8s, il est enregistr=E9=20
dans " & LblBatch1.Caption, , "Cr=E9ation d'un fichier Batch"
=20
FrmTraitement.Hide
Dim i As Integer
' Boucler sur la collection Forms et d=E9chargez
' chaque feuille.
For i =3D Forms.Count - 1 To 0 Step -1
Unload Forms(i)
Next


//fin du code

Merci de me r=E9pondre

7 réponses

Avatar
Zoury
Salut Rahou! :O)

Quelle est l'erreur rencontrée? ton code semble correct à première vue..

Voici toutefois quelques conseils :

- Tu fermes le fichier 2 deux fois de suite alors que tu devrais fermer le
fichier numéro 1 la deuxième fois. VB devrait tout de même le fermer
correctement, mais tu ne devrais pas prendre de chance et surtout prendre
cette bonne habitude de libérer les ressources que tu utlises. Si tu
travailles avec des APIs, ça ne pardonne pas..

: Close #2 ' Ferme le fichier.
: Loop
: Close #2 ' Ferme le fichier

- Je te conseilles d'éviter l'utilisation de numéro de fichier coder-en-dur.
Utilise plutôt la fonction FreeFile qui te renvoi le prochain disponible.

Ex :

Dim hFile1 As Long

hFile1 = FreeFile
Open monfichier1 For Input As #hFile1

'...

hFile2 = FreeFile
Open .... As #hFile2

' ...

Close #hFile1
Close #hFile2

- Je te recommende également fortement d'indenter ton code. Cela le rendra
plus facile à lire autant pour toi que pour ceux qui le liront par la suite.

- Et finalement, ce bout de code est inutile étant donné que l'ouverture en
mode Append place immédiatement le curseur à la fin du fichier.
: Do While Not EOF(2) ' Vérifie si ...
: Loop



Maintenant, il me semble qu'un fichier .dat serait plus efficace s'il était
sauvegardé en binaire non?

--
Cordialement
Yanick Lefebvre - MVP pour Visual Basic
http://faq.vb.free.fr/?rubrique=0 - http://www.mvps.org/vbnet/
http://www.mentalis.org/agnet/apiguide.shtml - http://www.mztools.com/

Merci de poster les réponses au groupe afin d'en faire profiter à tous
Avatar
RAHOU
Merci Zouri,
Merci pour les conseils que vous avez bien voulu me donner
pour améliorer la lisibilté et la transparence de mon
programme.
Au fait, je me suis rendu compte par le suite que le
programme tournait bien, le problème c que cela prenait un
peu de temps (1 minutes) pour traiter 20 000 lignes.
Le pb est que je n'avais pas mis de progressbar ou
d'indicateurs pour montrer la progression du traitement.
Je demande maintenant comment faire pour paramètrer le
progressbar pour vouloir la progession du traitement des
fichiers.

PS: je vais essayer d'enregistrer mon fichier en binaire
et d'éviter de coder en dur les canaux des fichiers.

Merci et à bientôt


-----Message d'origine-----
Salut Rahou! :O)

Quelle est l'erreur rencontrée? ton code semble correct à


première vue..

Voici toutefois quelques conseils :

- Tu fermes le fichier 2 deux fois de suite alors que tu


devrais fermer le
fichier numéro 1 la deuxième fois. VB devrait tout de


même le fermer
correctement, mais tu ne devrais pas prendre de chance et


surtout prendre
cette bonne habitude de libérer les ressources que tu


utlises. Si tu
travailles avec des APIs, ça ne pardonne pas..

: Close #2 ' Ferme le fichier.
: Loop
: Close #2 ' Ferme le fichier

- Je te conseilles d'éviter l'utilisation de numéro de


fichier coder-en-dur.
Utilise plutôt la fonction FreeFile qui te renvoi le


prochain disponible.

Ex :

Dim hFile1 As Long

hFile1 = FreeFile
Open monfichier1 For Input As #hFile1

'...

hFile2 = FreeFile
Open .... As #hFile2

' ...

Close #hFile1
Close #hFile2

- Je te recommende également fortement d'indenter ton


code. Cela le rendra
plus facile à lire autant pour toi que pour ceux qui le


liront par la suite.

- Et finalement, ce bout de code est inutile étant donné


que l'ouverture en
mode Append place immédiatement le curseur à la fin du


fichier.
: Do While Not EOF(2) ' Vérifie si ...
: Loop



Maintenant, il me semble qu'un fichier .dat serait plus


efficace s'il était
sauvegardé en binaire non?

--
Cordialement
Yanick Lefebvre - MVP pour Visual Basic
http://faq.vb.free.fr/?rubrique=0 -


http://www.mvps.org/vbnet/
http://www.mentalis.org/agnet/apiguide.shtml -


http://www.mztools.com/

Merci de poster les réponses au groupe afin d'en faire


profiter à tous


.



Avatar
Zoury
Salut Rahou! :O)

Voici un exemple qui créer un fichier de 25000 lignes et qui le tranforme
comme tu le voulais en incrémentant une barre de progrès.
'***
' Ajouter la composante Microsoft Windows Common Control 6.0 (SP6)
' Form1, BorderStyle = 3 - Fixed Single, ControlBox = False
Option Explicit

Private Sub Form_Activate()
Call GenerateNewFile("c:file1.txt", "c:file2.txt")
Unload Me
End Sub

Private Sub Form_Load()
Call GenerateSampleFile("c:file1.txt", 25000)
Call InitProgressBar(0, 25000)
Call InitInterface
End Sub

Private Sub GenerateSampleFile _
( _
ByRef sFilePath As String, _
ByRef lLineCount As Long _
)

Dim f As CFile
Dim i As Long

Set f = New CFile
For i = 1 To lLineCount
Call f.AppendLine("Ligne " & i)
Next i

Call f.SaveFileAs(sFilePath)

End Sub

Private Sub InitProgressBar(ByRef lMin As Long, ByRef lMax As Long)
ProgressBar1.Min = lMin
ProgressBar1.Max = lMax
ProgressBar1.Value = 0
ProgressBar1.Scrolling = ccScrollingSmooth
End Sub

Private Sub GenerateNewFile(ByRef sSrcFilePath As String, ByRef
sDestFilePath As String)

Const LINE_HEADER As String = "REMACNT,HJGGHGG="
Dim f As CFile
Dim i As Long

Set f = New CFile
Call f.OpenFile(sSrcFilePath)

For i = 1 To f.LineCount
f.Lines(i) = LINE_HEADER & f.Lines(i)
ProgressBar1.Value = ProgressBar1.Value + 1
' On modifie la valeur à
' l'écran une fois sur 10
' afin de réduire l'effet
' de rafraichissement
If i Mod 10 = 0 Then Label1.Caption = "Progression... " & CStr(Int(i
/ f.LineCount * 100)) & "%"
DoEvents
Next i

Call f.SaveFileAs(sDestFilePath)

End Sub

Private Sub InitInterface()

Me.Caption = "Exemple de barre de progrès"

Call Me.Move(0, 0, 5535, 1230)
Call Label1.Move(120, 120, 5175, 255)
Call ProgressBar1.Move(120, 360, 5175, 255)

End Sub
'***

Comme tu peux le voir le traitement est assez long.. Je me dis que tu
pourrais à la place de concatener la nouvelle valeur à chaque, faire une
Replace() de vbNewLine par VbNewLine & LINE_HEADER.

Voici un exemple
'***
Option Explicit

Private Sub Main()
Call GenerateSampleFile("c:file1.txt", 25000)
Call GenerateNewFile("c:file1.txt", "c:file2.txt")
End Sub

Private Sub GenerateSampleFile _
( _
ByRef sFilePath As String, _
ByRef lLineCount As Long _
)

Dim f As CFile
Dim i As Long

Set f = New CFile
For i = 1 To lLineCount
Call f.AppendLine("Ligne " & i)
Next i

Call f.SaveFileAs(sFilePath)

End Sub

Private Sub GenerateNewFile(ByRef sSrcFilePath As String, ByRef
sDestFilePath As String)

Const LINE_HEADER As String = "REMACNT,HJGGHGG="
Dim f As CFile

Set f = New CFile
Call f.OpenFile(sSrcFilePath)
Call f.ReplaceText(vbNewLine, vbNewLine & LINE_HEADER)
Call f.SaveFileAs(sDestFilePath)

End Sub
'***

Ma *nouvelle* classe CFile est en annexe..

j'y ai ajouté les fonctions :

ReplaceText = équivalent de Replace()
IndexOf = équivalent de InStr()
LastIndexOf = équivalent de InStrRev()

et pleins d'autres reste à venir. :O)

--
Cordialement
Yanick Lefebvre - MVP pour Visual Basic
http://faq.vb.free.fr/?rubrique=0 - http://www.mvps.org/vbnet/
http://www.mentalis.org/agnet/apiguide.shtml - http://www.mztools.com/

Merci de poster les réponses au groupe afin d'en faire profiter à tous

'***
'*********************************************
' Classe CFile
'
' Permet la lecture d'un fichier
' ligne par ligne
'
' Programmé par Yanick Lefebvre
' enlevé le .no_spam afin de m'écrire
'
'
'*********************************************
Option Explicit

Private m_sLignes() As String ' Contient les lignes du fichier
Private Const BUFFER_SIZE As Long = 500 ' Taille du buffer
Private m_lIndex As Long ' Index actuel
Private m_sFile As String ' Nom du fichier

'**************************************
' Renvoi la ligne demandée
'**************************************
Public Property Get Lines(ByRef lNumLine As Long) As String
If lNumLine > 0 And lNumLine <= (UBound(m_sLignes) + 1) Then
Lines = m_sLignes(lNumLine - 1)
End If
End Property

'**************************************
' Modifie la ligne demandée
'**************************************
Public Property Let Lines _
( _
ByRef lNumLine As Long, _
ByRef sLine As String _
)
If lNumLine > 0 And lNumLine <= (UBound(m_sLignes) + 1) Then
m_sLignes(lNumLine - 1) = sLine
End If
End Property

'**************************************
' Ajoute une ligne
'**************************************
Public Function AppendLine(ByRef sLine As String) As String

m_lIndex = m_lIndex + 1
If Not (m_lIndex <= UBound(m_sLignes)) Then
ReDim Preserve m_sLignes(UBound(m_sLignes) + BUFFER_SIZE) As String
End If
m_sLignes(m_lIndex) = sLine

End Function

'**************************************
' Ajoute du texte
'**************************************
Public Function Append(ByRef sText As String) As String

Dim s() As String
Dim i As Long

s = Split(sText, vbNewLine)

If m_lIndex = -1 Then
m_lIndex = m_lIndex + 1
If Not (m_lIndex <= UBound(m_sLignes)) Then
ReDim Preserve m_sLignes(UBound(m_sLignes) + BUFFER_SIZE) As
String
End If
End If
m_sLignes(m_lIndex) = m_sLignes(m_lIndex) & s(0)
For i = 1 To UBound(s)
Call AppendLine(s(i))
Next i

End Function

'**************************************
' Renvoi le texte en entier
'**************************************
Public Property Get Text() As String
Dim s() As String
s = m_sLignes
ReDim Preserve s(m_lIndex) As String
Text = Join(s, vbNewLine)
End Property

'**************************************
' Renvoi le nombre du ligne contenu
' dans le fichier
'**************************************
Public Property Get LineCount() As Long
LineCount = m_lIndex + 1
End Property

'**************************************
' Lit le fichier et le stock dans
' notre tableau
'**************************************
Public Function OpenFile(ByRef sFile As String) As String

OpenFile = GetFileContent(sFile)
If LenB(OpenFile) <> 0 Then
m_sFile = sFile
m_sLignes = Split(OpenFile, vbNewLine)
m_lIndex = UBound(m_sLignes)
End If

End Function

'*****************************
' Lit et renvoi le contenu du
' fichier sFile
'*****************************
Private Function GetFileContent(ByRef sFile As String) As String

Dim hFile As Integer ' Handle du fichier
Dim sText As String ' Contenu du fichier

' Sort le fichier n'existe pas...
If Not FileExists(sFile) Then
Err.Raise 53
Exit Function
End If

hFile = FreeFile
Open sFile For Binary As #hFile
sText = Space$(LOF(hFile))
Get #hFile, , sText
Close #hFile

GetFileContent = sText

End Function


'**************************************
' Écrit un nouveau fichier
'**************************************
Public Sub SaveFileAs(ByRef sFile As String)

Dim hFile As Integer ' Handle du fichier
Dim sText As String ' Contenu du fichier

m_sFile = sFile

If FileExists(sFile) Then
Kill sFile
End If

' Réduit le tableau et obtient le texte
If m_lIndex > -1 Then
ReDim Preserve m_sLignes(m_lIndex) As String
sText = Join(m_sLignes, vbNewLine)
End If

hFile = FreeFile
Open sFile For Binary As #hFile
Put #hFile, , sText
Close #hFile

End Sub

'**************************************
' Écrit le fichier
'**************************************
Public Sub SaveFile()

Dim hFile As Integer ' Handle du fichier
Dim sText As String ' Contenu du fichier

' Sort si aucun nom de fichier n'est spéficier
If LenB(m_sFile) = 0 Then
Exit Sub
End If

' Réduit le tableau et obtient le texte
If m_lIndex > -1 Then
ReDim Preserve m_sLignes(m_lIndex) As String
sText = Join(m_sLignes, vbNewLine)
End If

hFile = FreeFile
Open m_sFile For Binary As #hFile
Put #hFile, , sText
Close #hFile

End Sub

'**************************************
' Initialise le tableau de String
'**************************************
Private Sub Class_Initialize()
m_sLignes = Split("", " ")
m_lIndex = -1
End Sub

'**************************************
' Vérifie si le fichier existe
'**************************************
Private Function FileExists(ByRef sFile As String) As Boolean
On Error Resume Next
FileExists = ((GetAttr(sFile) And vbDirectory) = 0)
End Function

'**************************************
' Ajoute le contenu du fichier sFile
' à la suite du texte et renvoi le
' texte du fichier ajouté
'**************************************
Public Function AppendFile(ByRef sFile As String) As String

AppendFile = GetFileContent(sFile)
If LenB(AppendFile) <> 0 Then
Call Append(AppendFile)
End If

End Function

'**************************************
' Remplace la chaine cherchée par
' la nouvelle
'**************************************
Public Sub ReplaceText _
( _
ByRef sFind As String, _
ByRef sReplace As String, _
Optional ByRef lStart As Long = 1, _
Optional ByRef lCount As Long = -1, _
Optional ByRef cm As VbCompareMethod = vbBinaryCompare _
)

m_sLignes = Split(Replace(Text, sFind, sReplace, lStart, lCount, cm),
vbNewLine)
m_lIndex = UBound(m_sLignes)

End Sub

'**************************************
' Renvoi la position de la première
' occurance de sFind trouvée dans
' le texte
'**************************************
Public Function IndexOf _
( _
ByRef sFind As String, _
Optional ByRef lStart As Long = 1, _
Optional ByRef cm As VbCompareMethod = vbBinaryCompare _
) As Long
IndexOf = InStr(lStart, Text, sFind, cm)
End Function

'**************************************
' Renvoi la position de la dernière
' occurance de sFind trouvée dans
' le texte
'**************************************
Public Function LastIndexOf _
( _
ByRef sFind As String, _
Optional ByRef lStart As Long = 1, _
Optional ByRef cm As VbCompareMethod = vbBinaryCompare _
) As Long
IndexOf = InStrRev(Text, sFind, lStart, cm)
End Function
'***
Avatar
Zoury
juste un petit oubli dans le deuxième exemple.... :O)

Comme tu peux le voir le traitement est assez long.. Je me dis que tu
pourrais à la place de concatener la nouvelle valeur à chaque, faire une
Replace() de vbNewLine par VbNewLine & LINE_HEADER.



Il faut évidemment remplace la première ligne explicitement étant donnée
qu'elle ne commence *pas* par vbNewLine.. donc

Private Sub GenerateNewFile(ByRef sSrcFilePath As String, ByRef
sDestFilePath As String)

Const LINE_HEADER As String = "REMACNT,HJGGHGG="
Dim f As CFile

Set f = New CFile
Call f.OpenFile(sSrcFilePath)



' Il faut ajouté cette ligne ici..
Call f.Lines(1) = LINE_HEADER & f.Lines(1)

Call f.ReplaceText(vbNewLine, vbNewLine & LINE_HEADER)
Call f.SaveFileAs(sDestFilePath)

End Sub




--
Cordialement
Yanick Lefebvre - MVP pour Visual Basic
http://faq.vb.free.fr/?rubrique=0 - http://www.mvps.org/vbnet/
http://www.mentalis.org/agnet/apiguide.shtml - http://www.mztools.com/

Merci de poster les réponses au groupe afin d'en faire profiter à tous
Avatar
RAHOU
A chaque fois que je vois ce genre de codes sources je em
dis qu'il me reste un long chemin à parcourir avnt
d'atteindre un certain niveau.
ET pourtant, je me disais que VB c té acquis.
Une fois de plsu merci.

Merci, mais je me demande encore comment faire pour
configurer le newsgroups sous Outlook Express avec une
connexion vers internet avec un proxy HTTP qui nécessite
une authentification par login et password.

Je vais tester ton code et je t'en donnerai des nouvelles.

Ciao

PS: je suis de Dakar, Sénégal

-----Message d'origine-----
juste un petit oubli dans le deuxième exemple.... :O)

Comme tu peux le voir le traitement est assez long.. Je




me dis que tu
pourrais à la place de concatener la nouvelle valeur à




chaque, faire une
Replace() de vbNewLine par VbNewLine & LINE_HEADER.



Il faut évidemment remplace la première ligne


explicitement étant donnée
qu'elle ne commence *pas* par vbNewLine.. donc

Private Sub GenerateNewFile(ByRef sSrcFilePath As




String, ByRef
sDestFilePath As String)

Const LINE_HEADER As String = "REMACNT,HJGGHGG="
Dim f As CFile

Set f = New CFile
Call f.OpenFile(sSrcFilePath)



' Il faut ajouté cette ligne ici..
Call f.Lines(1) = LINE_HEADER & f.Lines(1)

Call f.ReplaceText(vbNewLine, vbNewLine &




LINE_HEADER)
Call f.SaveFileAs(sDestFilePath)

End Sub




--
Cordialement
Yanick Lefebvre - MVP pour Visual Basic
http://faq.vb.free.fr/?rubrique=0 -


http://www.mvps.org/vbnet/
http://www.mentalis.org/agnet/apiguide.shtml -


http://www.mztools.com/

Merci de poster les réponses au groupe afin d'en faire


profiter à tous


.



Avatar
RAHOU
C'est super, cela n'a même pas fait une seconde, pour
25000 lignes, vraiment impressionnant

Mais il ya une petite erreur dans la procédure suivante:


Private Sub GenerateNewFile(ByRef sSrcFilePath As String,
ByRef sDestFilePath As String)
Const LINE_HEADER As String = "REMACNT,HJGGHGG="
Dim f As CFile
Set f = New CFile
Call f.OpenFile(sSrcFilePath)

' Il faut ajouté cette ligne ici..
'Call f.Lines(1)=LINE_HEADER & f.Lines(1)
'A la palce de Call f.Lines(1)=LINE_HEADER &
f.Lines(1)
'Mettre
f.Lines(1)=LINE_HEADER & f.Lines(1)

Call f.ReplaceText(vbNewLine, vbNewLine & LINE_HEADER)
Call f.SaveFileAs(sDestFilePath)

End Sub

Mais une fois de plus merci pour l'aide.

A bientôt



-----Message d'origine-----
juste un petit oubli dans le deuxième exemple.... :O)

Comme tu peux le voir le traitement est assez long.. Je




me dis que tu
pourrais à la place de concatener la nouvelle valeur à




chaque, faire une
Replace() de vbNewLine par VbNewLine & LINE_HEADER.



Il faut évidemment remplace la première ligne


explicitement étant donnée
qu'elle ne commence *pas* par vbNewLine.. donc

Private Sub GenerateNewFile(ByRef sSrcFilePath As




String, ByRef
sDestFilePath As String)

Const LINE_HEADER As String = "REMACNT,HJGGHGG="
Dim f As CFile

Set f = New CFile
Call f.OpenFile(sSrcFilePath)



' Il faut ajouté cette ligne ici..
Call f.Lines(1) = LINE_HEADER & f.Lines(1)

Call f.ReplaceText(vbNewLine, vbNewLine &




LINE_HEADER)
Call f.SaveFileAs(sDestFilePath)

End Sub




--
Cordialement
Yanick Lefebvre - MVP pour Visual Basic
http://faq.vb.free.fr/?rubrique=0 -


http://www.mvps.org/vbnet/
http://www.mentalis.org/agnet/apiguide.shtml -


http://www.mztools.com/

Merci de poster les réponses au groupe afin d'en faire


profiter à tous


.



Avatar
Zoury
'A la palce de Call f.Lines(1)=LINE_HEADER &
f.Lines(1)
'Mettre
f.Lines(1)=LINE_HEADER & f.Lines(1)

hehe! bien vu! :O)
si tu as des questions sur le code n'hésite pas ;O)

--
Cordialement
Yanick Lefebvre - MVP pour Visual Basic
http://faq.vb.free.fr/?rubrique=0 - http://www.mvps.org/vbnet/
http://www.mentalis.org/agnet/apiguide.shtml - http://www.mztools.com/

Merci de poster les réponses au groupe afin d'en faire profiter à tous