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