Question

vb UTF-8 转GB2312格式.

vb UTF-8 转GB2312格式. a = Inet1.OpenURL( http://www.xxxx.com/x.html) a里面有乱码，怎么解决？

Answer 1

Function UTF2GB(UTFStr)
For Dig = 1 To Len(UTFStr)
If Mid(UTFStr, Dig, 1) = "%" Then
If Len(UTFStr) >= Dig + 8 Then
GBStr = GBStr & ConvChinese(Mid(UTFStr, Dig, 9))
Dig = Dig + 8
Else
GBStr = GBStr & Mid(UTFStr, Dig, 1)
End If
Else
GBStr = GBStr & Mid(UTFStr, Dig, 1)
End If
Next
UTF2GB = GBStr
End FunctionFunction ConvChinese(x)
a = Split(Mid(x, 2), "%")
i = 0
j = 0 For i = 0 To UBound(a)
a(i) = c16to2(a(i))
Next For i = 0 To UBound(a) - 1
DigS = InStr(a(i), "0")
Unicode = ""
For j = 1 To DigS - 1
If j = 1 Then
a(i) = Right(a(i), Len(a(i)) - DigS)
Unicode = Unicode & a(i)
Else
i = i + 1
a(i) = Right(a(i), Len(a(i)) - 2)
Unicode = Unicode & a(i)
End If
Next

If Len(c2to16(Unicode)) = 4 Then
ConvChinese = ConvChinese & ChrW(Int("&H" & c2to16(Unicode)))
Else
ConvChinese = ConvChinese & Chr(Int("&H" & c2to16(Unicode)))
End If
Next
End FunctionFunction c2to16(x)
i = 1
For i = 1 To Len(x) Step 4
c2to16 = c2to16 & Hex(c2to10(Mid(x, i, 4)))
Next
End FunctionFunction c2to10(x)
c2to10 = 0
If x = "0" Then Exit Function
i = 0
For i = 0 To Len(x) - 1
If Mid(x, Len(x) - i, 1) = "1" Then c2to10 = c2to10 + 2 ^ (i)
Next
End FunctionFunction c16to2(x)
i = 0
For i = 1 To Len(Trim(x))
tempstr = c10to2(CInt(Int("&h" & Mid(x, i, 1))))
Do While Len(tempstr) < 4
tempstr = "0" & tempstr
Loop
c16to2 = c16to2 & tempstr
Next
End FunctionFunction c10to2(x)
mysign = Sgn(x)
x = Abs(x)
DigS = 1
Do
If x < 2 ^ DigS Then
Exit Do
Else
DigS = DigS + 1
End If
Loop
tempnum = x

i = 0
For i = DigS To 1 Step -1
If tempnum >= 2 ^ (i - 1) Then
tempnum = tempnum - 2 ^ (i - 1)
c10to2 = c10to2 & "1"
Else
c10to2 = c10to2 & "0"
End If
Next
If mysign = -1 Then c10to2 = "-" & c10to2
End Function

Answer 2

Function UTF2GB(UTFStr)
For Dig = 1 To Len(UTFStr)
If Mid(UTFStr, Dig, 1) = "%" Then
If Len(UTFStr) >= Dig + 8 Then
GBStr = GBStr & ConvChinese(Mid(UTFStr, Dig, 9))
Dig = Dig + 8
Else
GBStr = GBStr & Mid(UTFStr, Dig, 1)
End If
Else
GBStr = GBStr & Mid(UTFStr, Dig, 1)
End If
Next
UTF2GB = GBStr
End Function 我的资料库里有这个 我自己不搞vb的 你看看 希望可以帮到你