如何编程实现Unicode编码的文件的字符串替换?
我用下面的代码实现将某个文本文件中的字符串Str1替换成Str2,但是现在碰到了这样的问题:
替换某些.aspx文件时替换不成功,还把文件变成了乱码,我认为这是因为.aspx是Unicode编码的原因,但是如何解决这个问题呢?
Dim Str1 As String
Dim Str2 As String
Dim I As Long
Dim StrTmpFile As String
Dim iCompare As Integer
iCompare = vbBinaryCompare
StrTmpFile = App.Path & "\" & "XReplace.tmp"
Open FileName For Input As #1
Open StrTmpFile For Output As #2
While Not EOF(1)
Line Input #1, Str1
Str2 = Str1
For I = 1 To ListView1.ListItems.Count
Str2 = Replace(Str2, ListView1.ListItems(I).Text, ListView1.ListItems(I).SubItems(1), , , iCompare)
Next
Print #2, Str2
Wend
Close #1
Close #2
Kill FileName
Name StrTmpFile As FileName
[解决办法]
Private Declare Function MultiByteToWideChar Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByRef lpMultiByteStr As Any, ByVal cchMultiByte As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As LongPrivate Declare Function WideCharToMultiByte Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, ByRef lpMultiByteStr As Any, ByVal cchMultiByte As Long, ByVal lpDefaultChar As Long, ByVal lpUsedDefaultChar As Long) As Long'常用的代码页:const cpUTF8 =65001const cpGB2312 = 936const cpGB18030=54936const cpUTF7 =65000Function MultiByteToUTF16(UTF8() As Byte, CodePage As Long) As String Dim bufSize As Long bufSize = MultiByteToWideChar(CodePage, 0&, UTF8(0), UBound(UTF8) + 1, 0, 0) MultiByteToUTF16 = Space(bufSize) MultiByteToWideChar CodePage, 0&, UTF8(0), UBound(UTF8) + 1, StrPtr(MultiByteToUTF16), bufSizeEnd FunctionFunction UTF16ToMultiByte(UTF16 As String, CodePage As Long) As Byte() Dim bufSize As Long Dim arr() As Byte bufSize = WideCharToMultiByte(CodePage, 0&, StrPtr(UTF16), Len(UTF16), 0, 0, 0, 0) ReDim arr(bufSize - 1) WideCharToMultiByte CodePage, 0&, StrPtr(UTF16), Len(UTF16), arr(0), bufSize, 0, 0 UTF16ToMultiByte = arrEnd FunctionPrivate Sub Command1_Click() MsgBox MultiByteToUTF16(UTF16ToMultiByte("ab中,c", cpUTF8), cpUTF8)End Sub
[解决办法]
Function GetUnicodeFileText(PathName As String) As String Dim hFile As Integer Dim Bytes() As Byte hFile = FreeFile() Open "C:\1.aspx" For Binary Access Read Lock Write As #hFile ReDim Bytes(LOF(hFile) - 1) As Byte Get #hFile, 1, Bytes Close #hFile GetUnicodeFileText = BytesEnd Function
[解决办法]
Str2 = Replace(Str2, StrConv(ListView1.ListItems(I).Text, vbUnicode), StrConv(ListView1.ListItems(I).SubItems(1), vbUnicode), , , iCompare)
[解决办法]
Line Input不支持读unicode文档的,建议用2楼的代码。下面是我使用的代码,考虑了文件头部的签名:
使用示例: If (FileToBytes(strFileName, bytFileContent)) Then fSdsjDoc.Content.Text = BytesToString(bytFileContent) End If'---------------------------------------------------' 过程名 : FileToBytes' 时间 : 2010-3-30 19:51' 作者 : 杨过.网狐.cn' 功能 : 返回值True成功'---------------------------------------------------'Public Function FileToBytes(ByVal strFileName As String, ByRef bytOutPut() As Byte) As Boolean Dim lng_SourceFile As Long Dim lng_FileLength As Long On Error GoTo Err: lng_SourceFile = FreeFile Open strFileName For Binary As lng_SourceFile lng_FileLength = LOF(lng_SourceFile) ReDim bytOutPut(lng_FileLength - 1) Get lng_SourceFile, , bytOutPut Close #lng_SourceFile FileToBytes = True Exit FunctionErr: FileToBytes = FalseEnd FunctionPublic Function BytesToString(ByRef bytFile() As Byte) As String If (UBound(bytFile) - LBound(bytFile) > 0) Then If ((bytFile(0) = &HFF) And (bytFile(1) = &HFE)) Then BytesToString = bytFile BytesToString = Mid$(BytesToString, 2) Else BytesToString = StrConv(bytFile, vbUnicode) End If End IfEnd Function
[解决办法]
使用万能的字节方式打开文件,然后转换或者直接替换随你。。。
推荐使用ReadFile这个API,又快又标准。。。
[解决办法]
我也支持使用二进制方式打开
[解决办法]
用API,不要用VB自带的Open/Get/Put和Strconv.
你确认.aspx是Unicode(utf16BE/LE) or UTF8 or UTF7 or GB2312???
Private Declare Function CreateFileW Lib "kernel32" (ByVal lpFileName As Long, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function lstrlenW Lib "kernel32" (ByVal psString As Any) As Long
Private Declare Function LCMapStringW Lib "kernel32" (ByVal Locale As Long, ByVal dwMapFlags As Long, ByVal lpSrcStr As Long, ByVal cchSrc As Long, ByVal lpDestStr As Long, ByVal cchDest As Long) As Long
Private Declare Function CreateFile Lib "KERNEL32.dll" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByRef lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function LCMapString Lib "KERNEL32.dll" Alias "LCMapStringA" (ByVal Locale As Long, ByVal dwMapFlags As Long, ByVal lpSrcStr As String, ByVal cchSrc As Long, ByVal lpDestStr As String, ByVal cchDest As Long) As Long
Private Declare Function lstrlen Lib "KERNEL32.dll" Alias "lstrlenA" (ByVal lpString As String) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, ByVal lpOverlapped As Long) As Long
Private Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, ByVal lpOverlapped As Long) As Long
Private Declare Function GetFileSize Lib "kernel32" (ByVal hFile As Long, lpFileSizeHigh As Long) As Long
Private Declare Function SetFilePointer Lib "kernel32" (ByVal hFile As Long, ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long