Classe CFile

> Merci de t'être penché sur la question. Finalement, j'ai l'impression
que ça complique les choses.
As-tu testé ? Car chez moi, ça m'efface l'intégralité des lignes. J'ai
un fichier vide.

oui... mais lit la suite

Dans la classe, j'ai rajouté
dim m_lLastIndex As Long car c'était pas défini.

c'est mon erreur.. m_lLastIndex est en fait m_lIndex qui a changé de nom..
:O/

prend cette classe-ci (qui est officiellement la dernière version)
'***
' CFile Class
Option Explicit

Private m_sLignes() As String ' lines
Private Const BUFFER_SIZE As Long = 500 ' buffer size
Private m_lLastIndex As Long ' current last index
Private m_sFileName As String ' filename

'**************************************
' Returns the corresponding line
'**************************************
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

'**************************************
' Modifies the corresponding line
'**************************************
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

'**************************************
' Add a line
'**************************************
Public Function AppendLine(ByRef sLine As String) As String

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

End Function

'**************************************
' Append text to the end of the file
'**************************************
Public Function Append(ByRef sText As String) As String

Dim s() As String
Dim i As Long

s = Split(sText, vbNewLine)

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

End Function

'**************************************
' Returns the current file text
'**************************************
Public Property Get Text() As String
Dim s() As String
s = m_sLignes
ReDim Preserve s(m_lLastIndex) As String
Text = Join(s, vbNewLine)
End Property

'**************************************
' Returns the number of lines
'**************************************
Public Property Get LineCount() As Long
LineCount = m_lLastIndex + 1
End Property

'**************************************
' Read the file and fill our object
' with it
'**************************************
Public Function OpenFile(ByRef sFile As String) As String

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

End Function

'*****************************
' Return the file content
'*****************************
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
Call 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

'**************************************
' Save the file with another name
'**************************************
Public Sub SaveFileAs(ByRef sFile As String)

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

m_sFileName = sFile

If FileExists(sFile) Then
Call Kill(sFile)
End If

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

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

End Sub

'**************************************
' Overwrite the existing file
'**************************************
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_sFileName) = 0 Then
Exit Sub
End If

' Supprimer le fichier
Call Kill(m_sFileName)

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

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

End Sub

'**************************************
' Initialize our object
'**************************************
Private Sub Class_Initialize()
m_sLignes = Split("", " ")
m_lLastIndex = -1
End Sub

'**************************************
' Returns True if the file exists
'**************************************
Private Function FileExists(ByRef sFile As String) As Boolean
On Error Resume Next
FileExists = ((GetAttr(sFile) And vbDirectory) = 0)
End Function

'**************************************
' Append the specified file content
' to our file
'**************************************
Public Function AppendFile(ByRef sFile As String) As String

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

End Function

'**************************************
' Replace the sFind text for the
' sReplace one in the file
'**************************************
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_lLastIndex = UBound(m_sLignes)

End Sub

'**************************************
' Returns the first position
' of sFind in the file
'**************************************
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

'**************************************
' Returns the last position
' of sFind in the file
'**************************************
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

'**************************************
' Removes the specified line
'**************************************
Public Sub RemoveLine(ByRef lIndex As Long)

Dim i As Long
Dim lCurIndex As Long
Dim s() As String
ReDim s(UBound(m_sLignes)) As String

For i = 0 To m_lLastIndex
If (i <> (lIndex - 1)) Then
s(lCurIndex) = m_sLignes(i)
lCurIndex = lCurIndex + 1
End If
Next i

m_lLastIndex = m_lLastIndex - 1
m_sLignes = s

End Sub

'***************************************
' Returns the actual file name
'***************************************
Public Property Get FileName() As String
FileName = m_sFileName
End Property
'***

Salut Yanick

Merci de t'être penché sur la question. Finalement, j'ai l'impression
que ça complique les choses.
As-tu testé ? Car chez moi, ça m'efface l'intégralité des lignes. J'ai
un fichier vide.

Dans la classe, j'ai rajouté
dim m_lLastIndex As Long car c'était pas défini.

Ne perds pas ton temps avec ça, je vais aller au plus simple.
Encore merci

Franck

Zoury wrote:

Oui c'est possible.. ça fera le même travail que ma première
solution.. :OP

ajoute cette fonction à la classe :
'***
'**************************************
' Removes the specified line
'**************************************
Public Sub RemoveLine(ByRef lIndex As Long)

Dim i As Long
Dim lCurIndex As Long
Dim s() As String
ReDim s(UBound(m_sLignes)) As String

For i = 0 To m_lLastIndex
If (i <> (lIndex - 1)) Then
s(lCurIndex) = m_sLignes(i)
lCurIndex = lCurIndex + 1
End If
Next i

m_lLastIndex = m_lLastIndex - 1
m_sLignes = s

End Sub
'***

tu peux l'utiliser comme ceci :
'***
Option Explicit

Private Sub Main()

Dim i As Long
Dim f As CFile
Set f = New CFile

Call f.OpenFile("c:test.txt")

' On doit faire une boucle inversé étant donnée
' que le contenu de f peut changer à chaque tour
For i = f.LineCount To 1 Step -1
If (f.Lines(i) Like "*blabla" Or f.Lines(i) Like
"*blablabla") Then Call f.RemoveLine(i)
End If
Next i

Call f.SaveFile

End Sub
'***

Génial ! Ca marche nickel ! Je pense que cette fois-ci, je ne devrais
plus avoir de problème en transposant cela dans mon appli.
Je garde cette classe bien au chaud. Je suis sûr que ça me resservira un
jour ou l'autre.
Merci pour tout !

Franck


Zoury wrote:

Merci de t'être penché sur la question. Finalement, j'ai l'impression
que ça complique les choses.
As-tu testé ? Car chez moi, ça m'efface l'intégralité des lignes.
J'ai un fichier vide.

oui... mais lit la suite

Dans la classe, j'ai rajouté
dim m_lLastIndex As Long car c'était pas défini.

c'est mon erreur.. m_lLastIndex est en fait m_lIndex qui a changé de
nom..

prend cette classe-ci (qui est officiellement la dernière version)

[voir msg précédent]