请教老师们，如何把汉字转换成url编码(gb2312)

z1092212819

比如 早晨 对应转换成 %D4%E7%B3%BF 老师们，有空帮我一下啦，论坛逛遍了，木有找到呢。。。。

zss427607

Function encodeURI(strText As String) As String
    With CreateObject("msscriptcontrol.scriptcontrol")
        .Language = "JavaScript"
        encodeURI = .Eval("encodeURIComponent('" & strText & "');")
    End With
End Function
实时性不

z1092212819

zss427607 发表于 2015-2-12 19:30
Function encodeURI(strText As String) As String
    With CreateObject("msscriptcontrol.scriptcontro ...

神速啊，大哥

z1092212819

zss427607 发表于 2015-2-12 19:30
Function encodeURI(strText As String) As String
    With CreateObject("msscriptcontrol.scriptcontro ...

不过你给的好像不能用撒。。。

zss427607

Function EncodeURI(strTobecoded As String) As String
    With CreateObject("msscriptcontrol.scriptcontrol")
        .Language = "JavaScript"
        EncodeURI = .Eval("encodeURIComponent('" & strTobecoded & "');")
        'encodeURIComponent无法转换括号，所以再替换下括号
        EncodeURI = Replace(Replace(EncodeURI, "(", "%28"), ")", "%29")
    End With
End Function

sz_wap

z1092212819 发表于 2015-2-12 19:45
不过你给的好像不能用撒。。。

1. Sub test()
   
2. Dim a() As Byte
   
3. txt = "1早晨()"
   
4. a = StrConv(txt, vbFromUnicode, &H804)
   
5. For i = 0 To UBound(a)
   
6. URL = URL & "%" & Right("0" & Hex(a(i)), 2)
   
7. Next
   
8. MsgBox URL
   
9. End Sub
   

复制代码

香川群子

sz_wap 发表于 2015-2-13 09:24

改成自定义函数：

默认把汉字字符转为中文简体GB2312的URL码。
也可转为台湾繁体字码(第2参数="&H404")
或转为日文字码(第2参数="&H411")、或韩国字码(第2参数="&H412")

1. Function GetURL$(txt$, Optional LC = &H804) 'Taiwan &H404/Japan &H411/ Korea &H412
   
2.     Dim a() As Byte: a = StrConv(txt, vbFromUnicode, LC)
   
3.     For i = 0 To UBound(a)
   
4.         GetURL = GetURL & "%" & Right("0" & Hex(a(i)), 2)
   
5.     Next
   
6. End Function

复制代码

以及，所得本地URL码值转回字符串的自定义函数：
注意，限定转换本地本机码，外国字符码转不回来。
所以，本函数不能指定LCID参数，只能转为本地本机码，即只能使用Chr函数转换。

1. Function ChrURL$(txt$) 'Change URL To Chr
   
2.     txt = Replace(txt, "%", "")
   
3.     For i = 1 To Len(txt)
   
4.         t = Val("&H" & Mid(txt, i, 2))
   
5.         If t < 128 Then ChrURL = ChrURL & Chr(t): i = i + 1 Else ChrURL = ChrURL & Chr(Val("&H" & Mid(txt, i, 2)) * 256 + Val("&H" & Mid(txt, i + 2, 2))): i = i + 3
   
6.     Next
   
7. End Function
   

复制代码

香川群子

如需转为UTF码(国际通用双字节码、16进制码值前含有前导e)

则自定义函数如下：

1. Function GetUTF$(txt$, Optional k = 0) 'Change Txt To UTF
   
2.     For i = 1 To Len(txt)
   
3.         t = AscW(Mid(txt, i, 1)): If t < 0 Then t = 65536 + t
   
4.         If t < 128 Then r = r & Hex(t) Else r = r & "e" & Hex(t \ 4096) & Hex((t \ 64) Mod 64 + 128) & Hex(t Mod 64 + 128)
   
5.     Next
   
6.     If k Then GetUTF = r Else For i = 1 To Len(r) Step 2: GetUTF = GetUTF & "%" & Mid(r, i, 2): Next
   
7. End Function
   

复制代码

香川群子

上述UTF码转回字符串的自定义函数。

1. Function ChrU$(txt$) 'Change UTF To Chr or ChrW
   
2.     txt = Replace(txt, "%", "")
   
3.     For i = 1 To Len(txt)
   
4.         t = Val("&H" & Mid(txt, i, 2))
   
5.         If t < 128 Then ChrU = ChrU & Chr(t): i = i + 1 Else ChrU = ChrU & ChrW(Val("&H" & Mid(txt, i + 1, 1)) * 4096 + ((Val("&H" & Mid(txt, i + 2, 2)) - 128) * 64 + Val("&H" & Mid(txt, i + 4, 2)) - 128)): i = i + 5
   
6.     Next
   
7. End Function

复制代码

z1092212819

sz_wap 发表于 2015-2-13 09:24

谢谢老师啊，昨天已经找到了。。