ProductID to Product Key formula?

I know there are tools that can convert a ProductID
(AAAAA-BBB-CCCCCCC-DDDDD) back into a Product Key (
xxxxx-xxxxx-xxxxx-xxxxx-xxxxx), does anyone know where I can get the formula
to do this (or is there a built-in function to do this already)? I'd like
to add it to my HTA script and would prefer not to 'trust' an exe I didn't
write myself. I do remember reading articles on generating the ProductID
but not the other way around (years ago).

I'm using WMI and VBS in my HTA.

Currently my script uses WMI to get the following data:
-Disk usage by volume/Partition (Label, Format, Size, Free and used space,
%used)
-installation date
-OS version and SP level (IE "Windows Server 2000 Advanced SP4")
ToDo:
-top ten warnings and errors (App and SYS)
-event log archive and clear
-PC and DHCP lease counts (ADSI?)

Am Wed, 31 Jan 2007 17:17:54 -0800 schrieb Steven:

> I know there are tools that can convert a ProductID
> (AAAAA-BBB-CCCCCCC-DDDDD) back into a Product Key (
> xxxxx-xxxxx-xxxxx-xxxxx-xxxxx), does anyone know where I can get the formula
> to do this (or is there a built-in function to do this already)?

-------------------------------------------------------------------------------------
'Author: gecko_au2003
'Published:
http://www.experts-exchange.com/Oper..._20832633.html

Public Function sGetXPCDKey()

Dim bDigitalProductID
Dim bProductKey()
Dim bKeyChars(24)
Dim ilByte
Dim nCur
Dim sCDKey
Dim ilKeyByte
Dim ilBit

ReDim Preserve bProductKey(14)

Set objShell = CreateObject("WScript.Shell")

bDigitalProductID =
objShell.RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\MICROSOFT\Windows
NT\CurrentVersion\DigitalProductId")

Set objShell = Nothing

For ilByte = 52 To 66
bProductKey(ilByte - 52) = bDigitalProductID(ilByte)
Next

'Possible characters in the CD Key:
bKeyChars(0) = Asc("B")
bKeyChars(1) = Asc("C")
bKeyChars(2) = Asc("D")
bKeyChars(3) = Asc("F")
bKeyChars(4) = Asc("G")
bKeyChars(5) = Asc("H")
bKeyChars(6) = Asc("J")
bKeyChars(7) = Asc("K")
bKeyChars(8) = Asc("M")
bKeyChars(9) = Asc("P")
bKeyChars(10) = Asc("Q")
bKeyChars(11) = Asc("R")
bKeyChars(12) = Asc("T")
bKeyChars(13) = Asc("V")
bKeyChars(14) = Asc("W")
bKeyChars(15) = Asc("X")
bKeyChars(16) = Asc("Y")
bKeyChars(17) = Asc("2")
bKeyChars(18) = Asc("3")
bKeyChars(19) = Asc("4")
bKeyChars(20) = Asc("6")
bKeyChars(21) = Asc("7")
bKeyChars(22) = Asc("8")
bKeyChars(23) = Asc("9")

For ilByte = 24 To 0 Step -1

nCur = 0

For ilKeyByte = 14 To 0 Step -1
'Step through each byte in the Product Key
nCur = nCur * 256 Xor bProductKey(ilKeyByte)
bProductKey(ilKeyByte) = Int(nCur / 24)
nCur = nCur Mod 24
Next

sCDKey = Chr(bKeyChars(nCur)) & sCDKey
If ilByte Mod 5 = 0 And ilByte <> 0 Then sCDKey = "-" & sCDKey
Next

sGetXPCDKey = sCDKey


End Function

Public Function Question()
Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim Ans

Ans = MsgBox("Yes = Write Windows XP Serial key to the C Drive and No =
Prompt with Serial key",4)

If Ans = vbYes then

Set oOutFile = objFSO.CreateTextFile("c:\XP_Serial_Key.txt")

oOutFile.WriteLine sGetXPCDKey
else
wscript.echo sGetXPCDKey
End If
End Function

call Question
-------------------------------------------------------------------------------------

greetings
Carsten
--
http://got.to/quote - richtig zitieren | http://oe-faq.de/ - OE im Usenet
http://www.realname-diskussion.info - Realnames sind keine Pflicht
http://www.spamgourmet.com/ + http://www.temporaryinbox.com/ - Antispam
cakruege (at) gmail (dot) com | http://www.geocities.com/mungfaq/