Several common transcoding functions in ASP

<%
'Utf to GB
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

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
 
Function c2to16 (X)
I = 1
For I = 1 to Len (x) Step 4
C2to16 = c2to16 & hex (c2to10 (mid (X, I, 4 )))
Next
End Function

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

Function c16to2 (X)
I = 0
For I = 1 to Len (TRIM (x ))
Tempstr = c10to2 (CINT ("& H" & Mid (X, I, 1 ))))
Do While Len (tempstr) <4
Tempstr = "0" & tempstr
Loop
C16to2 = c16to2 & tempstr
Next
End Function

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

Convert 'gb to utf8
Function toutf8 (szinput)
Dim wch, uch, szret
Dim X
Dim NASC, nasc2, nasc3

If szinput = "" then
Toutf8 = szinput
Exit Function
End if
For x = 1 to Len (szinput)
Wch = mid (szinput, X, 1)
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
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

'Gb to Unicode
Function chinese2unicode (STR)
Dim I
Dim str_one
Dim str_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 (1, 120)
Str_unicode = str_unicode & hex (ASCW (str_one ))
Str_unicode = str_unicode & CHR (59)
Next
Chinese2unicode = str_unicode
End Function

'Url Decoding
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

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> = "") and (C <= "Z") Then isvalidhex = false: Exit Function
C = mid (STR, 3,1)
If not (C> = "0") and (C <= "9") or (C> = "") and (C <= "Z") Then isvalidhex = false: Exit Function
End Function
%>