1. 程式人生 > >VB URL的編解碼原始碼 GB2312 UTF-8編解碼

VB URL的編解碼原始碼 GB2312 UTF-8編解碼

介面如下


原始碼如下

'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