VB 文件编码互换模块(支持 Ansi,UTF-8,Unicode(little endian),Unicode big endian)

最新推荐文章于 2021-09-18 11:44:38 发布

miaozk2006

最新推荐文章于 2021-09-18 11:44:38 发布

阅读量1.7k

点赞数

本文链接：https://blog.csdn.net/miaozk2006/article/details/82417056

版权

该VB模块提供了在Ansi、UTF-8、Unicode Little Endian、Unicode Big Endian编码之间的转换功能。通过调用kernel32.dll中的API函数，实现不同编码的文本文件之间的转换，包括读取、转换和保存文件内容。

摘要由CSDN通过智能技术生成

'VB 文件编码互换模块，支持对Ansi,UTF-8,Unicode(little endian),Unicode big endian编码之间进行转换。

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