wap常用转换函数

汉字转换为UTF-8的一段代码
一个ASP写的中文转UTF-8，大家可以试试

汉字转换为UTF-8

function chinese2unicode(Str) 
  dim i 
  dim Str_one 
  dim Str_unicode 
  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 
  Response.Write Str_unicode 
end function  

UTF-8 To GB2312

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(int("&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
'========第二种
Function c2u(sGBStr)
Dim i,c
For i = 1 to Len(sGBStr)
c = Mid(sGBStr,i,1)
c2u = c2u & "&#x" & Hex(AscW(c)) & ";"
Next
End Function
'======这个函数将二进制流转成字符串：
Public Function TransBinaryToStr(objObject As Variant) As String
Dim i As Integer
Dim nCount As Integer
Dim bFlag As Boolean
Dim sRtn As String
Dim varChar As Variant
Dim sHeadLetter As String
bFlag = False
sRtn = ""
nCount = LenB(objObject)

If Not IsNull(objObject) Then
For i = 1 To nCount
'If bFlag = False Then
varChar = MidB(objObject, i, 1)
If AscB(varChar) > 127 Then
sHeadLetter = CStr(Hex(AscB(varChar)))
sRtn = sRtn & "%" & sHeadLetter
'sRtn = sRtn & Chr(AscW(MidB(objObject, i + 1, 1) & varChar))
'bFlag = True
Else
sRtn = sRtn & Chr(AscB(varChar))
End If
'Else
'bFlag = False
'End If
Next
End If
TransBinaryToStr = sRtn
End Function

'======这个函数可以从Post串中提取你所要的value:
Public Function getUTF8Parameter(sParameter, sURL As Variant) As String
Dim url() As Byte
Dim sIndex As Integer
Dim nHighIndex As Integer
Dim nLowIndex As Integer
Dim sHighChar As String
Dim sLowChar As String
Dim svUrlUse As Variant
Dim sUrlUse As String
Dim sLog As String
Dim i, j, k, w As Integer
Dim Current
Dim noldflag, nnewflag
Dim sHexToInteger As String
Dim sRtn As String

sHexToInteger = "123456789ABCDEF"
sIndex = InStrB(sURL, sParameter)
svUrlUse = MidB(sURL, sIndex + Len(sParameter) + 2)
sUrlUse = TransBinaryToStr(svUrlUse)

If IsEmpty(sUrlUse) Or sUrlUse = "" Then
getUTF8Parameter = ""
Exit Function
End If

k = 0
noldflag = 2
nnewflag = 2
For i = 1 To Len(sUrlUse)
Current = Mid(sUrlUse, i, 1)
If Current = "&" Then Exit For
If Current = "%" Then
i = i + 1
sHighChar = Mid(sUrlUse, i, 1)
i = i + 1
sLowChar = Mid(sUrlUse, i, 1)
nHighIndex = InStr(sHexToInteger, UCase(sHighChar))
nLowIndex = InStr(sHexToInteger, UCase(sLowChar))
ReDim Preserve url(j + 1)
url(j) = CByte(nHighIndex * 16 + nLowIndex)

j = j + 1
k = k + 1
nnewflag = 1
Else
ReDim url(j + 1)
url(j) = CByte(Asc(Current))

j = j + 1
nnewflag = 2
End If
If (nnewflag = 1 And Mid(sUrlUse, i + 1, 1) <> "%" Then
Dim tempbyte() As Byte
url(UBound(url)) = CByte(&H60)
tempbyte = url

Dim sTemp
sTemp = StrConv(tempbyte, vbUnicode)

sRtn = sRtn & sTemp

k = 0
j = 0
ElseIf nnewflag = 2 Then
sRtn = sRtn & CStr(url)
j = 0
End If
noldflag = nnewflag
Next

Dim objHz As New AFCONVERTLib.HzConvert
Dim sGB As String
objHz.UTF8toGB sRtn, sGB

getUTF8Parameter = Replace(sGB, "`", ""
getUTF8Parameter = Replace(getUTF8Parameter, "++", "`"
getUTF8Parameter = Replace(getUTF8Parameter, "+", ""
getUTF8Parameter = Replace(getUTF8Parameter, "`", "+"

Set objHz = Nothing

End Function