Get XP, (PLUS?), Product Key

[GEOSoft]

AutoIt's RegRead() is changed. That would require to change 105 to 107 in scripts (key offset).

This also shows that using string functions with binary data is not to be recommended.

Good catch and I suspect that if I try to run my code as a script it will have pretty much the same problem. The link I provided uses code already compiled. When I find the time ( a year or two) I'll check it.

[flxfxp]

Just passing the message

[GEOSoft]

Based on the input from trancexx, here is the revised (Tested) code. Also tested okay for Office XP and Office 2003.

expandcollapse popup

$a=RegRead("HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion", "DigitalProductId")
If $a<>"" Then
    $xpkey=MSDecode($a, "-")
    ClipPut($xpkey)
    InputBox("Windows OS Product Key", "The installed Windows Operating System Product Key has been copied to the clipboard and is:", $xpkey)
Else
    MsgBox(0,"ERROR","No Product Key Found")
EndIf


;   Decodes The XP Key In The Registry

; *(May work for other installed Microsoft Products)

Func MSDecode($msd_prodid, $msd_sep="")

$msd_decoded =""
$msd_code="BCDFGHJKMPQRTVWXY2346789"
Dim $msd_encoded[16]
$msd_cnt=0
For $msd_t = 107 To 135 Step + 2
    $msd_encoded[$msd_cnt]=Dec(StringMid($msd_prodid, $msd_t, 2))
    $msd_cnt += 1
Next
$msd_cnt=1
For $msd_t = 29 To 1 Step - 1
If $msd_cnt <> 6 Then
    $msd_mod = 0
    For $msd_r = 14 To 0 Step -1
        $msd_bit = BitOR(BitShift($msd_mod, -8), $msd_encoded[$msd_r])
        $msd_encoded[$msd_r] = Int($msd_bit / 24)
        $msd_mod = Mod($msd_bit, 24)
    Next
    $msd_decoded = StringMid($msd_code, $msd_mod + 1, 1) & $msd_decoded
    $msd_cnt += 1
Else
    $msd_cnt=1
    If $msd_sep<>"" Then $msd_decoded = $msd_sep & $msd_decoded
EndIf
Next
Return $msd_decoded

EndFunc

[flxfxp]

wow, those 2 years went fast as hell

[GEOSoft]

At my age there may not be 2 years left, besides I wanted to update my own algorithm before I forgot about it which would take about 15 minutes to happen assuming I have 15 minutes left.

[trancexx]

I know for fact he's 17. ( )

[GEOSoft]

I know for fact he's 17. ( )

Thanks. My mind would like to go with that but the body just couldn't stand the pace.

[flxfxp]

by the way, I'm sad to inform that it still gives out the wrong key. I tested this on XP SP3 and the key from produkey matches correctly but the one from this script doesnt

[GEOSoft]

It's been fine on 4 systems for me

XP SP3 (2)

Vista Home Basic

Windows 7

There is however the potential for failure if you are using an OEM version because of the way that OEM product keys work. The Product Key in the registry may not be the same as the Product Key on your sticker in OEM versions. I'll test it some more on the OEM machines that come in for the next little while.

I also spotted another issue in this version of the function that will affect x64 systems. I'll fix that in the next day or two and modify my posted code.

Try running the file inside this zip and see if you get the same returns as this function.

http://dundats.mvps.org/beta/RegInfo4.zip

[mrjh]

Based on the input from trancexx, here is the revised (Tested) code. Also tested okay for Office XP and Office 2003.

expandcollapse popup

$a=RegRead("HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion", "DigitalProductId")
If $a<>"" Then
    $xpkey=MSDecode($a, "-")
    ClipPut($xpkey)
    InputBox("Windows OS Product Key", "The installed Windows Operating System Product Key has been copied to the clipboard and is:", $xpkey)
Else
    MsgBox(0,"ERROR","No Product Key Found")
EndIf


;   Decodes The XP Key In The Registry

; *(May work for other installed Microsoft Products)

Func MSDecode($msd_prodid, $msd_sep="")

$msd_decoded =""
$msd_code="BCDFGHJKMPQRTVWXY2346789"
Dim $msd_encoded[16]
$msd_cnt=0
For $msd_t = 107 To 135 Step + 2
    $msd_encoded[$msd_cnt]=Dec(StringMid($msd_prodid, $msd_t, 2))
    $msd_cnt += 1
Next
$msd_cnt=1
For $msd_t = 29 To 1 Step - 1
If $msd_cnt <> 6 Then
    $msd_mod = 0
    For $msd_r = 14 To 0 Step -1
        $msd_bit = BitOR(BitShift($msd_mod, -8), $msd_encoded[$msd_r])
        $msd_encoded[$msd_r] = Int($msd_bit / 24)
        $msd_mod = Mod($msd_bit, 24)
    Next
    $msd_decoded = StringMid($msd_code, $msd_mod + 1, 1) & $msd_decoded
    $msd_cnt += 1
Else
    $msd_cnt=1
    If $msd_sep<>"" Then $msd_decoded = $msd_sep & $msd_decoded
EndIf
Next
Return $msd_decoded

EndFunc

currect working for me thanks

[pinkbits]

It's been fine on 4 systems for me

XP SP3 (2)

Vista Home Basic

Windows 7

There is however the potential for failure if you are using an OEM version because of the way that OEM product keys work. The Product Key in the registry may not be the same as the Product Key on your sticker in OEM versions. I'll test it some more on the OEM machines that come in for the next little while.

I also spotted another issue in this version of the function that will affect x64 systems. I'll fix that in the next day or two and modify my posted code.

Try running the file inside this zip and see if you get the same returns as this function.

http://dundats.mvps.org/beta/RegInfo4.zip

He mentioned that he was comparing it to produkey, not to the sticker on the side of his box.

[Skrip]

Is it possible to reverse the decode, and make it encode?

[GEOSoft]

Is it possible to reverse the decode, and make it encode?

I don't see why not. A general rule would be "if it can be decoded then it can be encoded". Good luck with it.

[llewxam]

Any chance this can be made to work for an offline drive? I added this to my data backup app but just now realized that every single time I run the app on a drive it says Office 2007 is installed - that's because I run the backup on one of my machines with the customer's drive as a slave!!

The exact code I am working with for Office is:

expandcollapse popup

Global $product = ""
Dim $Bin = RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion", "DigitalProductID")
Dim $key4RegisteredOwner = "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion"
$objWMIService = ObjGet("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
$colSettings = $objWMIService.ExecQuery ("Select * from Win32_OperatingSystem")
For $objOperatingSystem In $colSettings
Next
getOfficeKey()
If $officeinst=1 then filewriteline($logfile,@crlf&"Office "&$product&" Product Key: "&getOfficeKey()&@crlf)


func getOfficeKey()
    Local $List[1]
    Local $i = 1
    $var = RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Office\11.0\Common\InstallRoot", "Path")
    If $var <> "" Then
        $product = "2003"
        Dim $officeKey = "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Office\11.0\Registration"
    Else
        $var = RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Office\10.0\Common\InstallRoot", "Path")
        If $var <> "" Then
            $product = "XP"
            Dim $officeKey = "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Office\10.0\Registration"
        Else
            $var = RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Office\12.0\Common\InstallRoot", "Path")
            If $var <> "" Then
                $product = "2007"
                Dim $officeKey = "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Office\12.0\Registration"
            EndIf
        EndIf
    EndIf
    Dim $var = RegEnumKey($officeKey, $i)
    If @error <> 0 Then
        $officeinst=0
;~         GUICtrlSetData($status_L, "Info: Unable to find REG_BINARY 'DigitalProductID', maybe no Office installed!")
        Return "No Office XP or 2003 found"
    Else
        $List[$i - 1] = RegRead($officeKey & "\" & $var, "DigitalProductID")
        If $List[$i - 1] = "" Then
            $officeinst=0
;~             GUICtrlSetData($status_L, "Info: Unable to find REG_BINARY 'DigitalProductID', maybe no Office installed!")
        Else
            $officeinst=1
            $key = $List[$i - 1]
            Return DecodeProductKey($key)
        EndIf
    EndIf
EndFunc  ;==>getOfficeKey



Func DecodeProductKey($BinaryDPID)
    Local $bKey[15]
    Local $sKey[29]
    Local $Digits[24]
    Local $Value = 0
    Local $hi = 0
    Local $n = 0
    Local $i = 0
    Local $dlen = 29
    Local $slen = 15
    Local $Result

    $Digits = StringSplit("BCDFGHJKMPQRTVWXY2346789", "")
    $BinaryDPID = StringMid($BinaryDPID, 107, 30)
    For $i = 1 To 29 Step 2
        $bKey[Int($i / 2) ] = Dec(StringMid($BinaryDPID, $i, 2))
    Next
    For $i = $dlen - 1 To 0 Step - 1
        If Mod(($i + 1), 6) = 0 Then
            $sKey[$i] = "-"
        Else
            $hi = 0
            For $n = $slen - 1 To 0 Step - 1
                $Value = BitOR(BitShift($hi, -8), $bKey[$n])
                $bKey[$n] = Int($Value / 24)
                $hi = Mod($Value, 24)
            Next
            $sKey[$i] = $Digits[$hi + 1]
        EndIf
    Next
    For $i = 0 To 28
        $Result = $Result & $sKey[$i]
    Next
    Return $Result
EndFunc   ;==>DecodeProductKey

For now I'll just block it off unless it is being run from the drive being backed up..... hehe, I feel like a goof now

Thanks!

Ian

BTW, I just found that it doesn't seem to pick up Office 2007 under Windows Vista.....

Edited September 24, 2009 by llewxam

[engjcowi]

Hey guys

I updated this to allow for office 2010. I have got office 2007 myself but when passed to a friend to test as he has 2010 he says it doesnt work it just says no office found.

Can anyone have a look and see if ive missed something please. Ive been lookin at it for so long now my eyes are blurring lol

jamie

expandcollapse popup

Func getOfficeKey()
    Local $List[1]
    Local $i = 1
    $var = RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Office\11.0\Common\InstallRoot", "Path")
    If $var <> "" Then
        $product = "2003"
        ;return("Office 2003 Found")
        Dim $officeKey = "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Office\11.0\Registration"
    Else
        $var = RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Office\10.0\Common\InstallRoot", "Path")
        If $var <> "" Then
            $product = "XP"
            ;return("Office xp Found")
            Dim $officeKey = "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Office\10.0\Registration"
        Else
            $var = RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Office\12.0\Common\InstallRoot", "Path")
            If $var <> "" Then
                $product = "2007"
                ;return("Office 2007 Found")
                Dim $officeKey = "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Office\12.0\Registration"

        Else
            $var = RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Office\14.0\Common\InstallRoot", "Path")
            If $var <> "" Then
                $product = "2010"
                ;return("Office 2010 Found")
                Dim $officeKey = "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Office\14.0\Registration"
            EndIf
        Endif
        EndIf
    EndIf
    Dim $var = RegEnumKey($officeKey, $i)
    If @error <> 0 Then
       ; return("Info: Unable to find REG_BINARY 'DigitalProductID', maybe no Office installed!")
        Return "No Office XP or 2003, 2007 or 2010 found"
    Else
        $List[$i - 1] = RegRead($officeKey & "\" & $var, "DigitalProductID")
        If $List[$i - 1] = "" Then
            return("Info: Unable to find REG_BINARY 'DigitalProductID', maybe no Office installed!")
        Else
            $key = $List[$i - 1]
            Return _DecodeProductKey($key)
        EndIf
    EndIf
EndFunc  ;==>getOfficeKey

[Emiel Wieldraaijer]

Hi,

This is my Modified version, will also check 32bits office versions on 64bits OS

expandcollapse popup

#include-once

$HKLM = "HKEY_LOCAL_MACHINE"
$Architecture = "32 Bits"

If @OSArch = "X64" Then
    $HKLM &= "64"
    $Architecture = "64 Bits"
EndIf

;===============================================================================
;
; Function Name:    _GetOfficeKey()
; Description:      gets the Office DigitalProductID from the registry
; Parameter(s):     none
; Requirement(s):   none
; Return Value(s):  Returns the binary 2000/XP/2003/2007/2010 Office DigitalProductID
; Author(s):        Danny35d
; Modification:     Emiel Wieldraaijer
;
;===============================================================================
; TBD: Error checking and SetError
Func _GetOfficeKey($sRemoteComputer = '')
    Dim $aKeys[1][8]
    If $sRemoteComputer <> '' Then $sRemoteComputer = '\\' & StringReplace($sRemoteComputer, '\', '') & '\'
    Local $sRegKey1 = $sRemoteComputer & $HKLM & '\SOFTWARE\Microsoft\Office'
    Local $sRegKey2 = $sRemoteComputer & $HKLM & '\SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall'
    Local $iCount1 = 1, $iCount2 = 1

    While 1
        $sKey1 = RegEnumKey($sRegKey1, $iCount1)
        If @error <> 0 Then ExitLoop
        While 1
            $ProductID = ''
            $ProductName = ''
            $DigitalProductID = ''
            $sKey2 = RegEnumKey($sRegKey1 & '\' & $sKey1 & '\Registration', $iCount2)
            If @error <> 0 Then ExitLoop
            $ProductID = RegRead($sRegKey1 & '\' & $sKey1 & '\Registration\' & $sKey2, 'ProductID')
            $ProductName = RegRead($sRegKey1 & '\' & $sKey1 & '\Registration\' & $sKey2, 'ProductName')
            $DigitalProductID = Hex(RegRead($sRegKey1 & '\' & $sKey1 & '\Registration\' & $sKey2, 'DigitalProductID'))
            $InstallPath = StringTrimRight((RegRead ($sRegKey1 & '\' & $sKey1 & '\Common\InstallRoot', 'Path')),1)
            $ProductVersion = RegRead($sRegKey1 & '\' & $sKey1 & '\Common\Productversion', 'Lastproduct')
            $OfficeLanguage = StringRight(Hex(RegRead($sRegKey1 & '\' & $sKey1 & '\Common\LanguageResources', 'SKULanguage')),4)

            If StringInStr(RegRead($sRegKey1 & '\' & $sKey1 & '\Registration\' & $sKey2, 'ProductName'), "2000") Then
                $SPLevel = "N/A"
            ElseIf StringInStr(RegRead($sRegKey1 & '\' & $sKey1 & '\Registration\' & $sKey2, 'ProductName'), "XP") Then
                $SPLevel = "N/A"
            ElseIf StringInStr(RegRead($sRegKey1 & '\' & $sKey1 & '\Registration\' & $sKey2, 'ProductName'), "2003") Then
                $SPLevel = "N/A"
            Else
                $SPLevel = RegRead($sRegKey1 & '\' & $sKey1 & '\Registration\' & $sKey2, 'SPLevel')
            EndIf

            If $ProductName = '' Then $ProductName = RegRead($sRegKey2 & '\' & $sKey2, 'DisplayName')
            $DigitalProductID = _DecodeProductKey($DigitalProductID)
            If $DigitalProductID <> 'BBBBB-BBBBB-BBBBB-BBBBB-BBBBB' Then
                ReDim $aKeys[UBound($aKeys) + 1][8]
                $aKeys[0][0] = UBound($aKeys) - 1
                $aKeys[UBound($aKeys) - 1][0] = $ProductName
                $aKeys[UBound($aKeys) - 1][1] = $ProductID
                $aKeys[UBound($aKeys) - 1][2] = $DigitalProductID
                $aKeys[UBound($aKeys) - 1][3] = $InstallPath
                $aKeys[UBound($aKeys) - 1][4] = $ProductVersion
                $aKeys[UBound($aKeys) - 1][5] = $OfficeLanguage
                $aKeys[UBound($aKeys) - 1][6] = $Architecture
                $aKeys[UBound($aKeys) - 1][7] = $SPLevel
            EndIf

            $iCount2 += 1
        WEnd
        $iCount1 += 1
    WEnd
    Return($aKeys)
EndFunc   ;==>_GetOfficeKey

Func _GetOfficeKey6432($sRemoteComputer = '')
    Dim $aKeys6432[1][8]
    If $sRemoteComputer <> '' Then $sRemoteComputer = '\\' & StringReplace($sRemoteComputer, '\', '') & '\'
    Local $sRegKey1 = $sRemoteComputer & $HKLM & '\SOFTWARE\Wow6432Node\Microsoft\Office'
    Local $sRegKey2 = $sRemoteComputer & $HKLM & '\SOFTWARE\Wow6432Node\Microsoft\Windows\CurrentVersion\Uninstall'
    Local $iCount1 = 1, $iCount2 = 1

    While 1
        $sKey1 = RegEnumKey($sRegKey1, $iCount1)
        If @error <> 0 Then ExitLoop
        While 1
            $ProductID = ''
            $ProductName = ''
            $DigitalProductID = ''
            $sKey2 = RegEnumKey($sRegKey1 & '\' & $sKey1 & '\Registration', $iCount2)
            If @error <> 0 Then ExitLoop
            $ProductID = RegRead($sRegKey1 & '\' & $sKey1 & '\Registration\' & $sKey2, 'ProductID')

            $ProductName = RegRead($sRegKey1 & '\' & $sKey1 & '\Registration\' & $sKey2, 'ProductName')
            $DigitalProductID = Hex(RegRead($sRegKey1 & '\' & $sKey1 & '\Registration\' & $sKey2, 'DigitalProductID'))
            $InstallPath = StringTrimRight((RegRead ($sRegKey1 & '\' & $sKey1 & '\Common\InstallRoot', 'Path')),1)
            $ProductVersion = RegRead($sRegKey1 & '\' & $sKey1 & '\Common\Productversion', 'Lastproduct')
            $OfficeLanguage = StringRight(Hex(RegRead($sRegKey1 & '\' & $sKey1 & '\Common\LanguageResources', 'SKULanguage')),4)
            $SPLevel = RegRead($sRegKey1 & '\' & $sKey1 & '\Registration\' & $sKey2, 'SPLevel')

            $Architecture = "32 Bits"

            If StringInStr(RegRead($sRegKey1 & '\' & $sKey1 & '\Registration\' & $sKey2, 'ProductName'), "2000") Then
                $SPLevel = "N/A"
            ElseIf StringInStr(RegRead($sRegKey1 & '\' & $sKey1 & '\Registration\' & $sKey2, 'ProductName'), "XP") Then
                $SPLevel = "N/A"
            ElseIf StringInStr(RegRead($sRegKey1 & '\' & $sKey1 & '\Registration\' & $sKey2, 'ProductName'), "2003") Then
                $SPLevel = "N/A"
            Else
                $SPLevel = RegRead($sRegKey1 & '\' & $sKey1 & '\Registration\' & $sKey2, 'SPLevel')
            EndIf

            If $ProductName = '' Then $ProductName = RegRead($sRegKey2 & '\' & $sKey2, 'DisplayName')
            $DigitalProductID = _DecodeProductKey($DigitalProductID)
            If $DigitalProductID <> 'BBBBB-BBBBB-BBBBB-BBBBB-BBBBB' Then
                ReDim $aKeys6432[UBound($aKeys6432) + 1][8]
                $aKeys6432[0][0] = UBound($aKeys6432) - 1
                $aKeys6432[UBound($aKeys6432) - 1][0] = $ProductName
                $aKeys6432[UBound($aKeys6432) - 1][1] = $ProductID
                $aKeys6432[UBound($aKeys6432) - 1][2] = $DigitalProductID
                $aKeys6432[UBound($aKeys6432) - 1][3] = $InstallPath
                $aKeys6432[UBound($aKeys6432) - 1][4] = $ProductVersion
                $aKeys6432[UBound($aKeys6432) - 1][5] = $OfficeLanguage
                $aKeys6432[UBound($aKeys6432) - 1][6] = $Architecture
                $aKeys6432[UBound($aKeys6432) - 1][7] = $SPLevel
            EndIf

            $iCount2 += 1
        WEnd
        $iCount1 += 1
    WEnd
    Return($aKeys6432)
EndFunc   ;==>_GetOfficeKey6432

;===============================================================================
;
; Function Name:    _DecodeProductKey()
; Description:      decodes the PID to get the product key
; Parameter(s):     $BinaryDPID - the PID as stored in registry
; Requirement(s):   none
; Return Value(s):  Returns the decoded Windows/Office/Visual studio/etc. product key
; Author(s):        found this in the Forum, who made it?!
;
;===============================================================================
Func _DecodeProductKey($BinaryDPID)
    Local $bKey[15]
    Local $sKey[29]
    Local $Digits[24]
    Local $Value = 0
    Local $hi = 0
    Local $n = 0
    Local $i = 0
    Local $dlen = 29
    Local $slen = 15
    Local $Result

    $Digits = StringSplit("BCDFGHJKMPQRTVWXY2346789", "")
    $binaryDPID = StringMid($binaryDPID, 105, 30)
    For $i = 1 To 29 Step 2
        $bKey[Int($i / 2) ] = Dec(StringMid($binaryDPID, $i, 2))
    Next

    For $i = $dlen - 1 To 0 Step - 1
        If Mod(($i + 1), 6) = 0 Then
            $sKey[$i] = "-"
        Else
            $hi = 0
            For $n = $slen - 1 To 0 Step - 1
                $Value = BitOR(BitShift($hi, -8), $bKey[$n])
                $bKey[$n] = Int($Value / 24)
                $hi = Mod($Value, 24)
            Next
            $sKey[$i] = $Digits[$hi + 1]
        EndIf
    Next
    For $i = 0 To 28
        $Result = $Result & $sKey[$i]
    Next
    Return $Result
EndFunc   ;==>_DecodeProductKey

Edited April 4, 2011 by Emiel Wieldraaijer

[Mobius]

@Emiel,

Quality work dude, very handy modification indeed

[Emiel Wieldraaijer]

Thanks Vlad,

Yes covers all the installed version on a computer not one but all version

Cheers M8

[GEOSoft]

Emiel

A little known tip for you. Just use HKLM64 regardless of the OS Architecture. You will get the same result.

[Emiel Wieldraaijer]

Hi George,

Thanks..

I did not know that was working also..

Cheers

Emiel