我需要对VBScript中的字符串进行URL解码。该字符串可能包含Unicode字符，根据UTF-8编码为多个字节。因此，例如“巴黎％20％E2％86％92％20Z％C3％BCrich”将解码为“巴黎→苏黎世”。
为了完成这项工作，我正在使用一段看起来像这样的代码：
Function URLDecode(str)
set list = CreateObject("System.Collections.ArrayList")
strLen = Len(str)
for i = 1 to strLen
sT = mid(str, i, 1)
if sT = "%" then
if i + 2 <= strLen then
list.Add cbyte("&H" & mid(str, i + 1, 2))
i = i + 2
end if
else
list.Add asc(sT)
end if
next
depth = 0
for each by in list.ToArray()
if by and &h80 then
if (by and &h40) = 0 then
if depth = 0 then Err.Raise 5
val = val * 2 ^ 6 + (by and &h3f)
depth = depth - 1
if depth = 0 then
sR = sR & chrw(val)
val = 0
end if
elseif (by and &h20) = 0 then
if depth > 0 then Err.Raise 5
val = by and &h1f
depth = 1
elseif (by and &h10) = 0 then
if depth > 0 then Err.Raise 5
val = by and &h0f
depth = 2
else
Err.Raise 5
end if
else
if depth > 0 then Err.Raise 5
sR = sR & chrw(by)
end if
next
if depth > 0 then Err.Raise 5
URLDecode = sR
End Function
这似乎运作良好，但对我来说看起来很复杂。在HTML5和Web标准时代，必须有一种更简单的方法来完成这项工作，而无需一堆手工制作的循环和条件。有什么建议吗？
答案 0 :(得分：18)
我想为三种不同的环境展示三种方法。所有这些方法都需要JScript的encodeURIComponent和decodeURIComponent函数。
<强> 1。在ASP中，使用服务器端JavaScript是最合适的解决方案之一：
<script language="javascript" runat="server">
URL = {
encode : function(s){return encodeURIComponent(s).replace(/'/g,"%27").replace(/"/g,"%22")},
decode : function(s){return decodeURIComponent(s.replace(/\+/g, " "))}
}
</script>
<%
Response.Write URL.decode("Paris%20%E2%86%92%20Z%C3%BCrich")
Response.Write URL.encode("Paris → Zürich")
%>
<强> 2。任何其他WSH中仅32位（由于MSScriptControl.ScriptControl仅为32位组件）：
Dim JSEngine
Set JSEngine = CreateObject("MSScriptControl.ScriptControl")
JSEngine.Language = "JScript"
Function UrlEncode(s)
UrlEncode = JSEngine.CodeObject.encodeURIComponent(s)
UrlEncode = Replace(UrlEncode, "'", "%27")
UrlEncode = Replace(UrlEncode, """", "%22")
End Function
Function UrlDecode(s)
UrlDecode = Replace(s, "+", " ")
UrlDecode = JSEngine.CodeObject.decodeURIComponent(UrlDecode)
End Function
WScript.Echo UrlDecode("Paris%20%E2%86%92%20Z%C3%BCrich")
WScript.Echo UrlEncode("Paris → Zürich")
第3。在使用WSC的任何其他WSH中支持64位：
urlencdec.wsc （使用WSC Wizard创建）
<?xml version="1.0"?>
<component>
<?component error="true" debug="true"?>
<registration
description="Url Encode / Decode Helper"
progid="JSEngine.Url"
version="1.0"
classid="{80246bcc-45d4-4e92-95dc-4fd9a93d8529}"
/>
<public>
<method name="encode">
<PARAMETER name="s"/>
</method>
<method name="decode">
<PARAMETER name="s"/>
</method>
</public>
<script language="JScript">
<![CDATA[
var description = new UrlEncodeDecodeHelper;
function UrlEncodeDecodeHelper() {
this.encode = encode;
this.decode = decode;
}
function encode(s) {
return encodeURIComponent(s).replace(/'/g,"%27").replace(/"/g,"%22");
}
function decode(s) {
return decodeURIComponent(s.replace(/\+/g, " "));
}
]]>
</script>
</component>
和vbs代码：
Dim JSEngine
Set JSEngine = GetObject("Script:C:\urlencdec.wsc")
WScript.Echo JSEngine.decode("Paris%20%E2%86%92%20Z%C3%BCrich")
WScript.Echo JSEngine.encode("Paris → Zürich")
答案 1 :(得分：3)
纯vbs经典asp的 URLDecode 功能，支持utf-8。
<%
Function RegExTest(str,patrn)
Dim regEx
Set regEx = New RegExp
regEx.IgnoreCase = True
regEx.Pattern = patrn
RegExTest = regEx.Test(str)
End Function
Function URLDecode(sStr)
Dim str,code,a0
str=""
code=sStr
code=Replace(code,"+"," ")
While len(code)>0
If InStr(code,"%")>0 Then
str = str & Mid(code,1,InStr(code,"%")-1)
code = Mid(code,InStr(code,"%"))
a0 = UCase(Mid(code,2,1))
If a0="U" And RegExTest(code,"^%u[0-9A-F]{4}") Then
str = str & ChrW((Int("&H" & Mid(code,3,4))))
code = Mid(code,7)
ElseIf a0="E" And RegExTest(code,"^(%[0-9A-F]{2}){3}") Then
str = str & ChrW((Int("&H" & Mid(code,2,2)) And 15) * 4096 + (Int("&H" & Mid(code,5,2)) And 63) * 64 + (Int("&H" & Mid(code,8,2)) And 63))
code = Mid(code,10)
ElseIf a0>="C" And a0<="D" And RegExTest(code,"^(%[0-9A-F]{2}){2}") Then
str = str & ChrW((Int("&H" & Mid(code,2,2)) And 3) * 64 + (Int("&H" & Mid(code,5,2)) And 63))
code = Mid(code,7)
ElseIf (a0<="B" Or a0="F") And RegExTest(code,"^%[0-9A-F]{2}") Then
str = str & Chr(Int("&H" & Mid(code,2,2)))
code = Mid(code,4)
Else
str = str & "%"
code = Mid(code,2)
End If
Else
str = str & code
code = ""
End If
Wend
URLDecode = str
End Function
Response.Write URLDecode("Paris%20%E2%86%92%20Z%C3%BCrich") 'Paris → Zürich
%>
答案 2 :(得分：1)
此vbscript代码受@ kul-Tigin解决方案的启发，以便在Application Data文件夹中生成urlencdec.wsc并将其与相同的vbscript文件一起使用：
'Question : Decoding URL encoded UTF-8 strings in VBScript
'URL : https://stackoverflow.com/questions/17880395/decoding-url-encoded-utf-8-strings-in-vbscript?answertab=active#tab-top
Option Explicit
Dim JSEngine,ws,WSC
Set ws = CreateObject("WScript.Shell")
WSC = ws.ExpandEnvironmentStrings("%AppData%\urlencdec.wsc")
Call Create_URL_ENC_DEC_Component(WSC)
Set JSEngine = GetObject("Script:"& WSC)
WScript.Echo JSEngine.decode("%D9%81%D9%8A%D9%84%D9%85-21Bridges-2019-%D9%85%D8%AA%D8%B1%D8%AC%D9%85")
WScript.Echo JSEngine.encode("Paris → Zürich")
Sub Create_URL_ENC_DEC_Component(WSC)
Dim fso,File
Set fso = CreateObject("Scripting.FileSystemObject")
Set File = fso.OpenTextFile(WSC,2,True)
File.WriteLine "<?xml version=""1.0""?>"
File.WriteLine "<component>"
File.WriteLine "<?component error=""true"" debug=""true""?>"
File.WriteLine "<registration"
File.WriteLine "description=""Url Encode / Decode Helper"""
File.WriteLine "progid=""JSEngine.Url"""
File.WriteLine "version=""1.0"""
File.WriteLine "classid=""{80246bcc-45d4-4e92-95dc-4fd9a93d8529}"""
File.WriteLine "/>"
File.WriteLine "<public>"
File.WriteLine "<method name=""encode"">"
File.WriteLine "<PARAMETER name=""s""/>"
File.WriteLine "</method>"
File.WriteLine "<method name=""decode"">"
File.WriteLine "<PARAMETER name=""s""/>"
File.WriteLine "</method>"
File.WriteLine "</public>"
File.WriteLine "<script language=""JScript"">"
File.WriteLine "<![CDATA["
File.WriteLine "var description = new UrlEncodeDecodeHelper;"
File.WriteLine "function UrlEncodeDecodeHelper() {"
File.WriteLine "this.encode = encode;"
File.WriteLine "this.decode = decode;"
File.WriteLine "}"
File.WriteLine "function encode(s) {"
File.WriteLine "return encodeURIComponent(s).replace(/'/g,""%27"").replace(/""/g,""%22"");"
File.WriteLine "}"
File.WriteLine "function decode(s) {"
File.WriteLine "return decodeURIComponent(s.replace(/\+/g, "" ""));"
File.WriteLine "}"
File.WriteLine "]]>"
File.WriteLine "</script>"
File.WriteLine "</component>"
End Sub
答案 3 :(得分：0)
我的代码（不创建临时文件）
编码URI
Option Explicit
Const WshRunning = 0,WshFailed = 1:Dim cmd,text,arr,i
If WScript.Arguments.Count()=0 Then
text=CreateObject("HTMLFile").parentWindow.clipboardData.GetData("text")
Else
ReDim arr(WScript.Arguments.Count-1)
For i=0 To WScript.Arguments.Count-1:arr(i)=WScript.Arguments(i):Next
text=Join(arr)
End if
if IsNull(text) Then
WScript.Echo "No data to execute.."
else
text=Replace(text,"""","\%22")
text=Replace(text,"'","\%27")
cmd="for /f ""usebackq"" %i in " & _
"(`mshta ""javascript:Code(close(new ActiveXObject('Scripting.FileSystemObject').GetStandardStream(1).Write(" & _
"encodeURIComponent('" & text & "')" & _
")));""`) do set e=%i&set e=!e:'=%27!&set e=!e:(=%28!&set e=!e:)=%29!&echo !e!"
Dim shell : Set shell = CreateObject("WScript.Shell")
Dim exec : Set exec = shell.Exec("cmd /v /c " & cmd)
While exec.Status = WshRunning
WScript.Sleep 50
Wend
Dim output
Dim err
If exec.ExitCode = WshFailed Then
err = exec.StdErr.ReadAll
Else
output = Split(exec.StdOut.ReadAll,Chr(10))
End If
If err="" Then
WScript.Echo output(2)
Else
WScript.Echo "Error=" & err
End If
End if
解码URI
Option Explicit
Dim Kod
If WScript.Arguments.Count()=0 Then
Kod=CreateObject("HTMLFile").parentWindow.clipboardData.GetData("text")
Else
Kod=WScript.Arguments(0)
End if
if IsNull(Kod) Then
WScript.Echo "No data to execute.."
Else
Dim chunk,Recoded,k1,k2,k3,i:i=0:Dim arr:arr=Split(Kod,"%")
Do While i <= UBound(arr)
if i<>0 Then
chunk = Left(arr(i),2)
If "&H"&Left(chunk,2)>=128 then
arr(i)="":i=i+1:chunk = chunk & Left(arr(i),2)
If "&H"&Left(chunk,2)<224 then
k1=Cint("&H"&Left(chunk,2)) mod 32
k2 = Cint("&H"&Mid(chunk,3,2)) mod 64
Recoded=ChrW( k2 + k1 * 64 )
Else
arr(i)="":i=i+1:chunk = chunk & Left(arr(i),4)
k1=Cint("&H"&Left(chunk,2)) mod 16
k2 = Cint("&H"&Mid(chunk,3,2)) mod 32
k3 = Cint("&H"&Mid(chunk,5,2)) mod 64
Recoded=ChrW( k3 + ( k2 + k1 * 64 ) * 64 )
End if
Else Recoded=Chr("&H"&chunk)
End If
arr(i)=Recoded & Mid(arr(i),3)
end if:i=i+1
loop
Kod=Join(arr,""):WScript.Echo Kod
End if
答案 4 :(得分：-1)
使用VBS编码URL的最佳方法是使用encodeURIComponent（）javascript函数!! ScriptControl组件允许您从VBS环境运行js代码。
这是我的URLEncode函数，它与js函数完全相同（事实上，它调用它!!）：
Function URLEncode(str)
Dim encodedUrl
Set sc = CreateObject("MSScriptControl.ScriptControl")
sc.Language = "JScript"
sc.AddCode "var s = """ & str & """;"
sc.AddCode "function myEncode(s){return encodeURIComponent(s);}"
encodedUrl = sc.Eval("myEncode(s);")
Set sc = Nothing
URLEncode = encodedUrl
End Function