UTF8 to GB2312 converts UTF8 encoded text to GB encoded text, and UTF8 encoded text will be converted into Chinese character codes. Friends in need can refer to it. 1. 'UTF to GB---Convert UTF8 encoded text to GB encoded text
Copy the code code as follows:
function UTF2GB(UTFStr)
for Dig=1 to len(UTFStr)
'Convert if UTF8 encoded text starts with %
if mid(UTFStr,Dig,1)=% then
'UTF8 encoded text greater than 8 is converted to Chinese characters
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
'UTF8 encoded text will be converted to Chinese characters
function 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 function
'Convert binary code to hexadecimal code
function c2to16(x)
i=1
for i=1 to len(x) step 4
c2to16=c2to16 & hex(c2to10(mid(x,i,4)))
next
end function
'Convert binary code to decimal code
function 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 function
'Convert hexadecimal code to binary code
function 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 function
'Convert decimal code to binary code
function 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
2. 'GB to UTF8--Convert GB encoded text to UTF8 encoded text
Copy the code code as follows:
Function toUTF8(szInput)
Dim wch,uch,szRet
Dim x
Dim nAsc, nAsc2, nAsc3
'If the input parameter is empty, exit the function
If szInput = Then
toUTF8 = szInput
Exit Function
End If
'Start conversion
For x = 1 To Len(szInput)
'Use mid function to split GB encoded text
wch = Mid(szInput, x, 1)
'Use the ascW function to return the Unicode character code of each GB encoded text
'Note: the asc function returns ANSI character code, pay attention to the difference
nAsc = AscW(wch)
If nAsc < 0 Then nAsc = nAsc + 65536
If (nAsc And &HFF80) = 0 Then
szRet = szRet & wch
Else
If (nAsc And &HF000) = 0 Then
uch = % & Hex(((nAsc / 2 ^ 6)) Or &HC0) & Hex(nAsc And &H3F Or &H80)
szRet = szRet&uch
Else
'The Unicode character code of GB encoded text adopts a three-byte template between 0800 - FFFF
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
toUTF8 = szRet
End Function
3. 'GB to unicode---Convert GB encoded text to unicode encoded text
Copy the code code as follows:
function chinese2unicode(Str)
dim i
dim Str_one
dimStr_unicode
if(isnull(Str)) then
exit function
end if
for i=1 to len(Str)
Str_one=Mid(Str,i,1)
Str_unicode=Str_unicode&chr(38)
Str_unicode=Str_unicode&chr(35)
Str_unicode=Str_unicode&chr(120)
Str_unicode=Str_unicode& Hex(ascw(Str_one))
Str_unicode=Str_unicode&chr(59)
next
chinese2unicode=Str_unicode
end function
4. 'URL decoding
Copy the code code as follows:
Function URLDecode(enStr)
dim deStr
dim c,i,v
deStr=
for i=1 to len(enStr)
c=Mid(enStr,i,1)
if c=% then
v=eval(&h+Mid(enStr,i+1,2))
if v<128 then
deStr=deStr&chr(v)
i=i+2
else
if isvalidhex(mid(enstr,i,3)) then
if isvalidhex(mid(enstr,i+3,3)) then
v=eval(&h+Mid(enStr,i+1,2)+Mid(enStr,i+4,2))
deStr=deStr&chr(v)
i=i+5
else
v=eval(&h+Mid(enStr,i+1,2)+cstr(hex(asc(Mid(enStr,i+3,1)))))
deStr=deStr&chr(v)
i=i+3
end if
else
destr=destr&c
end if
end if
else
if c=+ then
deStr=deStr&
else
deStr=deStr&c
end if
end if
next
URLDecode=deStr
end function
'Determine whether it is a valid hexadecimal code
function isvalidhex(str)
dim c
isvalidhex=true
str=ucase(str)
if len(str)<>3 then isvalidhex=false:exit function
if left(str,1)<>% then isvalidhex=false:exit function
c=mid(str,2,1)
if not (((c>=0) and (c<=9)) or ((c>=A) and (c<=Z))) then isvalidhex=false:exit function
c=mid(str,3,1)
if not (((c>=0) and (c<=9)) or ((c>=A) and (c<=Z))) then isvalidhex=false:exit function
end function
%>