Allen
KiX Supporter
Registered: 2003-04-19
Posts: 4534
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