16

I need to URL decode a string in a VBScript. The string may contain Unicode characters which are encoded as multiple bytes as per UTF-8. So for example "Paris%20%E2%86%92%20Z%C3%BCrich" would decode to "Paris → Zürich".

To do the job, I'm using a piece of code that looks like this:

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

This seems to be working well, but it looks exaggeratedly complex to me. In times of HTML5 and web standards, there must be a simpler way to get this done without a bunch of hand-made loops and conditions. Any suggestions?

5 Answers 5

27

I want to show three methods for three vary environments. All of these methods requires JScript's encodeURIComponent and decodeURIComponent functions.

1. In ASP, using server-side JavaScript is one of most appropriate solutions :

<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-Bit only (due to MSScriptControl.ScriptControl is 32-bit only component) in any other 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. With 64-bit support in any other WSH using a WSC:

urlencdec.wsc (created by using 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>

and vbs code :

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")
5
  • @ft1 I made a fix, bear in mind that if you used second solution.
    – Kul-Tigin
    Jul 30, 2013 at 15:59
  • 3
    Wow, had no idea you could mix JavaScript and VB like that. Mind = blown. This opens up a whole new world when stuck in classic ASP! Oct 30, 2013 at 21:28
  • 1
    Note that Request.Querystring() will automatically decode escaped characters for you, but this only helps if you're getting the encoded string via the querystring.
    – Martha
    Feb 24, 2016 at 21:34
  • @Martha true. BTW that implicit url decoding also applies to Request.Form and Request.Cookies.
    – Kul-Tigin
    Feb 24, 2016 at 21:58
  • 1
    Fantastic solution.
    – GWR
    Sep 28, 2016 at 19:21
7

Pure vbs classic asp of URLDecode function, with utf-8 support.

<%
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
%>
1

This vbscript code is inspired by @kul-Tigin solution in order to generate the urlencdec.wsc in Application Data folder and use it with the same vbscript file :

'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
1
  • There is only one thing I cannot understand. Why did you create the file in the %AppData% folder and not in %temp%
    – Garric
    Sep 16, 2020 at 14:04
0

The best way of encoding a URL using VBS is to use encodeURIComponent() javascript function!! The ScriptControl component allows you to run js code from a VBS environment.

Here's my URLEncode function, which works exactly the same as the js function (in fact, it calls it!!):

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
0

My code (without creating temporary files)

Encode 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

Decode 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

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.