技术文章 订阅所有【技术文章】的日志

VB实现Asp中的server.urlencode功能

作者:admin 日期:2012-05-20

字体大小: 小 中 大

VB版URLEncode  

ASP/Visual Basic代码
  1. Private Function URLEncoding(vstrIn)  
  2.  strReturn = ""  
  3.      Dim i  
  4.  For i = 1 To Len(vstrIn)  
  5.  ThisChr = Mid(vstrIn, i, 1)  
  6.  If Abs(Asc(ThisChr)) < &HFF Then  
  7.  strReturn = strReturn & ThisChr  
  8.  Else  
  9.  innerCode = Asc(ThisChr)  
  10.  If innerCode < 0 Then  
  11.  innerCode = innerCode + &H10000  
  12.  End If  
  13.  Hight8 = (innerCode And &HFF00) \ &HFF  
  14.  Low8 = innerCode And &HFF  
  15.  strReturn = strReturn & "%" & Hex(Hight8) & "%" & Hex(Low8)  
  16.  End If  
  17.  Next  
  18.  strReturn = Replace(strReturn, Chr(32), "%20")  
  19.  URLEncoding = strReturn  
  20.  End Function  
  21.    
  22.  '这个是根据HTML里面的ENSCAPE函数仿做的一个函数实现程序,将文字转换为16进制码表示的代码编码和解码方案  
  23.    
  24.  Function ChangeToChar(CharAsc As Long)  
  25.  On Error GoTo OnError  
  26.         ChangeToChar = ChrW(CharAsc)  
  27.         Exit Function  
  28.  OnError:  
  29.         Exit Function  
  30.  End Function  
  31.    
  32.  Function UnEnscape(enstr As String) As String  
  33.  Dim DataLen As Long  
  34.  Dim TempData As String  
  35.  Dim filepoint As Long  
  36.  Dim ChinaText As Long  
  37.  DataLen = Len(enstr)  
  38.  filepoint = 1  
  39.  Do While (filepoint <= DataLen)  
  40.      If Mid(enstr, filepoint, 1) = "%" Then  
  41.         If Mid(enstr, filepoint + 1, 1) = "u" Then  
  42.         On Error Resume Next  
  43.         ChinaText = CLng("&H" + Mid(enstr, filepoint + 2, 4))  
  44.         TempData = TempData + ChangeToChar(ChinaText)  
  45.         filepoint = filepoint + 6  
  46.         Else  
  47.         TempData = TempData + ChrW(CLng("&H" + Mid(enstr, filepoint + 1, 2)))  
  48.         filepoint = filepoint + 3  
  49.         End If  
  50.       Else  
  51.         TempData = TempData + Mid(enstr, filepoint, 1)  
  52.         filepoint = filepoint + 1  
  53.      End If  
  54.  Loop  
  55.  UnEnscape = TempData  
  56.  End Function  
  57.    
  58.  Function Enscape(enstr As String) As String  
  59.  Dim OutPutStr As String  
  60.  Dim TmpStr As String  
  61.  Dim DataLen As Long  
  62.  TmpStr = ""  
  63.  DataLen = Len(enstr)  
  64.  Dim TempNum As Long  
  65.  For i = 1 To DataLen  
  66.  TempNum = AscW(Mid(enstr, i, 1))  
  67.     Debug.Print TempNum  
  68.     If TempNum < 16 And TempNum > 0 Then  
  69.        TmpStr = TmpStr + "%0" + Hex(TempNum)  
  70.       
  71.     ElseIf 48 <= TempNum And TempNum <= 57 Then  
  72.          
  73.        TmpStr = TmpStr + Mid(enstr, i, 1)  
  74.          
  75.      ElseIf 65 <= TempNum And TempNum <= 90 Then  
  76.          
  77.        TmpStr = TmpStr + Mid(enstr, i, 1)  
  78.          
  79.      ElseIf 97 <= TempNum And TempNum <= 122 Then  
  80.          
  81.        TmpStr = TmpStr + Mid(enstr, i, 1)  
  82.          
  83.       
  84.      ElseIf 16 <= TempNum And TempNum < 256 Then  
  85.        TmpStr = TmpStr + "%" + Hex(TempNum)  
  86.    
  87.      ElseIf 4096 > TempNum And TempNum >= 256 Then  
  88.              If TempNum > 0 Then  
  89.        TmpStr = TmpStr + "%u0" + Hex(TempNum)  
  90.        Else  
  91.        TmpStr = TmpStr + "%u0" + Hex(CLng(&H10000) + TempNum)  
  92.        End If  
  93.      ElseIf Abs(TempNum) >= 4096 Then  
  94.        If TempNum > 0 Then  
  95.        TmpStr = TmpStr + "%u" + Hex(TempNum)  
  96.        Else  
  97.        TmpStr = TmpStr + "%u" + Hex(CLng(&H10000) + TempNum)  
  98.        End If  
  99.          
  100.      End If  
  101.    
  102.  Next  
  103.  Enscape = TmpStr  
  104.  End Function  

转载自：http://www.cnblogs.com/xxaxx/archive/2009/12/29/1635300.html



上一篇: Imghash:相似图片搜索的php实现
下一篇: VB随机插入字符串
文章来自: 本站原创
引用通告: 查看所有引用 | 我要引用此文章
Tags: vb
相关日志:
评论: 0 | 引用: 0 | 查看次数: 2191
发表评论
昵　称:
密　码: 游客发言不需要密码.
邮　箱: 邮件地址支持Gravatar头像,邮箱地址不会公开.
网　址: 输入网址便于回访.
内　容:
验证码:
选　项:
虽然发表评论不用注册，但是为了保护您的发言权，建议您注册帐号.
字数限制 1000 字 | UBB代码 开启 | [img]标签 关闭

 广告位

↑返回顶部↑