Option Explicit
Wscript.echo "Microsoft Windows-Key: " & DecodeKey(CreateObject( _
  "WScript.Shell").RegRead("HKLM\Software\Microsoft\Windows" & _
  "NT\CurrentVersion\DigitalProductId"))
Wscript.echo "Microsoft Office 2003-Key: " & DecodeKey(CreateObject( _
"WScript.Shell").RegRead( _
"HKLM\Software\Microsoft\Office\11.0\Registration\{90110407-6000-11D3-8CFE-015" & _
"048383C9}\DigitalProductId"))
 
Function DecodeKey(arrBinary)
  Const CHARS = "BCDFGHJKMPQRTVWXY2346789" 
  Dim retVal, i, j, k 
 
  For i = 24 To 0 Step -1 
    k = 0 
    For j = 66 To 52 Step -1 
      k = k * 256 Xor arrBinary(j) 
      arrBinary(j) = k \ 24
      k = k Mod 24 
    Next 
    retVal = Mid(CHARS, k + 1, 1) & retVal 
    If CBool(i) And ((i Mod 5) = 0) Then
      retVal = "-" & retVal
    End If
  Next 
  DecodeKey = retVal
End Function