VB6的UTF8编码解码
Posted 洞幺人生
tags:
篇首语：本文由小常识网(cha138.com)小编为大家整理，主要介绍了VB6的UTF8编码解码相关的知识，希望对你有一定的参考价值。
‘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 = szRetEnd Function‘UTF-8解码(2-25更改,采用递归方法，可以对一串字符串解码,仅仅为演示此算法,请不要随意调用)‘形式类如department=%E4%B9%B3%E8%85%BA‘%E5%A4%96%E7%A7%91Public 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 IfEnd 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 WendEnd 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)) NextEnd 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) WendEnd 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))) NextEnd 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) NextEnd 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 IfEnd Function以上是关于VB6的UTF8编码解码的主要内容，如果未能解决你的问题，请参考以下文章