Option Explicit
'--------------------------------------------------------
'[Class name]: clsTxtFile
'[Description]: Read Or Write Txt File
'--------------------------------------------------------
Private mFileNumber As Integer
Private mIsOpen As Boolean
Private mEncoding As String
Private mStream As Object
Private mFilePath As String
'--------------------------------------------------------
'[Function name]: OpenFile
'[Description]: Open file
'[Parameter]: (1) file path (2)encoding (eg:utf-8)
'--------------------------------------------------------
Public Sub OpenFile(path As String, encoding As String)
mEncoding = encoding
mFilePath = path
If mEncoding <> "" Then
Set mStream = CreateObject("Adodb.Stream")
With mStream
.Type = 2 '1:binary 2:text
.Mode = 3 '1:Read 2:Write 3:ReadWrite
.Open
.LoadFromFile path
.Charset = encoding
.Position = 2 'encoding's position
End With
Else
mFileNumber = FreeFile
Open path For Input As #mFileNumber
End If
mIsOpen = True
End Sub
'--------------------------------------------------------
'[Function name]: CreateFile
'[Description]: Create file
'[Parameter]: (1) file path (2)encoding
'--------------------------------------------------------
Public Sub CreateFile(path As String, encoding As String)
mEncoding = encoding
mFilePath = path
CreateFileCore (path)
If mEncoding <> "" Then
Set mStream = CreateObject("Adodb.Stream")
With mStream
.Type = 2 '1:binary 2:text
.Mode = 3 '1:Read 2:Write 3:ReadWrite
.Open
.Charset = encoding
End With
Else
mFileNumber = FreeFile
Open path For Binary Access Write As #mFileNumber
End If
mIsOpen = True
End Sub
'--------------------------------------------------------
'[Function name]: CreateFileCore
'[Description]: cretae file
'[Parameter]: (1) file path
'--------------------------------------------------------
Private Sub CreateFileCore(path As String)
Dim fso As Object
Dim folderName As String
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FileExists(path) Then
'file exists,delete
fso.DeleteFile path, True
Else
'file not exists,create
folderName = fso.GetParentFolderName(path)
If Not fso.FolderExists(folderName) Then
fso.CreateFolder (folderName)
End If
End If
fso.CreateTextFile path, True
End Sub
'--------------------------------------------------------
'[Function name]: ReadLine
'[Description]: read a line
'[Return Value]: line string
'--------------------------------------------------------
Public Function ReadLine() As String
Dim strLine As String
If mEncoding <> "" Then
strLine = mStream.ReadText(-2) '-1:adReadAll -2:adReadLine
Else
Line Input #mFileNumber, strLine
End If
ReadLine = strLine
End Function
'--------------------------------------------------------
'[Function name]: WriteLine
'[Description]: Write line
'[Parameter]: (1) line
'--------------------------------------------------------
Public Sub WriteLine(strLine As String)
If mEncoding <> "" Then
Call mStream.WriteText(strLine, 1) '0:adWriteChar 1:adWriteLine
Else
strLine = strLine & vbCrLf
Put #mFileNumber, , strLine
End If
End Sub
'--------------------------------------------------------
'[Function name]: IsEndOfFile
'[Description]: if is the end of the file
'[Return Value]: true:end of the file false:not end of the file
'--------------------------------------------------------
Public Function IsEndOfFile() As Boolean
If mEncoding <> "" Then
IsEndOfFile = mStream.EOS
Else
IsEndOfFile = EOF(mFileNumber)
End If
End Function
'--------------------------------------------------------
'[Function name]: CloseFile
'[Description]: close file
'--------------------------------------------------------
Public Sub CloseFile()
If mIsOpen Then
If mEncoding <> "" Then
mStream.SaveToFile mFilePath, 2 'adSaveCreateNotExist =1 adSaveCreateOverWrite = 2
mStream.Close
Set mStream = Nothing
Else
Close mFileNumber
End If
End If
End Sub