Page 2 of 3 <123>
Topic Options
#142317 - 2005-06-27 09:25 PM Re: Cd Key lookup.
Jose Offline
Seasoned Scripter
*****

Registered: 2001-04-04
Posts: 693
Loc: Buenos Aires - Argentina

Very logical lonkero´s style. je je. Me trying to understand it.
_________________________
Life is fine.

Top
#142318 - 2005-06-29 02:08 AM Re: Cd Key lookup.
Richard H. Administrator Offline
Administrator
*****

Registered: 2000-01-24
Posts: 4946
Loc: Leatherhead, Surrey, UK
Got this far with it:
Code:
Break ON
$=SetOption("WrapAtEOL","ON")

Dim $aiKeyChars[24]
Dim $sProductID
Dim $ilByte
Dim $i

$i=0
For Each $c In 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")
$aiKeyChars[$i]=Asc($c)
$i=$i+1
Next

$sProductID=ReadValue("HKEY_LOCAL_MACHINE\SOFTWARE\MICROSOFT\Windows NT\CurrentVersion","DigitalProductID")

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.

Top
#142319 - 2005-07-03 06:16 AM Re: Cd Key lookup.
Allen Administrator Online   shocked
KiX Supporter
*****

Registered: 2003-04-19
Posts: 4520
Loc: USA
Lonk, Richard... any luck figuring this out?
Top
#142320 - 2005-07-03 07:20 AM Re: Cd Key lookup.
Lonkero Administrator Offline
KiX Master Guru
*****

Registered: 2001-06-05
Posts: 22344
Loc: OK
nah, been too busy with my video scroll trough that haven't been able to do anything usefull.
_________________________
!

download KiXnet

Top
#142321 - 2005-09-08 02:21 PM Re: Cd Key lookup.
CJPinder Offline
Lurker

Registered: 2005-09-08
Posts: 4
Hi All,

I fixed a couple of things in Richard's code. The working script is below...
Code:

Break ON
$=SetOption("WrapAtEOL","ON")

Dim $aiKeyChars[24]
Dim $sProductID
Dim $ilByte
Dim $i

$i=0
For Each $c In 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")
$aiKeyChars[$i]=Asc($c)
$i=$i+1
Next

$sProductID=ReadValue("HKEY_LOCAL_MACHINE\SOFTWARE\MICROSOFT\Windows NT\CurrentVersion","DigitalProductID")

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

$sCDKey ?



I hope that helps.
Regards,
Christian

Top
#142322 - 2005-09-08 02:31 PM Re: Cd Key lookup.
Lonkero Administrator Offline
KiX Master Guru
*****

Registered: 2001-06-05
Posts: 22344
Loc: OK
you missed the "get $" but otherwise, nice...

thanks.
_________________________
!

download KiXnet

Top
#142323 - 2005-09-08 02:44 PM Re: Cd Key lookup.
Richard H. Administrator Offline
Administrator
*****

Registered: 2000-01-24
Posts: 4946
Loc: Leatherhead, Surrey, UK
Thanks for finishing that off Christian, the offset count was giving me a headache!
Top
#142324 - 2005-09-08 04:07 PM Re: Cd Key lookup.
Allen Administrator Online   shocked
KiX Supporter
*****

Registered: 2003-04-19
Posts: 4520
Loc: USA
Very nice! Christian, Richard... Do one of you want to add this to the UDF collection?
Top
#142325 - 2005-09-08 04:48 PM Re: Cd Key lookup.
CJPinder Offline
Lurker

Registered: 2005-09-08
Posts: 4
Here's a slightly modified version packaged in a function.
Code:

Break ON
$=SetOption("WrapAtEOL","ON")

function get_product_key ($sProductID)
Dim $aiKeyChars[24]
Dim $ilByte
Dim $i
Dim $bProductKey[15]
Dim $sCDKey

$aiKeyChars = '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
$get_product_key = $sCDKey
endfunction

$dpi=ReadValue("HKEY_LOCAL_MACHINE\SOFTWARE\MICROSOFT\Windows NT\CurrentVersion","DigitalProductID")
$key = get_product_key($dpi)
? "Windows Product Key: " + $key

? "Press any key..."
get $



Does anyone have any suggestions on the most appropriate name for the function?

Regards,
Christian.


Edited by CJPinder (2005-09-08 05:39 PM)

Top
#142326 - 2005-09-08 05:10 PM Re: Cd Key lookup.
Lonkero Administrator Offline
KiX Master Guru
*****

Registered: 2001-06-05
Posts: 22344
Loc: OK
now...
what product keys this works with?
_________________________
!

download KiXnet

Top
#142327 - 2005-09-08 05:50 PM Re: Cd Key lookup.
CJPinder Offline
Lurker

Registered: 2005-09-08
Posts: 4
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:

$offkey = "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Office\11.0\Registration"
$offkey = $offkey + "\" + EnumKey($offkey,0)
$dpi = ReadValue($offkey, "DigitalProductID")
$key = get_product_key($dpi)
? "Office 2003 Product Key: " + $key

$dpi=ReadValue("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Microsoft SQL Server\80\Registration","DigitalProductID")
$key = get_product_key($dpi)
? "SQL Server 2000 Product Key: " + $key



It probably works with other Microsoft products but I don't have any others installed to try it with.

Regards,
Christian.

Top
#142328 - 2005-09-08 06:53 PM Re: Cd Key lookup.
Lonkero Administrator Offline
KiX Master Guru
*****

Registered: 2001-06-05
Posts: 22344
Loc: OK
w2k - works.
_________________________
!

download KiXnet

Top
#142329 - 2005-09-08 09:28 PM Re: Cd Key lookup.
Chris S. Offline
MM club member
*****

Registered: 2002-03-18
Posts: 2368
Loc: Earth
Just to golf it down a little...

Code:

Break ON
$=SetOption("WrapAtEOL","ON")

function get_product_key ($sProductID)
Dim $aiKeyChars[24],$bProductKey[15],$ilByte,$i,$sCDKey

$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
$get_product_key = $sCDKey
endfunction

$dpi=ReadValue("HKEY_LOCAL_MACHINE\SOFTWARE\MICROSOFT\Windows NT\CurrentVersion","DigitalProductID")
$key = get_product_key($dpi)
? "Windows Product Key: " + $key

? "Press any key..."
get $



Top
#142330 - 2005-09-08 10:19 PM Re: Cd Key lookup.
NTDOC Administrator Offline
Administrator
*****

Registered: 2000-07-28
Posts: 11611
Loc: CA
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



Top
#142331 - 2005-09-08 11:05 PM Re: Cd Key lookup.
Allen Administrator Online   shocked
KiX Supporter
*****

Registered: 2003-04-19
Posts: 4520
Loc: USA
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

;$dpi=ReadValue("HKEY_LOCAL_MACHINE\SOFTWARE\MICROSOFT\Windows NT\CurrentVersion","DigitalProductID")
;$key = get_product_key($dpi)
? "Windows Product Key: " + getproductkey()

? "Press any key..."
get $


Top
#142332 - 2005-09-08 11:11 PM Re: Cd Key lookup.
Lonkero Administrator Offline
KiX Master Guru
*****

Registered: 2001-06-05
Posts: 22344
Loc: OK
well, sadly that's not XP key, but windows' cdkey
_________________________
!

download KiXnet

Top
#142333 - 2005-09-08 11:20 PM Re: Cd Key lookup.
Allen Administrator Online   shocked
KiX Supporter
*****

Registered: 2003-04-19
Posts: 4520
Loc: USA
I stand corrected... the Windows XP key, is what I'll use this for
Top
#142334 - 2005-09-08 11:40 PM Re: Cd Key lookup.
NTDOC Administrator Offline
Administrator
*****

Registered: 2000-07-28
Posts: 11611
Loc: CA
Well putting a couple of UDFs together we can search for ALL the products and have them output the ProductName and Key something like this

  • Microsoft Office Professional Edition 2003: XY7HB-8K3T4-KWLXC-KCTWW-VKKPM
  • Microsoft Office Visio Professional 2003: M58HJ-B4WW3-6X5MR-G8HD3-XSQSY
  • Microsoft Windows XP: RJTHT-PPKPY-EE7R6-DRGSB-KJMRT



Using the SearchReg() UDF from Kholm
http://www.kixtart.org/ubbthreads/showflat.php?Cat=0&Number=83331

and the updated one from Christian and Golfed by Chris I came up with this.


 
Break On
Dim $SO
$SO=SetOption('Explicit','On')
$SO=SetOption('NoVarsInStrings','On')

Dim $RegArray,$Value,$Product,$Key
$RegArray = SearchReg("HKLM\Software\Microsoft","DigitalProductID",2)
If @Error
'No matching items found' ?
Else
For Each $Value In $RegArray
If $Value
$Product = ReadValue(Join(Split($value,'<=>DigitalProductId'),''),'ProductName')
If $Product
$Key = Get_Product_Key(ReadValue(Join(Split($value,'<=>DigitalProductId'),''), 'DigitalProductID'))
$Product + ': ' + $Key ?
EndIf
EndIf
Next
EndIf

Function SearchReg($Key,$Str,$SrcIn)
Dim $Idx,$vName,$Value,$num,$SubKey,$fArr,$mbr
$SearchReg = ''
$num = 0
$Idx = 0
$vName = EnumValue($Key,$Idx)
Do
$mbr = ''
If $SrcIn & 1
$Value = ReadValue($Key,$vName)
If InStr($Value,$Str)
$mbr = $Key + "<=>" + IIf($vName,$vName,'<Default>')
EndIf
EndIf
If ($SrcIn & 2) And InStr($vName,$Str)
$mbr = $Key + "<=>" + $vName
EndIf
If $mbr
ReDim Preserve $SearchReg[$num]
$SearchReg[$num] = $mbr
$num = $num + 1
EndIf
$Idx = $Idx + 1
$vName = EnumValue($Key,$Idx)
Until @Error
$Idx = 0
$SubKey = EnumKey($Key,$Idx)
While $SubKey
If ($SrcIn & 4) And InStr($SubKey,$Str)
ReDim Preserve $SearchReg[$num]
$SearchReg[$num] = $Key + '\' + $SubKey + "<=><KeyName>"
$num = $num + 1
EndIf
$fArr = SearchReg($Key + "\" + $SubKey,$Str,$SrcIn)
If @Error = 0
For Each $mbr In $fArr
ReDim Preserve $SearchReg[$num]
$SearchReg[$num] = $mbr
$num = $num + 1
Next
EndIf
$Idx = $Idx + 1
$SubKey = EnumKey($Key,$Idx)
Loop
Exit VarType($SearchReg) = 8
EndFunction

Function Get_Product_Key($sProductID)
Dim $aiKeyChars[24],$bProductKey[15],$ilByte,$i,$sCDKey,$nCur
$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
$Get_Product_Key = $sCDKey
EndFunction

 

Top
#175581 - 2007-04-23 05:59 PM Re: Cd Key lookup. [Re: NTDOC]
Lonkero Administrator Offline
KiX Master Guru
*****

Registered: 2001-06-05
Posts: 22344
Loc: OK
thanks again for this awesome script!
_________________________
!

download KiXnet

Top
#201729 - 2011-03-10 06:39 AM Re: Cd Key lookup. [Re: Lonkero]
Allen Administrator Online   shocked
KiX Supporter
*****

Registered: 2003-04-19
Posts: 4520
Loc: USA
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.

  Dim $RegArray, $RegView, $Value,$Product,$Key, $rc, $Array2,$guid
  $RegView=setoption("WOW64AlternateRegView","On")
  $RegArray = SearchReg("HKLM\Software\Microsoft","DigitalProductID",2)
  if @onwow64
    $Array2 = SearchReg("HKLM\Software\WOW6432NODE\Microsoft","DigitalProductID",2)
    $RegArray=ArrayAdd($RegArray,$Array2)
  endif
  If ubound($RegArray)<0
      ? 'No matching items found'
  Else
    For Each $Value In $RegArray
      If $Value
        $Product = ReadValue(Join(Split($value,'<=>DigitalProductId'),''),'ProductName')
        If $product=""
          $guid="{" + split(split($value,"{")[1],"}")[0] + "}"
          if instr($value,"WOW6432Node")
            $product=readvalue("HKLM\Software\WOW6432Node\Microsoft\Windows\CurrentVersion\Uninstall\" + $guid,"DisplayName")
          else
            $product=readvalue("HKLM\Software\Microsoft\Windows\CurrentVersion\Uninstall\" + $guid,"DisplayName")
          endif
        endif
        If $Product
          $Key = Get_Product_Key(ReadValue(Join(Split($value,'<=>DigitalProductId'),''), 'DigitalProductID'))
            ? $Product + ': ' + $Key 
        EndIf
      EndIf
    Next
  EndIf
  $RegView=setoption("WOW64AlternateRegView",$RegView)


function Get_Product_Key($sproductid)
  Dim $aiKeyChars[24], $ilByte, $i, $iLOffset, $iUOffset, $bProductKey[15], $c, $nCur, $sCDKey
  For Each $c In 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")
    $aiKeyChars[$i]=Asc($c)
    $i=$i+1
  Next
  if len($sProductID)=2544
    $iLOffset=809
    $iUOffset=823
  else
    $iLOffset=53
    $iUOffset=67
  endif
  For $i = $iLOffset*2-1 To $iUOffset*2-1 Step 2
    $bProductKey[($i-($iLOffset*2-1))/2]=Execute("Exit &"+SubStr($sProductId,$i,2))
  Next
  For $ilByte = 24 To 0 Step -1
    $nCur = 0
    For $i=14 To 0 Step -1
      $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
  $Get_Product_Key=$sCDKey
EndFunction
 
Function SearchReg($Key,$Str,$SrcIn) Dim $Idx,$vName,$Value,$num,$SubKey,$fArr,$mbr $SearchReg = '' $num = 0 $Idx = 0 $vName = EnumValue($Key,$Idx) Do $mbr = '' If $SrcIn & 1 $Value = ReadValue($Key,$vName) If InStr($Value,$Str) $mbr = $Key + "<=>" + IIf($vName,$vName,'<Default>') EndIf EndIf If ($SrcIn & 2) And InStr($vName,$Str) $mbr = $Key + "<=>" + $vName EndIf If $mbr ReDim Preserve $SearchReg[$num] $SearchReg[$num] = $mbr $num = $num + 1 EndIf $Idx = $Idx + 1 $vName = EnumValue($Key,$Idx) Until @Error $Idx = 0 $SubKey = EnumKey($Key,$Idx) While $SubKey If ($SrcIn & 4) And InStr($SubKey,$Str) ReDim Preserve $SearchReg[$num] $SearchReg[$num] = $Key + '\' + $SubKey + "<=><KeyName>" $num = $num + 1 EndIf $fArr = SearchReg($Key + "\" + $SubKey,$Str,$SrcIn) If @Error = 0 For Each $mbr In $fArr ReDim Preserve $SearchReg[$num] $SearchReg[$num] = $mbr $num = $num + 1 Next EndIf $Idx = $Idx + 1 $SubKey = EnumKey($Key,$Idx) Loop Exit VarType($SearchReg) = 8 EndFunction
Function ArrayAdd($Array1, $Array2) ;Returns a new $Array1 Dim $n,$i $n = UBound($Array1) + 1 REDIM PRESERVE $Array1[$n+UBound($Array2)] For $i = 0 to UBound($Array2) $Array1[$n+$i] = $Array2[$i] Next $ArrayAdd = $Array1 EndFunction

Top
Page 2 of 3 <123>


Moderator:  Jochen, Allen, Radimus, Glenn Barnas, ShaneEP, Ruud van Velsen, Arend_, Mart 
Hop to:
Shout Box

Who's Online
0 registered and 275 anonymous users online.
Newest Members
Praveer, Ollero, rayyo, Foxlicht, DonChild
17742 Registered Users

Generated in 0.045 seconds in which 0.014 seconds were spent on a total of 14 queries. Zlib compression enabled.

Search the board with:
superb Board Search
or try with google:
Google
Web kixtart.org