关于VB修改文本文件内容后出现乱码的问题。

Question

Private Sub Command2_Click()
Open "D:\sheji1\script1变量修改.txt" For Input As #1
 Do While Not EOF(1)
  Line Input #1, strtxt
  If InStr(strtxt, "磁芯外半径") Then
   strtxt = Replace(strtxt, "磁芯外半径", Text1.Text)
  End If
  s = s & strtxt & vbCrLf
 Loop
Close #1
Open "D:\sheji1\script1变量修改2.txt" For Output As #1
 Print #1, s;
Close #1
End Sub
代码如上，用输入于TEXT1中的数值替换了文本文件中的“磁芯外半径“。
但是打开写入后的文本文件发现中文地方全部乱码了，但是如果把磁芯外半径这个变量改为字符例如cxwbj时，就可以替换成功，这是为什么呢？

Answer 1

这是因为文本文件的编码不是Unicode

Answer 2

对啊，Open For Output这种方式打开，再Print输出的文本，应该是使用本windows系统的默认字符编码（在简体中文WINDOWS中一般是GBK)输出的，看来你这个已经存在的“script1变量修改2.txt”不是用的这个默认编码。

Answer 3

给你一个参考书的例子，你自己琢磨一下修改成自己的即可。Function ReadBinaryText(ByVal bFile As String) As String
    ''读文本文件
    On Error GoTo 100
    Dim iNum As Integer, v As Variant
    iNum = FreeFile()
    Open bFile For Binary As #iNum
    Get #iNum, 1, v
    Close #iNum
    ReadBinaryText = v
    Exit Function
100:
    MsgBox Err.Description
End Function
Sub SaveTextFile(ByVal bFile As String, ByVal bValue As String)
    ''写文本文件
    On Error GoTo 100
    Dim iNum As Integer, v As Variant, Byt() As Byte
    iNum = FreeFile()
    Open bFile For Binary As #iNum
    Byt = bValue
    v = Byt
    Put #iNum, 1, v
    Close #iNum
    Exit Sub
100:
    MsgBox Err.Description
End Sub
写文件时，如果新内容比原来的短，原来文件多余的部分并不会被删除，虽然不影响读取，但是会影响文件的体积，
所以，如果介意这点，写文件之前如果存在则删除.......

Answer 4

我有个地方说错了，VB它保存的文本文件都是ANSI格式的，我要修改的VBS文件是UTF-8格式的，文件里头有中文字符，就是想要在修改后，保存的原VBS文件不要出现乱码，仍然是UTF-8文件。太愁了，在网上找方法找了好几天，有可以读取的相关例子，但是修改老是结合不起来。有没有高手再指点下？最好能帮我修改一下。

Answer 5

试试：
strtxt = Replace(strtxt, "磁芯外半径", StrConv(Text1.Text, vbFromUnicode))

Answer 6

既然是UTF-8格式的“文本”内容，你还要看看它的前面是否带有3字节的标志啊。
要以UTF-8格式输出，VB6中要用Binary模式写文件。如果有文件头标志，得自己处理加上。
要替换内容，很可能会造成文件长度的变化，长度增加一般没事，但如果减少，那文件尾部会出现多余的东西。
因此一般输出到新文件中。

Answer 7

给你一个模块：
Option Explicit' API declarations.
Private Const OFS_MAXPATHNAME As Long = 128
'Private Const OF_WRITE       As Long = &H1
Private Const OF_READ         As Long = &H0
Private Const OF_CREATE       As Long = &H1000Private Const ForReading      As Long = 1Public Enum ForWriteEnum
   ForWriting = 2
   ForAppending = 8
End EnumPublic Enum TristateEnum
   TristateTrue = -1        'Opens the file as Unicode
   TristateFalse = 0        'Opens the file as ASCII
   TristateUseDefault = -2  'Use default system setting
End EnumPrivate Type OVERLAPPED
   Internal             As Long
   InternalHigh         As Long
   offset               As Long
   OffsetHigh           As Long
   hEvent               As Long
End TypePrivate Type OFSTRUCT
   cBytes               As Byte
   fFixedDisk           As Byte
   nErrCode             As Integer
   Reserved1            As Integer
   Reserved2            As Integer
   szPathName           As String * OFS_MAXPATHNAME
End TypePrivate Declare Function OpenFile Lib "kernel32" (ByVal lpFileName As String, lpReOpenBuff As OFSTRUCT, ByVal wStyle As Long) As Long
Private Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, lpOverlapped As OVERLAPPED) As Long
Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, lpOverlapped As OVERLAPPED) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As LongPublic Function AppPath() As String
   AppPath = App.Path
   If Right$(AppPath, 1) <> "\" Then
      AppPath = AppPath & "\"
   End If
End FunctionPublic Function UnicodeFile_Read_FSO( _
   ByVal sFileName As String, _
   Optional ByVal TriState As TristateEnum = TristateTrue) As String
   
   Dim objFSO           As Object
   Dim objStream        As Object   Set objFSO = CreateObject("Scripting.FileSystemObject")
   If (Not objFSO Is Nothing) Then
      Set objStream = objFSO.OpenTextFile( _
         sFileName, ForReading, False, TriState)
      If (Not objStream Is Nothing) Then
         With objStream
            UnicodeFile_Read_FSO = .ReadAll
            .Close
         End With
         Set objStream = Nothing
      End If
      Set objFSO = Nothing
   End If
End FunctionPublic Sub UnicodeFile_Write_FSO( _
   ByVal sFileName As String, _
   ByVal sText As String, _
   Optional ByVal ForWrite As ForWriteEnum = ForWriting, _
   Optional ByVal TriState As TristateEnum = TristateTrue)   Dim objFSO           As Object
   Dim objStream        As Object   Set objFSO = CreateObject("Scripting.FileSystemObject")
   If (Not objFSO Is Nothing) Then
      Set objStream = objFSO.OpenTextFile( _
         sFileName, ForWrite, True, TriState)
         
      If (Not objStream Is Nothing) Then
         With objStream
            .Write sText
            .Close
         End With
         Set objStream = Nothing
      End If
      Set objFSO = Nothing
   End If
End SubPublic Function UnicodeFile_Read_VB(ByVal sFileName As String, _
   Optional ByVal bRemoveBOM As Boolean) As String
   Dim FF   As Long
   Dim b()  As Byte
   Dim s As String
   Const uBOM As String = "?"
   On Error Resume Next
   FF = FreeFile
   Open sFileName For Binary Access Read As FF
   ReDim b(LOF(FF))
   Get FF, , b
   Close FF
   s = b
   If bRemoveBOM Then
      If InStr(s, uBOM) = 1 Then
         s = Replace$(s, uBOM, "")
      End If
   End If
   UnicodeFile_Read_VB = s
End FunctionPublic Sub UnicodeFile_Write_VB(ByVal sFileName As String, _
   ByVal sText As String, _
   Optional ByVal bInsertBOM As Boolean)
   Dim FF   As Long
   Dim b()  As Byte   On Error Resume Next
   Kill sFileName
   On Error GoTo 0
   FF = FreeFile
   Open sFileName For Binary Access Write As #FF
   If bInsertBOM Then
      ReDim b(1)
      b(0) = &HFF
      b(1) = &HFE
      Put #FF, , b
      Erase b
   End If
   b = sText
   Put #FF, , b
   Close #FF
End SubPublic Function UnicodeFile_Read_API(ByVal sFileName As String) As String
   Dim lpFileInfo       As OFSTRUCT
   Dim lpOverlapped     As OVERLAPPED
   Dim szPathName       As String * OFS_MAXPATHNAME
   Dim hFile            As Long
   Dim sText            As String
   Dim lLength          As Long
   Dim lLengthRet       As Long   szPathName = sFileName   With lpFileInfo
      .cBytes = Len(lpFileInfo)
      .fFixedDisk = 1
      .szPathName = szPathName
   End With   lLength = FileLen(sFileName)
   sText = String(lLength, " ")   hFile = OpenFile(sFileName, lpFileInfo, OF_READ)
   If (hFile) Then
      ReadFile hFile, ByVal StrPtr(sText), lLength, lLengthRet, lpOverlapped
      UnicodeFile_Read_API = MidB(sText, 1, lLength)
      CloseHandle (hFile)
   End If
End FunctionPublic Function UnicodeFile_Write_API(ByVal sFileName As String, ByVal sText As String) As Boolean
   Dim lpFileInfo       As OFSTRUCT
   Dim lpOverlapped     As OVERLAPPED
   Dim szPathName       As String * OFS_MAXPATHNAME
   Dim hFile            As Long
   Dim lResult          As Long
   Dim lLengthRet       As Long   szPathName = sFileName   With lpFileInfo
      .cBytes = Len(lpFileInfo)
      .fFixedDisk = 1
      .szPathName = szPathName
   End With   hFile = OpenFile(sFileName, lpFileInfo, OF_CREATE)
   If (hFile) Then
      lResult = WriteFile(hFile, ByVal StrPtr(sText), LenB(sText), lLengthRet, lpOverlapped)
      UnicodeFile_Write_API = lResult <> 0
      CloseHandle (hFile)
   End If
End Function

Answer 8

对电脑而言没有乱码，只有二进制字节；对人脑才有乱码。啊 GBK:0xB0 0xA1,Unicode-16 LE:0x4A 0x55,Unicode-16 BE:0x55 0x4A,UTF-8:0xE5 0x95 0x8A推荐使用WinHex软件查看硬盘或文件或内存中的原始字节内容。

Answer 9

VB6要造个轮子才能支持UTF8