Dim $bProductKey[15] For $i = 52*2-1 To 66*2-1 Step 2 $bProductKey[($i-(52*2-1))/2]=Execute("Exit &"+SubStr($sProductId,$i,2)) Next
;Now we are going to 'base24' decode the Product Key
For $ilByte = 24 To 0 Step -1 ;Step through each character in the CD key $nCur = 0.0
For $i=14 To 0 Step -1 ;Step through each byte in the Product Key $nCur = $nCur * 256 ^ (CInt($bProductKey[$i])& &FF) ; NOTE THE XOR! $bProductKey[$i] = Int($nCur / 24) $nCur = $nCur Mod 24 Next
$sCDKey = Chr($aiKeyChars[$nCur]) + $sCDKey If $ilByte Mod 5 = 0 And $ilByte <> 0 $sCDKey = "-" + $sCDKey EndIf Next $sCDKey ?
; vim600: sw=4 ts=4 ai fdc=4 fdm=marker
Unfortunately I have to deal with an Exchange 5.5 restore so I'm not going to take it any further - somethings not quite right, either I'm picking up the wrong offset of the math is screwy.
Note the "^" - this resquires 4.50 RC1 which has XOR built in.
Dim $bProductKey[15] For $i = 53*2-1 To 67*2-1 Step 2 $bProductKey[($i-(53*2-1))/2]=Execute("Exit &"+SubStr($sProductId,$i,2)) Next
;Now we are going to 'base24' decode the Product Key
For $ilByte = 24 To 0 Step -1 ;Step through each character in the CD key $nCur = 0
For $i=14 To 0 Step -1 ;Step through each byte in the Product Key $nCur = $nCur * 256 ^ $bProductKey[$i] ; NOTE THE XOR! $bProductKey[$i] = Int($nCur / 24) $nCur = $nCur Mod 24 Next $sCDKey = Chr($aiKeyChars[$nCur]) + $sCDKey If $ilByte Mod 5 = 0 And $ilByte <> 0 $sCDKey = "-" + $sCDKey EndIf Next
It works with Office 2003 and SQL Server 2000, some quick code to do this is shown below. Finding the location of the Office 2003 key is a bit of a hack, there may be a more elegant way. The code would need error checking added before being put in to production use. Code:
Thanks Christian - works well on my system. Thanks for Registering to post this.
Code:
Internet Explorer (appears to be the same as Windows key) HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Internet Explorer\Registration
Microsoft Office Professional Edition 2003 HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Office\11.0\Registration\{90110409-6000-11D3-8CFE-0150048383C9}
Microsoft Office Visio Professional 2003 HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Office\11.0\Registration\{90510409-6000-11D3-8CFE-0150048383C9}
Windows Product Activation (appears to be the same as Windows key) HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Session Manager\WPA\Key-CJ27J3P2XV9J9JCPB4DVT
Windows Product Activation (appears to be the same as Windows key) HKEY_LOCAL_MACHINE\SYSTEM\WPA\Key-CJ27J3P2XV9J9JCPB4DVT
I'd like to see the UDF include "known product" registry locations. ie... getproductkey(1) = XP, getproductkey(2) = OfficeXP, etc. But also leave it open to future registry locations that can be typed in like it is now.
But for my use I'll probably only use this for the XP key.
Code:
Break ON $=SetOption("WrapAtEOL","ON")
function GetProductKey (optional $sProductID) Dim $aiKeyChars[24],$bProductKey[15],$ilByte,$i,$sCDKey if $sProductID="" $sProductID=ReadValue("HKEY_LOCAL_MACHINE\SOFTWARE\MICROSOFT\Windows NT\CurrentVersion","DigitalProductID") endif $aiKeyChars = Split('B,C,D,F,G,H,J,K,M,P,Q,R,T,V,W,X,Y,2,3,4,6,7,8,9',',')
for $i = 0 to 14 $bProductKey[$i] = val("&"+substr($sProductID,$i*2+105,2)) next
$sCDKey = "" For $ilByte = 24 To 0 Step -1 $nCur = 0
For $i=14 To 0 Step -1 $nCur = $nCur * 256 | $bProductKey[$i] $bProductKey[$i] = Int($nCur / 24) $nCur = $nCur Mod 24 Next $sCDKey = $aiKeyChars[$nCur] + $sCDKey If $ilByte Mod 5 = 0 And $ilByte <> 0 $sCDKey = "-" + $sCDKey EndIf Next $GetProductKey = $sCDKey endfunction
This needed a little updating for x64 systems and to take in consideration the newer DigitalProductID for Office 2010. I couldn't figure out the Golfed version's math, so I reverted to the original version above.
Office 2010 does not have a ProductID to give you easy way out for the Product Name, so I did the best I could. If someone knows a better way, please update this.