汉字转换为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