' Speichern als z.B. encode_url.vbs
' Starten mit URL als Parameter
' -> encode_url.vbs http://alant.de%2Fsonsiges
' Starten ohne URL -> Inputbox für die URL

Option Explicit

Dim sURL, wsh, oArgs, i, j, ie
Dim sC(15,1)

'Zeichen        Zeichenkette für Maskierung
sC(0,0) = " ": sC(0,1) = "%20"
sC(1,0) = "!": sC(1,1) = "%21"
sC(2,0) = "#": sC(2,1) = "%23"
sC(3,0) = "%": sC(3,1) = "%25"
sC(4,0) = "*": sC(4,1) = "%2A"
sC(5,0) = "/": sC(5,1) = "%2F"
sC(6,0) = "<": sC(6,1) = "%3C"
sC(7,0) = ">": sC(7,1) = "%3E"
sC(8,0) = "?": sC(8,1) = "%3F"
sC(9,0) = chr(196): sC(9,1) = "%C4" '"Ä"
sC(10,0) = chr(214): sC(10,1) = "%D6" '"Ö"
sC(11,0) = chr(220): sC(11,1) = "%DC" '"Ü"
sC(12,0) = chr(223): sC(12,1) = "%DF" '"ß"
sC(13,0) = chr(228): sC(13,1) = "%E4" '"ä"
sC(14,0) = chr(246): sC(14,1) = "%F6" '"ö"
sC(15,0) = chr(252): sC(15,1) = "%FC" '"ü"
'sC(,0) = "": sC(,1) = "%" 'Das Array vergrößern nicht vergessen

'Werden weitere Zeichen benötigt dann kann die Liste erweitert werden. Unter
'http://de.selfhtml.org/inter/zeichenkodierungen.htm
'den DezimalCode herauslesen und durch dez->Hex Umrechnung den Hex-Code berechnen.
'http://de.selfhtml.org/helferlein/dezhex.htm

Set oArgs = WScript.Arguments
Set wsh = CreateObject("WScript.Shell")
If oArgs.Count > 0 Then

sURL =  oArgs(0)

Else

sURL = InputBox("URL hierher kopieren !", "URL dekodieren")

End If

If IsEmpty(sURL) Or sURL="" Then

wsh.PopUp "Keine URL eingegeben !", 3 ', "",vbOK + vbError

WScript.Quit

End If

sURL = Replace(sURL, "\\", "//", 1, 1, vbTextCompare)
If Left(sURL, 1) = """" Then   sURL = Right(sURL, Len(sURL)-1)
If Right(sURL, 1) = """" Then   sURL = Left(sURL, Len(sURL)-1)


If InStr(1, sURL, " href="/"") Then

i = InStr(1, sURL, " href="/"") + 7

j = InStr(i, sURL, """")

sURL = Mid(sURL, i, j - i)

End If

If Left(sURL, 7) = "http://" Or Left(sURL, 8) = "https://" Then
'OK
ElseIf Left(sURL, 6) = "ttp://" Or Left(sURL, 7) = "ttps://" Then

sURL = "h" & sURL

ElseIf Left(sURL, 5) = "tp://" Or Left(sURL, 6) = "tps://" Then

sURL = "ht" & sURL

ElseIf Left(sURL, 4) = "p://" Or Left(sURL, 5) = "ps://" Then

sURL = "htt" & sURL

ElseIf Left(sURL, 3) = "://" Or Left(sURL, 4) = "s://" Then

sURL = "http" & sURL

ElseIf Left(sURL, 2) = "//" Then

sURL = "http:" & sURL

ElseIf Left(sURL, 1) = "/" Then

sURL = "http:/" & sURL

Else

sURL = "http://" & sURL

End If
For i = 0 To UBound(sC)

sURL = Replace(sURL, sC(i,1), sC(i,0))

Next

If wsh.popup("Soll die URL Im IExplorer gestartet werden:" & vbCrLf  & vbCrLf & sURL & _

vbCrLf  & vbCrLf & "Link wird In die Zwischenablage kopiert" & vbCrLf & _

"IEXplorer kann nachfragen ob die Seite auf die Zwischenablage zugreifen kann", 15, _

"Browser starten: Sie haben 15 Sek Zeit", vbYesNo + vbQuestion ) = vbYes Then

Set ie = WScript.CreateObject("InternetExplorer.Application")

On Error Resume Next

With ie

.navigate "about:blank"

.visible = True

Do While .busy

Loop

wsh.AppActivate("Leere Seite - Windows Internet Explorer")

.navigate sURL

.Document.parentWindow.clipboardData.setData "Text", sURL

    '.Quit 'IExplorer schließen

End With

End If