<% '--------------------------------------------------------------------------
'==============================================================
' Function: ASP server object built-in encoding function
' Description: No corresponding decoding function
'==============================================================
Function Vb_urlencode (ENSTR)
Vb_urlencode = Server.URLEncode (ENSTR)
End Function
'==============================================================
' Function: decoding function of Server.URLEncode ()
' Description: The function is not yet complete
' When this page is UTF-8 encoded, the source string contains the following format substring:
' "Coded AA test AA Test"
' function cannot decode the encoding after Vb_urlencode ()
' When this page is GB2312 encoded Yes, the function works fine.
'==============================================================
Function Vb_urldecode (ENSTR)
Dim destr,strspecial
Dim c,i,v
Destr= ""
Strspecial= "!" " #$%& ' () *+,.-_/:;<=>?@[\]^ ' {|} ~%"
For I=1 to Len (ENSTR)
C=mid (enstr,i,1)
If c= "%" then
V=eval_r ("&h" +mid (enstr,i+1,2))
If inStr (STRSPECIAL,CHR (v)) >0 Then
DESTR=DESTR&CHR (v)
I=i+2
Else
V=eval_r ("&h" + Mid (enstr,i+1,2) + mid (enstr,i+4,2))
Destr=destr & Chr (v)
I=i+5
End If
Else
If c= "+" then
destr=destr& ""
Else
Destr=destr&c
End If
End If
Next
Vb_urldecode=destr
End Function
'===========================================
' Function: Encode Chinese characters, convert from GB2312 to UTF-8
' Description: Reciprocal inversion with UTF8TOGB ()
' The encoded format can be used for data transfer between pages, but cannot be
' correctly displayed in the HTML page, requires UTF8TOGB () decoding.
'===========================================
Function Vb_gbtoutf8 (Szinput)
Dim WCh, Uch, Szret
Dim x
Dim NASC, NASC2, NASC3
' If the input parameter is empty, exit the function
If szinput = "Then
Vb_gbtoutf8 = Szinput
Exit Function
End If
' Start conversion
For x = 1 to Len (szinput)
' Using the mid function to split GB encoded text
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, note 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
' GB encoded literal Unicode character code with a three-byte template 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
Vb_gbtoutf8 = Szret
End Function
'===========================================
' Function: Encode Chinese characters, convert from UTF-8 to GB2312
' Description: Decoding function of Vb_gbtoutf8 ()
'===========================================
Function VB_UTF8TOGB (UTFSTR)
For Dig=1 to Len (UTFSTR)
' If the UTF8 encoded text starts with a% conversion
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
Vb_utf8togb=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 is 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
' Hex code is 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 into 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
%>
<meta http-equiv= "Content-type" content= "text/html; charset=gb2312 "/>
<title> character encoding Test </title>
<style type= "Text/css" >
body{margin:20px 10px; line-height:140%; font-size:12px; color:blue;}
</style>
<body>
<%
On Error Resume Next
str = "# #testingTest $$# #编码aa测aa试aa ##!! 67&#=; "
Response.Write ("Source string:" & str & "<BR>")
STR1 = Vb_urlencode (str)
str2 = Vb_urldecode (str1)
Response.Write ("Vb_urlencode:" & str1 & "<BR>")
Response.Write ("Vb_urldecode:" & str2 & "<BR>")
If str2 = str Then response.write ("The result ==> is decoded correctly, urlencode all characters except 26 letters (including case) in the string are encoded, Chinese characters are 2 bytes, non-Chinese characters 1 bytes <br > ")
Response.Write ("-------------------------------------------------------<BR>")
STR3 = Vb_gbtoutf8 (str)
STR4 = VB_UTF8TOGB (STR3)
Response.Write ("Vb_gbtoutf8:" & Str3 & "<BR>")
Response.Write ("VB_UTF8TOGB:" & STR4 & "<BR>")
If STR4 = str Then response.write ("result ==> decoded correctly, GBtoUTF8 only encodes Chinese characters, 3 bytes per Chinese character encoded <BR>")
Response.End ()
%>
</body>
