URL (de)maskierung der Zeichenkette

' 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