日期:2014-05-16 浏览次数:20445 次
Function UTF2GB(UTFStr) Dim Dig,GBStr 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 URLEncoding(vstrIn) Dim strReturn,i,innerCode,ThisChr,Hight8,Low8 strReturn = "" For i = 1 To Len(vstrIn) ThisChr = Mid(vStrIn,i,1) If Abs(Asc(ThisChr)) < &HFF Then strReturn = strReturn & ThisChr Else innerCode = Asc(ThisChr) If innerCode < 0 Then innerCode = innerCode + &H10000 End If Hight8 = (innerCode And &HFF00)\ &HFF Low8 = innerCode And &HFF strReturn = strReturn & "%" & Hex(Hight8) & "%" & Hex(Low8) End If Next URLEncoding = strReturn End Function Function ConvChinese(x) Dim A,i,j,DigS,Unicode 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) Dim i i = 1 For i = 1 To Len(x) Step 4 c2to16 = c2to16 & Hex(c2to10(Mid(x, i, 4))) Next End Function Function c2to10(x) Dim i 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) Dim i,tempstr 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) Dim mysign,DigS,tempnum,i 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
<% Response.Addheader "Content-Type","text/html; charset=gb2312f" Response.Write Server.URLEncode("测试用户") Response.Write "<p>" Dim s s="%E6%B5%8B%E8%AF%95%E7%94%A8%E6%88%B7" Dim d d="测试用户" 'Response.Write c2Toutf(d) 'Response.Write ConvChinese(s) Function c2Toutf(c2Str) Dim i, temp For i = 1 To LenB(c2Str) temp = temp & CStr(MidB(c2Str, i, 1)) & "-" Next c2Toutf = temp End Function Function ConvChinese(x) Dim A, i, j, DigS, Unicode 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) Dim i i = 1 For i = 1 To Len(x) Step 4 c2to16 = c2to16 & Hex(c2to10(Mid(x, i, 4))) Next End Function Function c2to10(x) Dim i c2to10 = 0 If x = "0"