1500字范文,内容丰富有趣,写作好帮手!
1500字范文 > VB URL的编解码源码 GB2312 UTF-8编解码

VB URL的编解码源码 GB2312 UTF-8编解码

时间:2023-10-25 00:48:45

相关推荐

VB URL的编解码源码 GB2312 UTF-8编解码

界面如下

源码如下

'UTF-8 URL解码Public Function UTF8_UrlDecode(ByVal URL As String)Dim B, ub ''中文字的Unicode码(2字节)Dim AA, BBDim UtfB ''Utf-8单个字节Dim UtfB1, UtfB2, UtfB3 ''Utf-8码的三个字节Dim i, n, sDim str1 As StringDim str2 As Stringn = 0ub = 0For i = 1 To Len(URL)B = Mid(URL, i, 1)Select Case BCase "+"s = s & " "Case "%"ub = Mid(URL, i + 1, 2)If InStr(ub, vbLf) <= 0 And ub <> "" ThenAA = 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 <> "%" ThenUtfB = CInt("&H" & ub)End IfEnd IfIf UtfB < 128 Theni = i + 2s = s & ChrW(UtfB)ElseUtfB1 = (UtfB And &HF) * &H1000 ''取第1个Utf-8字节的二进制后4位str1 = Mid(URL, i + 4, 2)If InStr(str1, vbLf) <= 0 And str1 <> "" ThenAA = 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 <> "%" ThenUtfB2 = (CInt("&H" & str1) And &H3F) * &H40''取第2个Utf-8字节的二进制后6位End Ifstr2 = Mid(URL, i + 7, 2)If InStr(str2, vbLf) <= 0 And str2 <> "" ThenAA = 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 <> "%" ThenUtfB3 = CInt("&H" & str2) And &H3F''取第3个Utf-8字节的二进制后6位End IfEnd IfEnd Ifs = s & ChrW(UtfB1 Or UtfB2 Or UtfB3)i = i + 8End IfCase Else ''Ascii码s = s & BEnd SelectNextUTF8_UrlDecode = sEnd Function'UTF-8编码Public Function UTF8_URLEncoding(szInput)Dim wch, uch, szRetDim xDim nAsc, nAsc2, nAsc3If szInput = "" ThenUTF8_URLEncoding = szInputExit FunctionEnd IfFor x = 1 To Len(szInput)wch = Mid(szInput, x, 1)nAsc = AscW(wch)If nAsc < 0 Then nAsc = nAsc + 65536If (nAsc And &HFF80) = 0 ThenszRet = szRet & wchElseIf (nAsc And &HF000) = 0 Thenuch = "%" & Hex(((nAsc \ 2 ^ 6)) Or &HC0) & Hex(nAsc And &H3F Or &H80)szRet = szRet & uchElseuch = "%" & Hex((nAsc \ 2 ^ 12) Or &HE0) & "%" & _Hex((nAsc \ 2 ^ 6) And &H3F Or &H80) & "%" & _Hex(nAsc And &H3F Or &H80)szRet = szRet & uchEnd IfEnd IfNextUTF8_URLEncoding = szRetEnd Function'GB2312 URL解码Public Function GB_UrlDecode(ByVal URL As String) As StringDim i As Long, c As String, d As Longi = 1While i <= Len(URL)c = Mid$(URL, i, 1)i = i + 1If c = "%" Thend = Val("&H" & Mid$(URL, i, 2))If d >= 128 Thend = d * 256 + Val("&H" & Mid$(URL, i + 3, 2))i = i + 5Elsei = i + 2End IfGB_UrlDecode = GB_UrlDecode + Chr$(d)ElseGB_UrlDecode = GB_UrlDecode + cEnd IfWendEnd Function'GB2312 URL编码Public Function GB_URLEncode(ByRef strURL)Dim iDim tempStrFor i = 1 To Len(strURL)If InStr("-,.0123456789/", Mid(strURL, i, 1)) ThenGB_URLEncode = GB_URLEncode & Mid(strURL, i, 1)ElseIf Asc(Mid(strURL, i, 1)) < 0 ThentempStr = "%" & 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) & tempStrGB_URLEncode = GB_URLEncode & tempStrElseIf (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) ThenGB_URLEncode = GB_URLEncode & Mid(strURL, i, 1)ElseGB_URLEncode = GB_URLEncode & "%" & Hex(Asc(Mid(strURL, i, 1)))End IfEnd IfNextEnd 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.1Private Sub Command1_Click(Index As Integer)Text2.Text = GB_UrlDecode(Text1.Text) 'GB2312解码End SubPrivate Sub Command2_Click(Index As Integer)Text2.Text = GB_URLEncode(Text1.Text) 'GB2312编码End SubPrivate Sub Command3_Click(Index As Integer)Text2.Text = UTF8_UrlDecode(Text1.Text) 'UTF-8解码End SubPrivate Sub Command4_Click(Index As Integer)Text2.Text = UTF8_URLEncoding(Text1.Text) 'UTF-8编码End SubPrivate Sub Command5_Click()Text1.Text = ""Text2.Text = ""End SubPrivate Sub Form_Load()Text1.Text = ""Text2.Text = ""Text1.FontSize = 10Text2.FontSize = 10End SubPrivate Sub Option1_Click(Index As Integer)Text1.FontSize = 24Text2.FontSize = 24End SubPrivate Sub Option2_Click(Index As Integer)Text1.FontSize = 22Text2.FontSize = 22End SubPrivate Sub Option3_Click(Index As Integer)Text1.FontSize = 20Text2.FontSize = 20End SubPrivate Sub Option4_Click(Index As Integer)Text1.FontSize = 18Text2.FontSize = 18End SubPrivate Sub Option5_Click(Index As Integer)Text1.FontSize = 16Text2.FontSize = 16End SubPrivate Sub Option6_Click(Index As Integer)Text1.FontSize = 14Text2.FontSize = 14End SubPrivate Sub Option7_Click(Index As Integer)Text1.FontSize = 12Text2.FontSize = 12End SubPrivate Sub Option8_Click(Index As Integer)Text1.FontSize = 10Text2.FontSize = 10End Sub'组合键函数Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)Static intCode As IntegerIf Shift = 2 And (KeyCode = Asc("a") Or KeyCode = Asc("A")) ThenScreen.ActiveControl.SelStart = 0Screen.ActiveControl.SelLength = Len(Screen.ActiveControl.Text)End IfintCode = KeyCodeEnd SubPrivate Sub Text2_KeyDown(KeyCode As Integer, Shift As Integer)Static intCode As IntegerIf Shift = 2 And (KeyCode = Asc("a") Or KeyCode = Asc("A")) ThenScreen.ActiveControl.SelStart = 0Screen.ActiveControl.SelLength = Len(Screen.ActiveControl.Text)End IfintCode = KeyCodeEnd SubPrivate Sub V_Click() '粘贴Form1.ActiveControl.SelText = Clipboard.GetText()End Sub

源码下载

/download/gs1069405343/11029128

本内容不代表本网观点和政治立场,如有侵犯你的权益请联系我们处理。
网友评论
网友评论仅供其表达个人看法,并不表明网站立场。