VB URL的編解碼原始碼 GB2312 UTF-8編解碼
阿新 • • 發佈:2018-11-03
介面如下
原始碼如下
'UTF-8 URL解碼 Public Function UTF8_UrlDecode(ByVal URL As String) Dim B, ub ''中文字的Unicode碼(2位元組) Dim AA, BB Dim UtfB ''Utf-8單個位元組 Dim UtfB1, UtfB2, UtfB3 ''Utf-8碼的三個位元組 Dim i, n, s Dim str1 As String Dim str2 As String n = 0 ub = 0 For i = 1 To Len(URL) B = Mid(URL, i, 1) Select Case B Case "+" s = s & " " Case "%" ub = Mid(URL, i + 1, 2) If InStr(ub, vbLf) <= 0 And ub <> "" Then AA = Mid(ub, 1, 1) BB = Mid(ub, 2, 1) If AA < "g" And AA < "G" And BB < "g" And BB < "G" And AA <> "%" And BB <> "%" Then UtfB = CInt("&H" & ub) End If End If If UtfB < 128 Then i = i + 2 s = s & ChrW(UtfB) Else UtfB1 = (UtfB And &HF) * &H1000 ''取第1個Utf-8位元組的二進位制後4位 str1 = Mid(URL, i + 4, 2) If InStr(str1, vbLf) <= 0 And str1 <> "" Then AA = Mid(str1, 1, 1) BB = Mid(str1, 2, 1) If AA < "g" And AA < "G" And BB < "g" And BB < "G" And AA <> "%" And BB <> "%" Then UtfB2 = (CInt("&H" & str1) And &H3F) * &H40 ''取第2個Utf-8位元組的二進位制後6位 End If str2 = Mid(URL, i + 7, 2) If InStr(str2, vbLf) <= 0 And str2 <> "" Then AA = Mid(str2, 1, 1) BB = Mid(str2, 2, 1) If AA < "g" And AA < "G" And BB < "g" And BB < "G" And AA <> "%" And BB <> "%" Then UtfB3 = CInt("&H" & str2) And &H3F ''取第3個Utf-8位元組的二進位制後6位 End If End If End If s = s & ChrW(UtfB1 Or UtfB2 Or UtfB3) i = i + 8 End If Case Else ''Ascii碼 s = s & B End Select Next UTF8_UrlDecode = s End Function 'UTF-8編碼 Public Function UTF8_URLEncoding(szInput) Dim wch, uch, szRet Dim x Dim nAsc, nAsc2, nAsc3 If szInput = "" Then UTF8_URLEncoding = szInput Exit Function End If For x = 1 To Len(szInput) wch = Mid(szInput, x, 1) nAsc = AscW(wch) If nAsc < 0 Then nAsc = nAsc + 65536 If (nAsc And &HFF80) = 0 Then szRet = szRet & wch Else If (nAsc And &HF000) = 0 Then uch = "%" & Hex(((nAsc \ 2 ^ 6)) Or &HC0) & Hex(nAsc And &H3F Or &H80) szRet = szRet & uch Else uch = "%" & Hex((nAsc \ 2 ^ 12) Or &HE0) & "%" & _ Hex((nAsc \ 2 ^ 6) And &H3F Or &H80) & "%" & _ Hex(nAsc And &H3F Or &H80) szRet = szRet & uch End If End If Next UTF8_URLEncoding = szRet End Function 'GB2312 URL解碼 Public Function GB_UrlDecode(ByVal URL As String) As String Dim i As Long, c As String, d As Long i = 1 While i <= Len(URL) c = Mid$(URL, i, 1) i = i + 1 If c = "%" Then d = Val("&H" & Mid$(URL, i, 2)) If d >= 128 Then d = d * 256 + Val("&H" & Mid$(URL, i + 3, 2)) i = i + 5 Else i = i + 2 End If GB_UrlDecode = GB_UrlDecode + Chr$(d) Else GB_UrlDecode = GB_UrlDecode + c End If Wend End Function 'GB2312 URL編碼 Public Function GB_URLEncode(ByRef strURL) Dim i Dim tempStr For i = 1 To Len(strURL) If InStr("-,.0123456789/", Mid(strURL, i, 1)) Then GB_URLEncode = GB_URLEncode & Mid(strURL, i, 1) Else If Asc(Mid(strURL, i, 1)) < 0 Then tempStr = "%" & Right(CStr(Hex(Asc(Mid(strURL, i, 1)))), 2) tempStr = "%" & Left(CStr(Hex(Asc(Mid(strURL, i, 1)))), Len(CStr(Hex(Asc(Mid(strURL, i, 1))))) - 2) & tempStr GB_URLEncode = GB_URLEncode & tempStr ElseIf (Asc(Mid(strURL, i, 1)) >= 65 And Asc(Mid(strURL, i, 1)) <= 90) Or (Asc(Mid(strURL, i, 1)) >= 97 And Asc(Mid(strURL, i, 1)) <= 122) Then GB_URLEncode = GB_URLEncode & Mid(strURL, i, 1) Else GB_URLEncode = GB_URLEncode & "%" & Hex(Asc(Mid(strURL, i, 1))) End If End If Next End Function 'GET /suggest/word?callback=suggest_so&encodein=utf-8&encodeout=utf-8&word=%E4%B8%AD%E5%9B%BD&_jsonp=suggest_so HTTP/1.1 Private Sub Command1_Click(Index As Integer) Text2.Text = GB_UrlDecode(Text1.Text) 'GB2312解碼 End Sub Private Sub Command2_Click(Index As Integer) Text2.Text = GB_URLEncode(Text1.Text) 'GB2312編碼 End Sub Private Sub Command3_Click(Index As Integer) Text2.Text = UTF8_UrlDecode(Text1.Text) 'UTF-8解碼 End Sub Private Sub Command4_Click(Index As Integer) Text2.Text = UTF8_URLEncoding(Text1.Text) 'UTF-8編碼 End Sub Private Sub Command5_Click() Text1.Text = "" Text2.Text = "" End Sub Private Sub Form_Load() Text1.Text = "" Text2.Text = "" Text1.FontSize = 10 Text2.FontSize = 10 End Sub Private Sub Option1_Click(Index As Integer) Text1.FontSize = 24 Text2.FontSize = 24 End Sub Private Sub Option2_Click(Index As Integer) Text1.FontSize = 22 Text2.FontSize = 22 End Sub Private Sub Option3_Click(Index As Integer) Text1.FontSize = 20 Text2.FontSize = 20 End Sub Private Sub Option4_Click(Index As Integer) Text1.FontSize = 18 Text2.FontSize = 18 End Sub Private Sub Option5_Click(Index As Integer) Text1.FontSize = 16 Text2.FontSize = 16 End Sub Private Sub Option6_Click(Index As Integer) Text1.FontSize = 14 Text2.FontSize = 14 End Sub Private Sub Option7_Click(Index As Integer) Text1.FontSize = 12 Text2.FontSize = 12 End Sub Private Sub Option8_Click(Index As Integer) Text1.FontSize = 10 Text2.FontSize = 10 End Sub '組合鍵函式 Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer) Static intCode As Integer If Shift = 2 And (KeyCode = Asc("a") Or KeyCode = Asc("A")) Then Screen.ActiveControl.SelStart = 0 Screen.ActiveControl.SelLength = Len(Screen.ActiveControl.Text) End If intCode = KeyCode End Sub Private Sub Text2_KeyDown(KeyCode As Integer, Shift As Integer) Static intCode As Integer If Shift = 2 And (KeyCode = Asc("a") Or KeyCode = Asc("A")) Then Screen.ActiveControl.SelStart = 0 Screen.ActiveControl.SelLength = Len(Screen.ActiveControl.Text) End If intCode = KeyCode End Sub Private Sub V_Click() '貼上 Form1.ActiveControl.SelText = Clipboard.GetText() End Sub
網盤原始碼下載地址
http://pan.baidu.com/s/1ges3JUz