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 = 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
相關文章
- 1. utf8編碼
- 2. unicode和utf8編碼詳解
- 3. GBK 和 UTF8編碼
- 4. Maven設置utf8編碼格式 Maven設置utf8編碼格式
- 5. 查詢任意漢字的Unicode編碼,UTF8編碼,GB2312編碼,GBK編碼
- 6. 解決‘utf8‘編解碼器無法解碼字節0xa3異常
- 7. 轉換編碼 --GBK---UTF16---UTF8
- 8. MySQL編碼latin1轉utf8
- 9. cmd設置utf8編碼
- 10. putty mtputty 設置utf8編碼
- 更多相關文章...
- • XML 編碼 - XML 教程
- • HTTP狀態碼 - HTTP 教程
- • Scala 中文亂碼解決
- • IntelliJ IDEA代碼格式化設置
相關標籤/搜索
每日一句
-
每一个你不满意的现在，都有一个你没有努力的曾经。
歡迎關注本站公眾號,獲取更多信息
