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
源码下载
https://download.csdn.net/download/gs1069405343/11029128