VB打开/保存任意编码格式文本文件
VB打开/保存任意编码格式文本文件/
刚吃饭见论坛有人使用FSO对象保存UTF-8格式的文本文件。。顺便写了一个类。。属于俺们VB的FSO类
'--------------------
'类模块:FSO
'SielnceNet@qq.Com
'时间:2008-7-4 15:57:53
'说明:打开/保存任意编码格式的文本文件
'--------------------
Option Explicit
Private FileBody As String '文件内容
Private ErrInfo As String
Private Coding As String
'Dim ADO_Stream As Stream '使用此项需引用ADO对象
Dim ADO_Stream As Object
'文件打开成功后使用此方法获取文件内容
Public Function GetFileText() As String
GetFileText = FileBody
End Function
'操作失败时。。使用此方法获取错误信息
Public Function GetErrorInfo() As String
GetErrorInfo = ErrInfo
End Function
'打开文件
Public Function OpenFile(FileName As String) As Boolean
'FileName:需要打开的文件名
If ADO_Stream Is Nothing Then Exit Function
Err.Number = 0
On Error GoTo ferr
With ADO_Stream
.Type = 1
.Mode = 3
.Open
.LoadFromFile FileName
.Position = 0
.Type = 2
.Charset = IIf(Coding = "", "gb2312", Coding)
FileBody = .ReadText
.Close
End With
OpenFile = True
Exit Function
ferr:
ErrInfo = FileName & "打开失败！错误信息:" & Err.Description
Debug.Print ErrInfo
Err.Number = 0
End Function
'保存文件
Public Function SaveFile(FileName As String, strFileBody As String) As Boolean
'FileName:文件保存路径名字
'strFileBody:需要保存的文件内容
If ADO_Stream Is Nothing Then Exit Function
Err.Number = 0
On Error GoTo ferr
With ADO_Stream
.Type = 2
.Mode = 3
.Charset = IIf(Coding = "", "gb2312", Coding)
.Open
.WriteText strFileBody
.SaveToFile FileName, 2
End With
SaveFile = True
Exit Function
ferr:
ErrInfo = FileName & "保存失败！错误信息:" & Err.Description
Debug.Print ErrInfo
Err.Number = 0
End Function
Private Sub Class_Initialize()
Err.Number = 0
On Error GoTo ferr
'Set ADO_Stream = New Stream '使用此项需引用ADO对象
Set ADO_Stream = CreateObject("ADODB.Stream")
Exit Sub
ferr:
Set ADO_Stream = Nothing
ErrInfo = "ADODB.Stream对象创建失败！"
Debug.Print ErrInfo
Err.Number = 0
End Sub
'设置文件编码
'缺省编码为gb2312
Public Property Let SetCoding(ByVal vNewValue As String)
Coding = vNewValue
End Property
'Form代码
'使用方法。。添加两个按钮。。一个文本框。。使用默认名字
Option Explicit
Const F = "E:/System Files/桌面/偶偶.txt" '需要打开的文件路径
Const F2 = "E:/System Files/桌面/偶偶2.txt" '保存的文件路径
Dim FSO1 As New FSO
Private Sub Command1_Click()
If FSO1.OpenFile(F) Then
Text1.Text = FSO1.GetFileText
Else
MsgBox FSO1.GetErrorInfo
End If
End Sub
Private Sub Command2_Click()
If FSO1.SaveFile(F2, Text1.Text) Then
MsgBox "文件保存成功！"
Else
MsgBox FSO1.GetErrorInfo
End If
End Sub
Private Sub Form_Load()
FSO1.SetCoding = "UTF-8"
End Sub
