urluft8.asp
上传用户:sking1122
上传日期:2020-09-24
资源大小:1005k
文件大小:3k
源码类别:

手机WAP编程

开发平台:

ASP/ASPX

  1. <% 
  2. Function UTF2GB(UTFStr) 
  3. Dim Dig 
  4. Dim GBStr 
  5. For Dig = 1 To Len(UTFStr) 
  6. If Mid(UTFStr, Dig, 1) = "%" Then 
  7. If Len(UTFStr) >= Dig + 8 Then 
  8. GBStr = GBStr & ConvChinese(Mid(UTFStr, Dig, 9)) 
  9. Dig = Dig + 8 
  10. Else 
  11. GBStr = GBStr & Mid(UTFStr, Dig, 1) 
  12. End If 
  13. Else 
  14. GBStr = GBStr & Mid(UTFStr, Dig, 1) 
  15. End If 
  16. Next 
  17. UTF2GB = GBStr 
  18. End Function 
  19. '====================================================================================================================================================== 
  20. 'UTF8编码文字将转换为汉字 
  21. Function ConvChinese(x) 
  22. Dim A,i,j 
  23. A = Split(Mid(x, 2), "%") 
  24. i = 0 
  25. j = 0 
  26. For i = 0 To Ubound(A) 
  27. A(i) = C16To2(A(i)) 
  28. Next 
  29. For i = 0 To Ubound(A) - 1 
  30. DigS = Instr(A(i), "0") 
  31. Unicode = "" 
  32. For j = 1 To DigS - 1 
  33. If j = 1 Then 
  34. A(i) = Right(A(i), Len(A(i)) - DigS) 
  35. Unicode = Unicode & A(i) 
  36. Else 
  37. i = i + 1 
  38. A(i) = Right(A(i), Len(A(i)) - 2) 
  39. Unicode = Unicode & A(i) 
  40. End If 
  41. Next 
  42. If Len(C2To16(Unicode)) = 4 Then 
  43. ConvChinese = ConvChinese & Chrw(Int("&H" & C2To16(Unicode))) 
  44. Else 
  45. ConvChinese = ConvChinese & Chr(Int("&H" & C2To16(Unicode))) 
  46. End If 
  47. Next 
  48. End Function 
  49. '====================================================================================================================================================== 
  50. '二进制代码转换为十六进制代码 
  51. Function C2To16(x) 
  52. i = 1 
  53. For i = 1 To Len(x) Step 4 
  54. C2To16 = C2To16 & Hex(C2To10(mid(x, i, 4))) 
  55. Next 
  56. End Function 
  57. '====================================================================================================================================================== 
  58. '二进制代码转换为十进制代码 
  59. Function C2To10(x) 
  60. C2To10 = 0 
  61. If x="0" Then 
  62. Exit Function 
  63. End If 
  64. i = 0 
  65. For i = 0 To Len(x) - 1 
  66. If Mid(x, Len(x) - i, 1) = "1" Then 
  67. C2To10 = C2To10+2^(i) 
  68. End If 
  69. Next 
  70. End Function 
  71. '====================================================================================================================================================== 
  72. '十六进制代码转换为二进制代码 
  73. Function C16To2(x) 
  74. Dim Tempstr 
  75. i = 0 
  76. For i = 1 To Len(Trim(x)) 
  77. Tempstr = C10To2(Cint(Int("&h" & Mid(x, i, 1)))) 
  78. Do While Len(tempstr) < 4 
  79. tempstr = "0" & tempstr 
  80. Loop 
  81. C16To2 = C16To2 & tempstr 
  82. Next 
  83. End Function 
  84. '====================================================================================================================================================== 
  85. '十进制代码转换为二进制代码 
  86. Function C10To2(x) 
  87. Dim mysign,DigS,tempnum 
  88. mysign = Sgn(x) 
  89. x = Abs(x) 
  90. DigS = 1 
  91. Do 
  92. if x<2^DigS then 
  93. Exit Do 
  94. Else 
  95. DigS = DigS + 1 
  96. End If 
  97. Loop 
  98. tempnum = x 
  99. i = 0 
  100. For i = DigS To 1 step - 1 
  101. If tempnum>=2^(i-1) Then 
  102. tempnum = tempnum-2^(i-1) 
  103. C10To2 = C10To2 & "1" 
  104. Else 
  105. C10To2 = C10To2 & "0" 
  106. End If 
  107. Next 
  108. If mysign=-1 Then 
  109. C10To2="-" & C10To2 
  110. End If 
  111. End Function 
  112. %><%
  113. '====================================================================
  114. ' 请你保留这段说明,这并不会影响你的速度.   电脑交流:http://www.cnscu.cn
  115. ' 程序制作:横云   掌上校园收倾心整理收集于互联网,感谢你的支持!
  116. ' 升级时间: 2008-2-5   主页地址:HTTP://wap.cnscu.cn
  117. ' E-Mail: cnscu@126.com    客服QQ:554904632 QQ群:30493504 QQ群2:46659883
  118. '====================================================================
  119. %>