Hope This Helps

Benötigte Objekte :

Dim ObjWsh : Set ObjWsh = CreateObject("WScript.Shell")

Der Aufruf erfolgt durch :

ProductKey(ObjWsh.RegRead("HKLM\Software\Microsoft\Windows NT\CurrentVersion\DigitalProductId"))

Funktion :

Function ProductKey(REG_BINARY) ' von Base24
If (REG_BINARY(0) - 1) = UBound(REG_BINARY) Then ' Gültig ?
Const CHARS = "BCDFGHJKMPQRTVWXY2346789"
Dim strPK, i, j, k

For i = 24 To 0 Step -1
k = 0
For j = 66 To 52 Step -1
k = k * 256 Xor REG_BINARY(j)
REG_BINARY(j) = k \ 24 ' Base24
k = k Mod 24
Next

strPK = Mid(CHARS, k + 1, 1) & strPK
If CBool(i) And ((i Mod 5) = 0) Then strPK = "-" & strPK
Next
End If

ProductKey = strPK
End Function