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