Set WshShell = CreateObject("WScript.Shell")
WScript.echo decode(WshShell.RegRead(WScript.Arguments(0)))

Function decode(id)
  Dim WinNew, Map, Out, A, B, C, D, E, F
  WinNew = (id(66) \ 6) And 1
  id(66) = (id(66) And &HF7) Or ((WinNew And 2) * 4)
  A = 24
  Map = "BCDFGHJKMPQRTVWXY2346789"
  Do
    B = 14
    C = 0
    Do
      C = C * 256
      C = id(B + 52) + C
      id(B + 52) = (C \ 24)
      C = C Mod 24
      B = B -1
    Loop While B >= 0
    A = A - 1
    Out = Mid(Map, C + 1, 1) & Out
    E = C
  Loop While A >= 0
  If (WinNew = 1) Then
    D = Mid(Out, 2, E)
    F = "N"
    Out = Replace(Out, D, D & F, 2, 1, 0)
    If E = 0 Then Out = F & Out
  End If
  decode = Mid(Out, 1, 5) & "-" & Mid(Out, 6, 5) & "-" & Mid(Out, 11, 5) & "-" & Mid(Out, 16, 5) & "-" & Mid(Out, 21, 5)
End Function

' Urheber der Funktion leider unbekannt. Sachdienliche Hinweise bitte an axv@ct.de, danke.