VB版URLEncode

 

  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
105 

 

 

转载于:https://www.cnblogs.com/xxaxx/archive/2009/12/29/1635300.html