asp gb2312/utf-8编码和解码

dim iSourceCode'网站默认编码
iSourceCode=Session.CodePage'得到当前页面指定的编码
'sStr：要编码的字符串
'iTargetCode：指定的编码
Function UrlEncode(sStr,iTargetCode)'将内容转换为指定编码的字符串
  If iTargetCode <> iSourceCode Then '如果指定要编码的类型与当前页面编码不一至，则临时设置处理该函数时的页面编码类型
    Session.CodePage = iTargetCode
    UrlEncode = Server.UrlEncode(sStr)
    Session.CodePage =iSourceCode'还原回原来的编码
  Else
    UrlEncode = Server.UrlEncode(sStr)
  End If
End Function

'==================================================
'将gb2312编码的字符串解码为对应的中文
'这个函数只能在gb2312编码的asp页面使用，指定codepage=65001(utf-8编码)时，无法解码，会得到乱码
'网上找了utf-8编码的asp网站想要解码gb2312编码的内容，视乎没什么好办法，查到的都是用中间页面来实现解码
'将gb2312编码的字符串从utf-8编码的页面用microsoft.xmlhttp组件发送到gb2312编码的页面
'gb2312编码的页面解码后返回utf-8编码字符串，这样再调用解码utf-8方法来实现内容转换
'==================================================
function GBUrlDecode(s)
  if s="" or isnull(s) then exit function
  dim i,sl,rst,schr,schrcode
  sl=len(s):rst=""
  for i=1 to sl
    schr=mid(s,i,1)
    if schr="+" then
      rst=rst&" "
    elseif schr="%" then'编码过的内容
      schr=mid(s,i+1,2)
      schrcode=abs(cint("&H"&schr))
      if schrcode>127 then
        schr=replace(mid(s,i+1,5),"%","")
        rst=rst & chr(cint("&H"&schr))
        i=i+5
      else'ASCII
        rst=rst & chr(schrcode)
        i=i+2
      end if
    else
      rst=rst & schr
    end if
  next
  GBUrlDecode=rst
end function

'==================================================
'将utf-8编码的字符串解码为对应的中文
'此方法可以在gb2312或者utf-8编码的页面来解码utf-8编码的字符串
'==================================================
Function UTF8URLDecode(ByVal strIn)
  UTF8URLDecode = ""
  Dim sl: sl = 1
  Dim tl: tl = 1
  Dim key: key = "%"
  Dim kl: kl = Len(key)
  Dim hh, hi, hl
  Dim a
  sl = InStr(sl, strIn, key, 1)
  Do While sl>0
    If (tl=1 And sl<>1) or tl<sl Then UTF8URLDecode = UTF8URLDecode & Mid(strIn, tl, sl-tl)
    Select Case UCase(Mid(strIn, sl+kl, 1))
      Case "U":'Unicode URLEncode
        a = Mid(strIn, sl+kl+1, 4)
        UTF8URLDecode = UTF8URLDecode & ChrW("&H" & a)
        sl = sl + 6
      Case "E":'UTF-8 URLEncode
        hh = Mid(strIn, sl+kl, 2)
        a = Int("&H" & hh)'ascii码
        If Abs(a)<128 Then
          sl = sl + 3
          UTF8URLDecode = UTF8URLDecode & Chr(a)
        Else
          hi = Mid(strIn, sl+3+kl, 2)
          hl = Mid(strIn, sl+6+kl, 2)
          a = ("&H" & hh And &H0F) * 2 ^12 or ("&H" & hi And &H3F) * 2 ^ 6 or ("&H" & hl And &H3F)
          If a<0 Then a = a + 65536
          UTF8URLDecode = UTF8URLDecode & ChrW(a)
          sl = sl + 9
        End If
      Case Else:'Asc URLEncode
        hh = Mid(strIn, sl+kl, 2)'高位
        a = Int("&H" & hh)'ascii码
        If Abs(a)<128 Then
          sl = sl + 3
        Else
          hi = Mid(strIn, sl+3+kl, 2)'低位
          a = Int("&H" & hh & hi)'非ascii码
          sl = sl + 6
        End If
        UTF8URLDecode = UTF8URLDecode & Chr(a)
    End Select
    tl = sl
    sl = InStr(sl, strIn, key, 1)
  Loop
  UTF8URLDecode = UTF8URLDecode & Mid(strIn, tl)
End Function

'==================================================
'从2进制数据流生成内容
'==================================================
Function BytesToBstr(strBody,CodeBase)
  dim obj
  set obj=Server.CreateObject("Adodb.Stream")
  obj.Type=1
  obj.Mode=3
  obj.Open
  obj.Write strBody
  obj.Position=0
  obj.Type=2
  obj.Charset=CodeBase
  BytesToBstr=obj.ReadText
  obj.Close
  set obj=nothing
End Function
'==================================================
'在utf-8页面解码gb2312编码的字符串，需要一个gb2312的中间页面来解码
'decodeType　　1：通过BytesToBstr来获取内容　　2：通过UTF8URLDecode来获取内容　
'==================================================
function GBDecodeInUTF8Page(s,decodeType)
  set xhr=server.CreateObject("microsoft.xmlhttp")
  xhr.open "post","http://"&Request.ServerVariables("SERVER_NAME") &"/gbtoutf8.asp",false
  s="s="&s&"&dt="&decodeType
  xhr.setrequestheader "content-length",len(s)
  xhr.setrequestheader "content-type","application/x-www-form-urlencoded"
  xhr.send(s)
  if decodeType=1 then
    GBDecodeInUTF8Page=BytesToBstr(xhr.responsebody,"gb2312")
  else
    GBDecodeInUTF8Page=UTF8URLDecode(xhr.responsetext)'UTF8URLDecode为上面贴出的ａ）部分解码内容
  end if
end function

<%@ language="vbscript" codepage="936" %>
<%
'中继页面，接收utf-8页面发送的gb2312字符串，解码成中文后再转换为utf-8编码字符串
iSourceCode=936
'==================================================
'将sStr字符编码为指定编码，通过设置session.codepage来实现，然后调用Server.UrlEncode即可
'可以在任何编码页面使用，注意定义iSourceCode变量
'iTargetCode：指定的编码，数字。GB2312==936   utf-8==65001
'为什么要写这么个编码函数，因为可以在gb2312页面将内容编码为utf-8的，然后保存到cookie
'这样在其他2级域名使用utf-8编码的站点就可以获取utf-8编码的cookie内容，然后解码就可以获取到内容了
'==================================================
Function UrlEncode(sStr,iTargetCode)'将内容转换为指定编码的字符串
  If iTargetCode <> iSourceCode Then '如果指定要编码的类型与当前页面编码不一至，则临时设置处理该函数时的页面编码类型
    Session.CodePage = iTargetCode
    UrlEncode = Server.UrlEncode(sStr)
    Session.CodePage =iSourceCode'还原为原来的编码
  Else
    UrlEncode = Server.UrlEncode(sStr)
  End If
End Function
'==================================================
'将gb2312编码的字符串解码为对应的中文
'这个函数只能在gb2312编码的asp页面使用，指定codepage=65001(utf-8编码)时，无法解码，会得到乱码
'==================================================
function GBUrlDecode(s)
  if s="" or isnull(s) then exit function
  dim i,sl,rst,schr,schrcode
  sl=len(s):rst=""
  for i=1 to sl
    schr=mid(s,i,1)
    if schr="+" then
      rst=rst&" "
    elseif schr="%" then'编码过的内容
      schr=mid(s,i+1,2)
      schrcode=abs(cint("&H"&schr))
      if schrcode>127 then
        schr=replace(mid(s,i+1,5),"%","")
        rst=rst & chr(cint("&H"&schr))
        i=i+5
      else'ASCII
        rst=rst & chr(schrcode)
        i=i+2
      end if
    else
      rst=rst & schr
    end if
  next
  GBUrlDecode=rst
end function
dt=request.Form("dt")'dt不为1时，将内容编码为utf-8编码，否则utf-8页面使用adodb.stream来生成内容
s=request.Form("s")'获取utf-8页面post过来的gb2312编码的字符串
s=GBURLDecode(s)'解码得到对应的内容
if dt<>"1" then s=UrlEncode(s,65001)'转换内容为utf-8编码
response.write s
%>