Category: Win32
Author/Contact Info William Gannon
Description: How to find the Windows XP CD Key and the Office 2003 CD Key and display them in the xxxxx-xxxxx-xxxxx-xxxxx format. Microsoft uses base-24 encoding to store the installer key in the registry. I took this code from some VBA script I found online and translated it in Perl. 
use strict;
use Win32::TieRegistry;

# Get the Windows XP CD Key
print &getXPkey(qq!HKEY_LOCAL_MACHINE\\Software\\Microsoft\\Windows NT
+\\CurrentVersion\\\\DigitalProductId!);

# Get Office 2003 CD Key
# You need to get the GUID which is different on every machine
my @office = $Registry->{"HKEY_LOCAL_MACHINE\\Software\\Microsoft\\Off
+ice\\11.0\\Registration"}->SubKeyNames;
print &getXPkey("HKEY_LOCAL_MACHINE\\Software\\Microsoft\\Office\\11.0
+\\Registration\\$office[0]\\\\DigitalProductId");

sub getXPkey {
  use integer;
  my $registry = shift;
  my @bKeyChars = map(ord, (qw(B C D F G H J K M P Q R T V W X Y 2 3 4
+ 6 7 8 9)));
  my $nCur;
  my @bDigitalProductID = unpack('C*', $Registry->{$registry});
  my @bProductKey = @bDigitalProductID[52..66];
  my $sCDKey = '';
  for (my $ilByte = 24; $ilByte >= 0; $ilByte--) {
    $nCur = 0;
    for (my $ilKeyByte = 14; $ilKeyByte >= 0; $ilKeyByte--) {
      $nCur = $nCur * 256 ^ $bProductKey[$ilKeyByte];
      $bProductKey[$ilKeyByte] = $nCur / 24;
      $nCur %= 24;
    }
    $sCDKey = chr($bKeyChars[$nCur]) . $sCDKey;
    $sCDKey = '-' . $sCDKey if ($ilByte % 5 == 0 and $ilByte != 0);
  }
  return $sCDKey;
}
Replies are listed 'Best First'.
Re: Finding Windows XP CD Key
by ww (Archbishop) on Oct 05, 2005 at 19:32 UTC
    Excellent, indeed!

    And, FWIW, wgannon's code appears to work fine on W2K, at least for the OS key; the Ofc key can be adapted, trivially, by changing both instances of "11.0" to whatever version you find (via regedit, for instance) at n.n in your registry at 

    HKEY_LOCAL_MACHINE\\Software\\Microsoft\\Office\\n.n

    [download]
    but I'm not positive it works correctly as running the adapted code here spews what seems to me to be a highly unlikely key -- but that may be because the Ofc install here is a (thoroughly legal) US govt site license, to which only the systems folk have access.

    Just in case my n.n notation is unclear, my changed lines are:

    my @office = $Registry->{"HKEY_LOCAL_MACHINE\\Software\\Microsoft\\Off
+ice\\9.0\\Registration"}->SubKeyNames;
print &getXPkey("HKEY_LOCAL_MACHINE\\Software\\Microsoft\\Office\\9.0\
+\Registration\\$office[0]\\\\DigitalProductId");

    [download]
[reply]
[d/l]
[select]
      I have no idea if this works for previous version of Office or Windows. I only tested it with XP Pro and Office 2003, but if anybody finds that it works for other version, please continue to post or post solutions for other verions.
[reply]
Re: Finding Windows XP CD Key
by wfsp (Abbot) on Oct 05, 2005 at 16:48 UTC
    wgannon++

    Excellent, thanks very much! I have only ever come to grief trying to read the sticker at the back bottom corner of the m/c. :-)

     

     

[reply]
Re: Finding Windows XP CD Key
by Mr. Muskrat (Canon) on Oct 27, 2005 at 18:46 UTC

    Add a newline to the output of the Windows CD key otherwise the two keys run together.

[reply]
Re: Finding Windows XP CD Key
by CharlesClarkson (Curate) on Oct 31, 2005 at 05:31 UTC

    @bKeyChars is being translated using ord() then translated back using chr(). The dashes can be added using a regex outside the first loop simplifying the outer loop. @bProductKey can be found without a need for @bDigitalProductID. The for loops can be rewritten to a more "perlish" style and we can step through @bProductKey without resorting to indexes. Finally, we can get rid of the Hungarian notation.

    sub getXPkey {
    my $key     = shift;
    my @encoded = ( unpack 'C*', $Registry->{$key} )[ reverse 52 .. 66
+ ];

    # Get indices
    my @indices;
    foreach ( 0 .. 24 ) {
        my $index = 0;

        # Shift off remainder
        ( $index, $_ ) = quotient( $index, $_ ) foreach @encoded;

        # Store index.
        unshift @indices, $index;
    }

    # translate base 24 "digits" to characters
    my $cd_key =
        join '',
        qw( B C D F G H J K M P Q R T V W X Y 2 3 4 6 7 8 9 )[ @indice
+s ];

    # Add seperators
    $cd_key =
        join '-',
        $cd_key =~ /(.{5})/g;

    return $cd_key;
}

sub quotient {
    use integer;
    my( $index, $encoded ) = @_;

    # Same as $index * 256 + $product_key ???
    my $dividend = $index * 256 ^ $encoded;

    # return modulus and integer quotient
    return(
        $dividend % 24,
        $dividend / 24,
    );
}

    [download]

    This makes for a little cleaner look, not a speed increase. I tend more toward clean, maintainable code than fast code.

    HTH,
    Charles
[reply]
[d/l]
      Works in Vista (Home Premium) too. Thanks for this code! (I used the CharlesClarkson version)
[reply]
Re: Finding Windows XP CD Key
by mikeock (Hermit) on Nov 08, 2005 at 20:33 UTC
    Tried on winxp home and it did not work. Was a few days ago, so I don't remeber the error, but am willing to d\l and run again if you want to fix the problem?

    edit: Here is the error message that I am recieving. Can't call method "SubKeyNames" on an undefined value at key.pl line 9.

[reply]
[d/l]
      Mike, I know it is a while since your comment about this not working on XP Home, but for me it does. My XP Home system does not have perl installed. I do everything using modules (exe files) created using the perl pp -o facility on my development system. The module ran without error, giving me the numbers I expected to see.
[reply]

Back to Code Catacombs