Расшифровка URL-кодированных строк UTF-8 в VBScript
Мне нужно URL декодировать строку в VBScript. Строка может содержать символы Unicode, которые закодированы как несколько байтов согласно UTF-8. Так, например, "Paris%20%E2%86%92%20Z%C3%BCrich" расшифровывается как "Paris → Zürich".
Чтобы сделать работу, я использую кусок кода, который выглядит следующим образом:
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 и веб-стандартов должен существовать более простой способ сделать это без нескольких ручных циклов и условий. Какие-либо предложения?
3 ответа
Решение
Я хочу показать три метода для трех разных сред. Все эти методы требуют 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. Только 32-битный (из-за MSScriptControl.ScriptControl является 32-битным компонентом) в любом другом WSH:
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. С поддержкой 64-бит в любом другом WSH с использованием WSC:
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")
Pure vbs classic 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
%>
Этот код vbscript вдохновлен решением @kul-Tigin для создания urlencdec.wsc в папке Application Data и используйте его с тем же файлом vbscript:
'Question : Decoding URL encoded UTF-8 strings in VBScript
'URL : https://stackru.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
Лучший способ кодирования URL с использованием VBS - использовать функцию javascript encodeURIComponent()!! Компонент ScriptControl позволяет запускать код js из среды VBS.
Вот моя функция URLEncode, которая работает точно так же, как и функция js (на самом деле она вызывает ее!!):
Функция 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
Конечная функция
Мой код (без создания временных файлов)
Кодировать 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