Several useful functions about character encoding conversion in ASP

Coding | functions | converting

<%
1. ' UTF to GB---convert UTF8 encoded text to GB encoded text
function UTF2GB (UTFSTR)

For Dig=1 to Len (UTFSTR)
' If the UTF8 encoded text starts with a%, it converts
If mid (utfstr,dig,1) = "%" Then
' UTF8 encoded text is greater than 8 to convert 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

' binary code converted 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

' Binary code converted 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

' hexadecimal code converted 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

decimal code converts to binary
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 turn utf8--to convert GB encoded text to UTF8 encoded text

Function toUTF8 (Szinput)
Dim WCh, Uch, Szret
Dim x
Dim NASC, NASC2, NASC3
' If the input parameter is empty, the function is exited
If szinput = "" Then
ToUTF8 = Szinput
Exit Function
End If
' Start conversion
For x = 1 to Len (szinput)
' Split GB encoded text with mid function
WCH = Mid (Szinput, X, 1)
' Use the ASCW function to return Unicode character codes for each GB encoded text
' NOTE: The ASC function returns the ANSI character code, paying 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 for GB encoded text uses a three-byte stencil between 0800-FFFF
Uch = "%" & Hex (NASC \ 2 ^) 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

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 (120)
str_unicode=str_unicode& Hex (AscW (Str_one))
STR_UNICODE=STR_UNICODE&CHR (59)
Next
Chinese2unicode=str_unicode
End Function

4, ' 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&AMP;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&AMP;CHR (v)
I=i+5
Else
V=eval ("&h" +mid (enstr,i+1,2) +cstr (Hex (ASC (enstr,i+3,1)))
DESTR=DESTR&AMP;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 if the hexadecimal code is valid
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
%>