1,485
社区成员
发帖
与我相关
我的任务
分享
'Unicode(Little Endian)文本文件转换为UTF-8文本文件
Public Function ULEToUTF8(ByVal InputULEfile As String, ByVal OutputUTF8file As String) As Boolean
Dim Filebyte() As Byte ', Fbyte() As Byte
Dim sAnsi As String, retLen As Long, FileNumber As Long
Dim sUTF8Buffer() As Byte, S As String
On Error Resume Next
'打开Unicode(Little Endian)文本文件InputULEfile
FileNumber = FreeFile
If Dir(InputULEfile) = "" Then ULEToUTF8 = False: Exit Function
Open InputULEfile For Binary As #FileNumber
ReDim Filebyte(LOF(FileNumber) - 1)
Get #FileNumber, , Filebyte
Close #FileNumber
If Hex$(Filebyte(0)) = "FF" And Hex$(Filebyte(1)) = "FE" Then
S = Filebyte
Else
MsgBox (InputULEfile & " 为非Unicode(Little Endian)编码格式文件!")
ULEToUTF8 = False: Exit Function
End If
sAnsi = StrConv(S, vbNarrow) '转换为VB6可显示的字符串
Mid$(sAnsi, 1, 1) = " ": sAnsi = Trim(sAnsi)
retLen = WideCharToMultiByte(CP_UTF8, 0, StrPtr(sAnsi), -1, vbNullString, 0, vbNullString, 0) '取得转换后需要的空间大小retLen
If retLen > 0 Then
ReDim sUTF8Buffer(retLen - 1) ' = String$(retLen, vbNullChar) '设置缓冲区大小
retLen = WideCharToMultiByte(CP_UTF8, 0, StrPtr(sAnsi), -1, sUTF8Buffer(0), retLen, vbNullString, 0) '开始转换
Else
ULEToUTF8 = False: Exit Function
End If
'保存为UTF-8文本文件OutputUTF8file
If retLen > 0 Then
ReDim Preserve sUTF8Buffer(retLen - 1)
S = StrConv(sUTF8Buffer, vbUnicode)
FileNumber = FreeFile
If Dir(OutputUTF8file) <> "" Then Kill (OutputUTF8file)
Open OutputUTF8file For Binary As #FileNumber
Put #FileNumber, , &HBFBBEF '加上UTF-8文件头BOM标志EFBBBF
Put #FileNumber, 4, S '保存文件内容
Close #FileNumber
ULEToUTF8 = True
Else
ULEToUTF8 = False: Exit Function
End If
End Function
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 Long
Private 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 =65001
const cpGB2312 = 936
const cpGB18030=54936
const cpUTF7 =65000
Function 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), bufSize
End Function
Function 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 = arr
End Function
Private Sub Command1_Click()
MsgBox MultiByteToUTF16(UTF16ToMultiByte("ab中,c", cpUTF8), cpUTF8)
End Sub