Ansi,Unicode(little endian),Unicode big endian,UTF-8編碼檔案相互轉換__編碼

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純文字檔案轉換為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) '轉換為VB6可顯示的字串 retLen = MultiByteToWideChar(CP_ACP, 0, sAnsi, LenB(sAnsi), vbNullChar, 0) '取得轉換後需要的空間大小retLen sUnicodeBuffer = String$(LenB(sAnsi), vbNullChar) '設定緩衝區大小 If retLen > 0 Then retLen = MultiByteToWideChar(CP_ACP, 0, sAnsi, LenB(sAnsi), sUnicodeBuffer, retLen) '開始轉換 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標誌FFFE Put #FileNumber, , sUnicodeBuffer '儲存檔案內容 Close #FileNumber AnsiToULE = True Else AnsiToULE = False: Exit Function End If End Function 'Ansi純文字檔案轉換為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) '轉換為VB6可顯示的字串 retLen = MultiByteToWideChar(CP_ACP, 0, sAnsi, LenB(sAnsi), vbNullChar, 0) '取得轉換後需要的空間大小retLen sUnicodeBuffer = String$(LenB(sAnsi), vbNullChar) '設定緩衝區大小 If retLen > 0 Then retLen = MultiByteToWideChar(CP_ACP, 0, sAnsi, LenB(sAnsi), sUnicodeBuffer, retLen) '開始轉換 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標誌FEFF Put #FileNumber, , Fbyte ' sUnicodeBuffer '儲存檔案內容 Close #FileNumber AnsiToUBE = True Else AnsiToUBE = False: Exit Function End If End Function 'Ansi純文字檔案轉換為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) '轉換為VB6可顯示的字串 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 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標誌EFBBBF Put #FileNumber, 4, S '儲存檔案內容 Close #FileNumber AnsiToUTF8 = True Else AnsiToUTF8 = False: Exit Function End If End Function 'UTF-8文字檔轉換為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) '轉換為VB6可顯示的字串 retLen = MultiByteToWideChar(CP_UTF8, 0, sAnsi, -1, vbNullChar, 0) '取得轉換後需要的空間大小retLen If retLen > 0 Then sUTF8Buffer = String$(retLen * 2, vbNullChar) '設定緩衝區大小 retLen = MultiByteToWideChar(CP_UTF8, 0, sAnsi, -1, sUTF8Buffer, retLen * 2) '開始轉換 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 '儲存檔案內容，程式自動加上了Unicode(Little Endian)檔案頭BOM標誌FFFE Close #FileNumber UTF8ToULE = True Else UTF8ToULE = False: Exit Function End If End Function 'UTF-8文字檔轉換為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) '轉換為VB6可顯示的字串 retLen = MultiByteToWideChar(CP_UTF8, 0, sAnsi, -1, vbNullString, 0) '取得轉換後需要的空間大小retLen If retLen > 0 Then sUTF8Buffer = String$(retLen * 2, vbNullChar) '設定緩衝區大小 retLen = MultiByteToWideChar(CP_UTF8, 0, sAnsi, -1, sUTF8Buffer, retLen * 2) '開始轉換 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 '儲存檔案內容，程式自動加上了Unicode(Big Endian)檔案頭BOM標誌FEFF Close #FileNumber UTF8ToUBE = True Else UTF8ToUBE = False: Exit Function End If End Function 'UTF-8文字檔轉換為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) '轉換為VB6可顯示的字串 retLen = MultiByteToWideChar(CP_UTF8, 0, sAnsi, -1, vbNullString, 0) '取得轉換後需要的空間大小retLen If retLen > 0 Then sUTF8Buffer = String$(retLen * 2, vbNullChar) '設定緩衝區大小 retLen = MultiByteToWideChar(CP_UTF8, 0, sAnsi, -1, sUTF8Buffer, retLen * 2) '開始轉換 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 '儲存檔案內容 Close #FileNumber UTF8ToAnsi = True Else UTF8ToAnsi = False: Exit Function End If End Function 'Unicode(Little Endian)文字檔轉換為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) '轉換為VB6可顯示的字串 '到這個地方，應該說可以結束了，VB6用StrConv轉換，直接將sAnsi存入檔案即可 '下面是用API轉換為Ansi代碼 sAnsi = S retLen = WideCharToMultiByte(CP_ACP, 0, StrPtr(sAnsi), -1, vbNullString, 0, vbNullString, 0) '取得轉換後需要的空間大小retLen If retLen > 0 Then ReDim sUnicodeBuffer(retLen * 2 - 1) ' String$(retLen * 2, vbNullChar)'設定緩衝區大小 retLen = WideCharToMultiByte(CP_ACP, 0, StrPtr(sAnsi), -1, sUnicodeBuffer(0), retLen * 2, vbNullString, 0) '開始轉換 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 '儲存檔案內容 Close #FileNumber ULEToAnsi = True Else ULEToAnsi = False: Exit Function End If End Function 'Unicode(Little Endian)文字檔轉換為Unicode Big Endian文字檔。 'Unicode Big Endian文字檔轉換為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 '儲存檔案內容 Close #FileNumber End Function 'Unicode(Little Endian)文字檔轉換為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) '轉換為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 Sub Command1_Click() '先建立一個Ansi純文字檔案"d:/AnsiCodeFile.txt" 'Ansi純文字檔案轉換為Unicode(Little Endian)文字檔 Call AnsiToULE("d:/AnsiCodeFile.txt", "d:/AnsiToUnicodeLEFile.txt") 'Ansi純文字檔案轉換為Unicode(Big Endian)文字檔 Call AnsiToUBE("d:/AnsiCodeFile.txt", "d:/AnsiToUnicodeBEFile.txt") 'Ansi純文字檔案轉換為UTF-8文字檔 Call AnsiToUTF8("d:/AnsiCodeFile.txt", "d:/AnsiToUTF8File.txt") 'UTF-8文字檔轉換為Unicode(Little Endian)文字檔 Call UTF8ToULE("d:/AnsiToUTF8File.txt", "d:/UTF8ToUnicodeLEFile.txt") 'UTF-8文字檔轉換為Unicode Big Endian文字檔 Call UTF8ToUBE("d:/AnsiToUTF8File.txt", "d:/UTF8ToUnicodeBEFile.txt") 'UTF-8文字檔轉換為Ansi純文字檔案 Call UTF8ToAnsi("d:/AnsiToUTF8File.txt", "d:/UTF8ToAnsiFile.txt") 'Unicode(Little Endian)文字檔轉換為Ansi純文字檔案 Call ULEToAnsi("d:/AnsiToUnicodeLEFile.txt", "d:/UnicodeLEToAnsiFile.txt") 'Unicode(Little Endian)文字檔轉換為Unicode Big Endian文字檔 Call ULEToUBE("d:/AnsiToUnicodeLEFile.txt", "d:/UnicodeLEToUnicodeBEFile.txt") 'Unicode(Little Endian)文字檔轉換為UTF-8文字檔 Call ULEToUTF8("d:/AnsiToUnicodeLEFile.txt", "d:/UnicodeLEToUTF8File.txt") End Sub