首页 > 代码库 > VB6的UTF8编码解码

VB6的UTF8编码解码

2024-10-12 16:44:39   215人阅读

‘UTF-8编码
 Public Function UTF8Encode(ByVal szInput As String) As String
    Dim wch  As String
    Dim uch As String
    Dim szRet As String
    Dim x As Long
    Dim inputLen As Long
    Dim nAsc  As Long
    Dim nAsc2 As Long
    Dim nAsc3 As Long
     
    If szInput = "" Then
        UTF8Encode = szInput
        Exit Function
    End If
    inputLen = Len(szInput)
    For x = 1 To inputLen
    ‘得到每个字符
        wch = Mid(szInput, x, 1)
        ‘得到相应的UNICODE编码
        nAsc = AscW(wch)
    ‘对于<0的编码　其需要加上65536
        If nAsc < 0 Then nAsc = nAsc + 65536
    ‘对于<128位的ASCII的编码则无需更改
        If (nAsc And &HFF80) = 0 Then
            szRet = szRet & wch
        Else
            If (nAsc And &HF000) = 0 Then
            ‘真正的第二层编码范围为000080 - 0007FF
            ‘Unicode在范围D800-DFFF中不存在任何字符，基本多文种平面中约定了这个范围用于UTF-16扩展标识辅助平面（两个UTF-16表示一个辅助平面字符）.
            ‘当然，任何编码都是可以被转换到这个范围，但在unicode中他们并不代表任何合法的值。
     
                uch = "%" & Hex(((nAsc \ 2 ^ 6)) Or &HC0) & Hex(nAsc And &H3F Or &H80)
                szRet = szRet & uch
                 
            Else
            ‘第三层编码00000800 – 0000FFFF
            ‘首先取其前四位与11100000进行或去处得到UTF-8编码的前8位
            ‘其次取其前10位与111111进行并运算，这样就能得到其前10中最后6位的真正的编码　再与10000000进行或运算来得到UTF-8编码中间的8位
            ‘最后将其与111111进行并运算，这样就能得到其最后6位的真正的编码　再与10000000进行或运算来得到UTF-8编码最后8位编码
                uch = "%" & Hex((nAsc \ 2 ^ 12) Or &HE0) & "%" & _
                Hex((nAsc \ 2 ^ 6) And &H3F Or &H80) & "%" & _
                Hex(nAsc And &H3F Or &H80)
                szRet = szRet & uch
            End If
        End If
    Next
     
    UTF8Encode = szRet
End Function
 
 
‘UTF-8解码(2-25更改,采用递归方法，可以对一串字符串解码,仅仅为演示此算法,请不要随意调用)
 
‘形式类如department=%E4%B9%B3%E8%85%BA‘%E5%A4%96%E7%A7%91
Public Function UTF8BadDecode(ByVal code As String) As String
    If code = "" Then
        Exit Function
    End If
    
    Dim tmp As String
    Dim decodeStr As String
    Dim codelen As Long
    Dim result As String
    Dim leftStr As String
    
    leftStr = Left(code, 1)
    
    If leftStr = "" Then
    
        UTF8BadDecode = ""
        Exit Function
        
    ElseIf leftStr <> "%" Then
    
        UTF8BadDecode = leftStr + UTF8BadDecode(Right(code, Len(code) - 1))
        
    ElseIf leftStr = "%" Then
    
        codelen = Len(code)
        
        If (Mid(code, 2, 1) = "C" Or Mid(code, 2, 1) = "B") Then
            decodeStr = Replace(Mid(code, 1, 6), "%", "")
            tmp = c10ton(Val("&H" & Hex(Val("&H" & decodeStr) And &H1F3F)))
            tmp = String(16 - Len(tmp), "0") & tmp
            UTF8BadDecode = UTF8BadDecode & ChrW(Val("&H" & c2to16(Mid(tmp, 3, 4)) & c2to16(Mid(tmp, 7, 2) & Mid(tmp, 11, 2)) & Right(decodeStr, 1))) & UTF8BadDecode(Right(code, codelen - 6))
        ElseIf (Mid(code, 2, 1) = "E") Then
            decodeStr = Replace(Mid(code, 1, 9), "%", "")
            tmp = c10ton((Val("&H" & Mid(Hex(Val("&H" & decodeStr) And &HF3F3F), 2, 3))))
            tmp = String(10 - Len(tmp), "0") & tmp
            UTF8BadDecode = ChrW(Val("&H" & (Mid(decodeStr, 2, 1) & c2to16(Mid(tmp, 1, 4)) & c2to16(Mid(tmp, 5, 2) & Right(tmp, 2)) & Right(decodeStr, 1)))) & UTF8BadDecode(Right(code, codelen - 9))
        Else
            UTF8BadDecode = Chr(Val("&H" & (Mid(code, 2, 2)))) & UTF8BadDecode(Right(code, codelen - 3))
        End If
        
    End If
End Function
 
 
‘UTF-8解码(3-12更改,可以解多个字符串 可供正常使用)
 
Public Function UTF8Decode(ByVal code As String) As String
    If code = "" Then
        UTF8Decode = ""
        Exit Function
    End If
    
    Dim tmp As String
    Dim decodeStr As String
    Dim codelen As Long
    Dim result As String
    Dim leftStr As String
     
    leftStr = Left(code, 1)
     
    While (code <> "")
        codelen = Len(code)
        leftStr = Left(code, 1)
        If leftStr = "%" Then
                If (Mid(code, 2, 1) = "C" Or Mid(code, 2, 1) = "B") Then
                    decodeStr = Replace(Mid(code, 1, 6), "%", "")
                    tmp = c10ton(Val("&H" & Hex(Val("&H" & decodeStr) And &H1F3F)))
                    tmp = String(16 - Len(tmp), "0") & tmp
                    UTF8Decode = UTF8Decode & UTF8Decode & ChrW(Val("&H" & c2to16(Mid(tmp, 3, 4)) & c2to16(Mid(tmp, 7, 2) & Mid(tmp, 11, 2)) & Right(decodeStr, 1)))
                    code = Right(code, codelen - 6)
                ElseIf (Mid(code, 2, 1) = "E") Then
                    decodeStr = Replace(Mid(code, 1, 9), "%", "")
                    tmp = c10ton((Val("&H" & Mid(Hex(Val("&H" & decodeStr) And &HF3F3F), 2, 3))))
                    tmp = String(10 - Len(tmp), "0") & tmp
                    UTF8Decode = UTF8Decode & ChrW(Val("&H" & (Mid(decodeStr, 2, 1) & c2to16(Mid(tmp, 1, 4)) & c2to16(Mid(tmp, 5, 2) & Right(tmp, 2)) & Right(decodeStr, 1))))
                    code = Right(code, codelen - 9)
                End If
        Else
            UTF8Decode = UTF8Decode & leftStr
            code = Right(code, codelen - 1)
        End If
    Wend
End Function
 
‘gb2312编码
Public Function GBKEncode(szInput) As String
    Dim i As Long
    Dim startIndex As Long
    Dim endIndex As Long
    Dim x() As Byte
     
    x = StrConv(szInput, vbFromUnicode)
     
    startIndex = LBound(x)
    endIndex = UBound(x)
    For i = startIndex To endIndex
        GBKEncode = GBKEncode & "%" & Hex(x(i))
    Next
End Function
 
‘GB2312编码
Public Function GBKDecode(ByVal code As String) As String
    code = Replace(code, "%", "")
    Dim bytes(1) As Byte
    Dim index As Long
    Dim length As Long
    Dim codelen As Long
    codelen = Len(code)
    While (codelen > 3)
        For index = 1 To 2
            bytes(index - 1) = Val("&H" & Mid(code, index * 2 - 1, 2))
        Next index
        GBKDecode = GBKDecode & StrConv(bytes, vbUnicode)
        code = Right(code, codelen - 4)
        codelen = Len(code)
    Wend
End Function
 
‘二进制代码转换为十六进制代码
Public Function c2to16(ByVal x As String) As String
   Dim i As Long
   i = 1
   For i = 1 To Len(x) Step 4
      c2to16 = c2to16 & Hex(c2to10(Mid(x, i, 4)))
   Next
End Function
 
‘二进制代码转换为十进制代码
Public Function c2to10(ByVal x As String) As String
   c2to10 = 0
   If x = "0" Then Exit Function
   Dim i As Long
   i = 0
   For i = 0 To Len(x) - 1
      If Mid(x, Len(x) - i, 1) = "1" Then c2to10 = c2to10 + 2 ^ (i)
   Next
End Function
 
‘10进制转n进制(默认2)
Public Function c10ton(ByVal x As Integer, Optional ByVal n As Integer = 2) As String
    Dim i As Integer
    i = x \ n
    If i > 0 Then
        If x Mod n > 10 Then
            c10ton = c10ton(i, n) + chr(x Mod n + 55)
        Else
            c10ton = c10ton(i, n) + CStr(x Mod n)
        End If
    Else
        If x > 10 Then
            c10ton = chr(x + 55)
        Else
            c10ton = CStr(x)
        End If
    End If
End Function

VB6的UTF8编码解码


联系
我们