' 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(34,1)

'Zeichen        Zeichenkette für Maskierung
i = 0
sC(i,0) = " ": sC(i,1) = "%20":i=i+1 '32
sC(i,0) = "!": sC(i,1) = "%21":i=i+1 '33
sC(i,0) = "#": sC(i,1) = "%23":i=i+1 '35
sC(i,0) = "$": sC(i,1) = "%24":i=i+1 '36
sC(i,0) = "%": sC(i,1) = "%25":i=i+1 '37
sC(i,0) = "&": sC(i,1) = "%26":i=i+1 '38
sC(i,0) = "(": sC(i,1) = "%28":i=i+1 '40
sC(i,0) = ")": sC(i,1) = "%29":i=i+1 '41
sC(i,0) = "*": sC(i,1) = "%2A":i=i+1 '42
sC(i,0) = "+": sC(i,1) = "%2B":i=i+1 '43
sC(i,0) = "/": sC(i,1) = "%2F":i=i+1 '47
sC(i,0) = ":": sC(i,1) = "%3A":i=i+1 '58
sC(i,0) = ";": sC(i,1) = "%3A":i=i+1 '59
sC(i,0) = "<": sC(i,1) = "%3C":i=i+1 '60
sC(i,0) = "=": sC(i,1) = "%3D":i=i+1 '61
sC(i,0) = ">": sC(i,1) = "%3E":i=i+1 '62
sC(i,0) = "?": sC(i,1) = "%3F":i=i+1 '63
sC(i,0) = "[": sC(i,1) = "%5B":i=i+1 '91
sC(i,0) = "\": sC(i,1) = "%5C":i=i+1 '92
sC(i,0) = "]": sC(i,1) = "%5D":i=i+1 '93
sC(i,0) = "{": sC(i,1) = "%7B":i=i+1 '123
sC(i,0) = "|": sC(i,1) = "%7C":i=i+1 '124
sC(i,0) = "}": sC(i,1) = "%7D":i=i+1 '125
sC(i,0) = "}": sC(i,1) = "%7E":i=i+1 '126
sC(i,0) = chr(196): sC(i,1) = "%C4":i=i+1  '"Ä"
sC(i,0) = chr(214): sC(i,1) = "%D6":i=i+1  '"Ö"
sC(i,0) = chr(220): sC(i,1) = "%DC":i=i+1  '"Ü"
sC(i,0) = chr(223): sC(i,1) = "%DF":i=i+1  '"ß"
sC(i,0) = chr(228): sC(i,1) = "%E4":i=i+1  '"ä"
sC(i,0) = chr(246): sC(i,1) = "%F6":i=i+1  '"ö"
sC(i,0) = chr(252): sC(i,1) = "%FC":i=i+1  '"ü"
'sC(i,0) = "": sC(i,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