VB 文件編碼互換模塊(支持 Ansi,UTF-8,Unicode(little endian),Unicode big endian)
減小字體
增大字體
作者:佚名 來源:本站整理 發(fā)布時(shí)間:2011-03-08 17:55:56
VB 文件編碼互換模塊,,支持對Ansi,UTF-8,Unicode(little endian),Unicode big endian編碼之間進(jìn)行轉(zhuǎn)換,。 - VBScript code復(fù)制代碼
Option Explicit
Private Declare Function MultiByteToWideChar Lib "kernel32.dll" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpMultiByteStr As String, ByVal cchMultiByte As Long, ByVal lpWideCharStr As String, ByVal cchWideChar As Long) As Long
Private Declare Function WideCharToMultiByte Lib "kernel32.dll" (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 String, ByVal lpUsedDefaultChar As Long) As Long
Private Const CP_ACP As Long = 0
Private Const CP_UTF8 As Long = 65001
'Ansi純文本文件轉(zhuǎn)換為Unicode(Little Endian)文本文件
Private Function AnsiToULE(ByVal Inputansifile As String, ByVal OutputULEfile As String) As Boolean
Dim Filebyte() As Byte, sAnsi As String, retLen As Long, FileNumber As Long
Dim sUnicodeBuffer As String
On Error Resume Next
'打開Ansi純文本文件Inputansifile
FileNumber = FreeFile
If Dir(Inputansifile) = "" Then AnsiToULE = False: Exit Function
Open Inputansifile For Binary As #FileNumber
ReDim Filebyte(LOF(FileNumber) - 1)
Get #FileNumber, , Filebyte
Close #FileNumber
sAnsi = StrConv(Filebyte, vbUnicode) '轉(zhuǎn)換為VB6可顯示的字符串
retLen = MultiByteToWideChar(CP_ACP, 0, sAnsi, LenB(sAnsi), vbNullChar, 0) '取得轉(zhuǎn)換后需要的空間大小retLen
sUnicodeBuffer = String$(LenB(sAnsi), vbNullChar) '設(shè)置緩沖區(qū)大小
If retLen > 0 Then
retLen = MultiByteToWideChar(CP_ACP, 0, sAnsi, LenB(sAnsi), sUnicodeBuffer, retLen) '開始轉(zhuǎn)換
Else
AnsiToULE = False: Exit Function
End If
'保存為Unicode(Little Endian)文本文件OutputULEfile
If retLen > 0 Then
FileNumber = FreeFile
If Dir(OutputULEfile) <> "" Then Kill (OutputULEfile)
Open OutputULEfile For Binary As #FileNumber
Put #FileNumber, , &HFEFF '加上Unicode(Little Endian)文件頭BOM標(biāo)志FFFE
Put #FileNumber, , sUnicodeBuffer '保存文件內(nèi)容
Close #FileNumber
AnsiToULE = True
Else
AnsiToULE = False: Exit Function
End If
End Function
'Ansi純文本文件轉(zhuǎn)換為Unicode Big Endian文本文件
Private Function AnsiToUBE(ByVal Inputansifile As String, ByVal OutputUBEfile As String) As Boolean
Dim Filebyte() As Byte, Fbyte() As Byte
Dim sAnsi As String, retLen As Long, FileNumber As Long
Dim sUnicodeBuffer As String
Dim i As Long
On Error Resume Next
'打開Ansi純文本文件Inputansifile
FileNumber = FreeFile
If Dir(Inputansifile) = "" Then AnsiToUBE = False: Exit Function
Open Inputansifile For Binary As #FileNumber
ReDim Filebyte(LOF(FileNumber) - 1)
Get #FileNumber, , Filebyte
Close #FileNumber
sAnsi = StrConv(Filebyte, vbUnicode) '轉(zhuǎn)換為VB6可顯示的字符串
retLen = MultiByteToWideChar(CP_ACP, 0, sAnsi, LenB(sAnsi), vbNullChar, 0) '取得轉(zhuǎn)換后需要的空間大小retLen
sUnicodeBuffer = String$(LenB(sAnsi), vbNullChar) '設(shè)置緩沖區(qū)大小
If retLen > 0 Then
retLen = MultiByteToWideChar(CP_ACP, 0, sAnsi, LenB(sAnsi), sUnicodeBuffer, retLen) '開始轉(zhuǎn)換
Else
AnsiToUBE = False: Exit Function
End If
'保存為Unicode Big Endian文本文件OutputUBEfile
If retLen > 0 Then
ReDim Filebyte(LenB(sAnsi) - 1), Fbyte(LenB(sAnsi) - 1)
Filebyte = StrConv(sUnicodeBuffer, vbFromUnicode)
For i = 0 To UBound(Filebyte)
If i Mod 2 = 0 Then
Fbyte(i) = Filebyte(i + 1)
Else
Fbyte(i) = Filebyte(i - 1)
End If
Next
FileNumber = FreeFile
If Dir(OutputUBEfile) <> "" Then Kill (OutputUBEfile)
Open OutputUBEfile For Binary As #FileNumber
Put #FileNumber, , &HFFFE '加上Unicode(Big Endian)文件頭BOM標(biāo)志FEFF
Put #FileNumber, , Fbyte ' sUnicodeBuffer '保存文件內(nèi)容
Close #FileNumber
AnsiToUBE = True
Else
AnsiToUBE = False: Exit Function
End If
End Function
'Ansi純文本文件轉(zhuǎn)換為UTF-8文本文件
Private Function AnsiToUTF8(ByVal Inputansifile 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
'打開Ansi純文本文件Inputansifile
FileNumber = FreeFile
If Dir(Inputansifile) = "" Then AnsiToUTF8 = False: Exit Function
Open Inputansifile For Binary As #FileNumber
ReDim Filebyte(LOF(FileNumber) - 1)
Get #FileNumber, , Filebyte
Close #FileNumber
S = Filebyte
sAnsi = StrConv(S, vbUnicode) '轉(zhuǎn)換為VB6可顯示的字符串
retLen = WideCharToMultiByte(CP_UTF8, 0, StrPtr(sAnsi), -1, vbNullString, 0, vbNullString, 0) '取得轉(zhuǎn)換后需要的空間大小retLen
If retLen > 0 Then
ReDim sUTF8Buffer(retLen - 1) ' = String$(retLen, vbNullChar) '設(shè)置緩沖區(qū)大小
retLen = WideCharToMultiByte(CP_UTF8, 0, StrPtr(sAnsi), -1, sUTF8Buffer(0), retLen, vbNullString, 0) '開始轉(zhuǎn)換
Else
AnsiToUTF8 = 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標(biāo)志EFBBBF
Put #FileNumber, 4, S '保存文件內(nèi)容
Close #FileNumber
AnsiToUTF8 = True
Else
AnsiToUTF8 = False: Exit Function
End If
End Function
'UTF-8文本文件轉(zhuǎn)換為Unicode(Little Endian)文本文件
Private Function UTF8ToULE(ByVal InputUTF8file As String, ByVal OutputULEfile As String) As Boolean
Dim Filebyte() As Byte ', Fbyte() As Byte
Dim sAnsi As String, retLen As Long, FileNumber As Long
Dim sUTF8Buffer As String, S As String
On Error Resume Next
'打開UTF-8文本文件InputUTF8file
FileNumber = FreeFile
If Dir(InputUTF8file) = "" Then UTF8ToULE = False: Exit Function
Open InputUTF8file For Binary As #FileNumber
ReDim Filebyte(LOF(FileNumber) - 1)
Get #FileNumber, , Filebyte
Close #FileNumber
If Hex$(Filebyte(0)) = "EF" And Hex$(Filebyte(1)) = "BB" And Hex$(Filebyte(2)) = "BF" Then
S = Filebyte
Else
MsgBox (InputUTF8file & " 為非UTF-8編碼格式文件!")
UTF8ToULE = False: Exit Function
End If
sAnsi = StrConv(S, vbUnicode) '轉(zhuǎn)換為VB6可顯示的字符串
retLen = MultiByteToWideChar(CP_UTF8, 0, sAnsi, -1, vbNullChar, 0) '取得轉(zhuǎn)換后需要的空間大小retLen
If retLen > 0 Then
sUTF8Buffer = String$(retLen * 2, vbNullChar) '設(shè)置緩沖區(qū)大小
retLen = MultiByteToWideChar(CP_UTF8, 0, sAnsi, -1, sUTF8Buffer, retLen * 2) '開始轉(zhuǎn)換
Else
UTF8ToULE = False: Exit Function
End If
'保存為Unicode(Little Endian)文本文件OutputULEfile
If retLen > 0 Then
S = Left$(sUTF8Buffer, retLen * 2)
FileNumber = FreeFile
If Dir(OutputULEfile) <> "" Then Kill (OutputULEfile)
Open OutputULEfile For Binary As #FileNumber
Put #FileNumber, , S '保存文件內(nèi)容,程序自動加上了Unicode(Little Endian)文件頭BOM標(biāo)志FFFE
Close #FileNumber
UTF8ToULE = True
Else
UTF8ToULE = False: Exit Function
End If
End Function
'UTF-8文本文件轉(zhuǎn)換為Unicode(Big Endian)文本文件
Private Function UTF8ToUBE(ByVal InputUTF8file As String, ByVal OutputUBEfile As String) As Boolean
Dim Filebyte() As Byte, Fbyte() As Byte
Dim sAnsi As String, retLen As Long, FileNumber As Long
Dim sUTF8Buffer As String, S As String
Dim i As Long
On Error Resume Next
'打開UTF-8文本文件InputUTF8file
FileNumber = FreeFile
If Dir(InputUTF8file) = "" Then UTF8ToUBE = False: Exit Function
Open InputUTF8file For Binary As #FileNumber
ReDim Filebyte(LOF(FileNumber) - 1)
Get #FileNumber, , Filebyte
Close #FileNumber
If Hex$(Filebyte(0)) = "EF" And Hex$(Filebyte(1)) = "BB" And Hex$(Filebyte(2)) = "BF" Then
S = Filebyte
Else
MsgBox (InputUTF8file & " 為非UTF-8編碼格式文件!")
UTF8ToUBE = False: Exit Function
End If
sAnsi = StrConv(S, vbUnicode) '轉(zhuǎn)換為VB6可顯示的字符串
retLen = MultiByteToWideChar(CP_UTF8, 0, sAnsi, -1, vbNullString, 0) '取得轉(zhuǎn)換后需要的空間大小retLen
If retLen > 0 Then
sUTF8Buffer = String$(retLen * 2, vbNullChar) '設(shè)置緩沖區(qū)大小
retLen = MultiByteToWideChar(CP_UTF8, 0, sAnsi, -1, sUTF8Buffer, retLen * 2) '開始轉(zhuǎn)換
Else
UTF8ToUBE = False: Exit Function
End If
'保存為Unicode Big Endian文本文件OutputUBEfile
If retLen > 0 Then
ReDim Filebyte(LenB(sAnsi) - 1), Fbyte(LenB(sAnsi) - 1)
Filebyte = StrConv(Left$(sUTF8Buffer, retLen * 2), vbFromUnicode)
For i = 0 To UBound(Filebyte)
If i Mod 2 = 0 Then
Fbyte(i) = Filebyte(i + 1)
Else
Fbyte(i) = Filebyte(i - 1)
End If
Next
FileNumber = FreeFile
If Dir(OutputUBEfile) <> "" Then Kill (OutputUBEfile)
Open OutputUBEfile For Binary As #FileNumber
Put #FileNumber, , Fbyte '保存文件內(nèi)容,,程序自動加上了Unicode(Big Endian)文件頭BOM標(biāo)志FEFF
Close #FileNumber
UTF8ToUBE = True
Else
UTF8ToUBE = False: Exit Function
End If
End Function
'UTF-8文本文件轉(zhuǎn)換為Ansi純文本文件
Private Function UTF8ToAnsi(ByVal InputUTF8file As String, ByVal OutputAnsifile As String) As Boolean
Dim Filebyte() As Byte ', Fbyte() As Byte
Dim sAnsi As String, retLen As Long, FileNumber As Long
Dim sUTF8Buffer As String, S As String
'Dim i As Long
On Error Resume Next
'打開UTF-8文本文件InputUTF8file
FileNumber = FreeFile
If Dir(InputUTF8file) = "" Then UTF8ToAnsi = False: Exit Function
Open InputUTF8file For Binary As #FileNumber
ReDim Filebyte(LOF(FileNumber) - 1)
Get #FileNumber, , Filebyte
Close #FileNumber
If Hex$(Filebyte(0)) = "EF" And Hex$(Filebyte(1)) = "BB" And Hex$(Filebyte(2)) = "BF" Then
S = Filebyte
Else
MsgBox (InputUTF8file & " 為非UTF-8編碼格式文件!")
UTF8ToAnsi = False: Exit Function
End If
sAnsi = StrConv(S, vbUnicode) '轉(zhuǎn)換為VB6可顯示的字符串
retLen = MultiByteToWideChar(CP_UTF8, 0, sAnsi, -1, vbNullString, 0) '取得轉(zhuǎn)換后需要的空間大小retLen
If retLen > 0 Then
sUTF8Buffer = String$(retLen * 2, vbNullChar) '設(shè)置緩沖區(qū)大小
retLen = MultiByteToWideChar(CP_UTF8, 0, sAnsi, -1, sUTF8Buffer, retLen * 2) '開始轉(zhuǎn)換
Else
UTF8ToAnsi = False: Exit Function
End If
'保存為Ansi純文本文件OutputAnsifile
If retLen > 0 Then
S = Left$(sUTF8Buffer, retLen * 2)
S = StrConv(S, vbFromUnicode)
Mid$(S, 1, 1) = " ": S = Trim(S)
FileNumber = FreeFile
If Dir(OutputAnsifile) <> "" Then Kill (OutputAnsifile)
Open OutputAnsifile For Binary As #FileNumber
Put #FileNumber, , S '保存文件內(nèi)容
Close #FileNumber
UTF8ToAnsi = True
Else
UTF8ToAnsi = False: Exit Function
End If
End Function
'Unicode(Little Endian)文本文件轉(zhuǎn)換為Ansi純文本文件
Private Function ULEToAnsi(ByVal InputULEfile As String, ByVal OutputAnsifile As String) As Boolean
Dim Filebyte() As Byte ', Fbyte() As Byte
Dim sAnsi As String, retLen As Long, FileNumber As Long
Dim sUnicodeBuffer() As Byte, S As String
'Dim i As Long
On Error Resume Next
'打開Unicode(Little Endian)文本文件InputULEfile
FileNumber = FreeFile
If Dir(InputULEfile) = "" Then ULEToAnsi = 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)編碼格式文件!")
ULEToAnsi = False: Exit Function
End If
sAnsi = StrConv(S, vbNarrow) '轉(zhuǎn)換為VB6可顯示的字符串
'到這個(gè)地方,,應(yīng)該說可以結(jié)束了,VB6用StrConv轉(zhuǎn)換,,直接將sAnsi存入文件即可
'下面是用API轉(zhuǎn)換為Ansi代碼
sAnsi = S
retLen = WideCharToMultiByte(CP_ACP, 0, StrPtr(sAnsi), -1, vbNullString, 0, vbNullString, 0) '取得轉(zhuǎn)換后需要的空間大小retLen
If retLen > 0 Then
ReDim sUnicodeBuffer(retLen * 2 - 1) ' String$(retLen * 2, vbNullChar)'設(shè)置緩沖區(qū)大小
retLen = WideCharToMultiByte(CP_ACP, 0, StrPtr(sAnsi), -1, sUnicodeBuffer(0), retLen * 2, vbNullString, 0) '開始轉(zhuǎn)換
Else
ULEToAnsi = False: Exit Function
End If
'保存為Ansi純文本文件OutputAnsifile
If retLen > 0 Then
ReDim Preserve sUnicodeBuffer(retLen - 1)
S = StrConv(sUnicodeBuffer, vbUnicode)
Mid$(S, 1, 1) = " ": S = Trim(S)
FileNumber = FreeFile
If Dir(OutputAnsifile) <> "" Then Kill (OutputAnsifile)
Open OutputAnsifile For Binary As #FileNumber
Put #FileNumber, , S '保存文件內(nèi)容
Close #FileNumber
ULEToAnsi = True
Else
ULEToAnsi = False: Exit Function
End If
End Function
'Unicode(Little Endian)文本文件轉(zhuǎn)換為Unicode Big Endian文本文件。
'Unicode Big Endian文本文件轉(zhuǎn)換為Unicode(Little Endian)文本文件,,
'只須將Hex$(Filebyte(0)) = "FF" And Hex$(Filebyte(1)) = "FE"改為
'Hex$(Filebyte(0)) = "FE" And Hex$(Filebyte(1)) = "FF"即可,。
Private Function ULEToUBE(ByVal InputULEfile As String, ByVal OutputUBEfile As String) As Boolean
Dim Filebyte() As Byte, Fbyte() As Byte
'Dim sAnsi As String, retLen As Long
'Dim sUnicodeBuffer() As Byte, S As String
Dim i As Long, FileNumber As Long
On Error Resume Next
'打開Unicode(Little Endian)文本文件InputULEfile
FileNumber = FreeFile
If Dir(InputULEfile) = "" Then ULEToUBE = False: Exit Function
Open InputULEfile For Binary As #FileNumber
ReDim Filebyte(LOF(FileNumber) - 1), Fbyte(LOF(FileNumber) - 1)
Get #FileNumber, , Filebyte
Close #FileNumber
If Hex$(Filebyte(0)) = "FF" And Hex$(Filebyte(1)) = "FE" Then
'Unicode(Little Endian)編碼格式文件
Else
MsgBox (InputULEfile & " 為非Unicode(Little Endian)編碼格式文件!")
ULEToUBE = False: Exit Function
End If
For i = 0 To UBound(Filebyte)
If i Mod 2 = 0 Then
Fbyte(i) = Filebyte(i + 1)
Else
Fbyte(i) = Filebyte(i - 1)
End If
Next
'保存為Unicode Big Endian文本文件OutputUBEfile
FileNumber = FreeFile
If Dir(OutputUBEfile) <> "" Then Kill (OutputUBEfile)
Open OutputUBEfile For Binary As #FileNumber
Put #FileNumber, , Fbyte '保存文件內(nèi)容
Close #FileNumber
End Function
'Unicode(Little Endian)文本文件轉(zhuǎn)換為UTF-8文本文件
Private 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) '轉(zhuǎn)換為VB6可顯示的字符串
Mid$(sAnsi, 1, 1) = " ": sAnsi = Trim(sAnsi)
retLen = WideCharToMultiByte(CP_UTF8, 0, StrPtr(sAnsi), -1, vbNullString, 0, vbNullString, 0) '取得轉(zhuǎn)換后需要的空間大小retLen
If retLen > 0 Then
ReDim sUTF8Buffer(retLen - 1) ' = String$(retLen, vbNullChar) '設(shè)置緩沖區(qū)大小
retLen = WideCharToMultiByte(CP_UTF8, 0, StrPtr(sAnsi), -1, sUTF8Buffer(0), retLen, vbNullString, 0) '開始轉(zhuǎn)換
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標(biāo)志EFBBBF
Put #FileNumber, 4, S '保存文件內(nèi)容
Close #FileNumber
ULEToUTF8 = True
Else
ULEToUTF8 = False: Exit Function
End If
End Function
Private Sub Command1_Click()
'先新建一個(gè)Ansi純文本文件"d:\AnsiCodeFile.txt"
'Ansi純文本文件轉(zhuǎn)換為Unicode(Little Endian)文本文件
Call AnsiToULE("d:\AnsiCodeFile.txt", "d:\AnsiToUnicodeLEFile.txt")
'Ansi純文本文件轉(zhuǎn)換為Unicode(Big Endian)文本文件
Call AnsiToUBE("d:\AnsiCodeFile.txt", "d:\AnsiToUnicodeBEFile.txt")
'Ansi純文本文件轉(zhuǎn)換為UTF-8文本文件
Call AnsiToUTF8("d:\AnsiCodeFile.txt", "d:\AnsiToUTF8File.txt")
'UTF-8文本文件轉(zhuǎn)換為Unicode(Little Endian)文本文件
Call UTF8ToULE("d:\AnsiToUTF8File.txt", "d:\UTF8ToUnicodeLEFile.txt")
'UTF-8文本文件轉(zhuǎn)換為Unicode Big Endian文本文件
Call UTF8ToUBE("d:\AnsiToUTF8File.txt", "d:\UTF8ToUnicodeBEFile.txt")
'UTF-8文本文件轉(zhuǎn)換為Ansi純文本文件
Call UTF8ToAnsi("d:\AnsiToUTF8File.txt", "d:\UTF8ToAnsiFile.txt")
'Unicode(Little Endian)文本文件轉(zhuǎn)換為Ansi純文本文件
Call ULEToAnsi("d:\AnsiToUnicodeLEFile.txt", "d:\UnicodeLEToAnsiFile.txt")
'Unicode(Little Endian)文本文件轉(zhuǎn)換為Unicode Big Endian文本文件
Call ULEToUBE("d:\AnsiToUnicodeLEFile.txt", "d:\UnicodeLEToUnicodeBEFile.txt")
'Unicode(Little Endian)文本文件轉(zhuǎn)換為UTF-8文本文件
Call ULEToUTF8("d:\AnsiToUnicodeLEFile.txt", "d:\UnicodeLEToUTF8File.txt")
End Sub
|