Beefy Boxes and Bandwidth Generously Provided by pair Networks
P is for Practical
 
PerlMonks  

Finding Windows XP CD Key

by wgannon (Novice)
on Oct 05, 2005 at 14:47 UTC ( [id://497616]=sourcecode: print w/replies, xml ) Need Help??
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
    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");
      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.
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. :-)

     

     

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.

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, ); }

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

    HTH,
    Charles
      Works in Vista (Home Premium) too. Thanks for this code! (I used the CharlesClarkson version)
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.

      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.

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: sourcecode [id://497616]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others romping around the Monastery: (3)
As of 2024-03-29 05:52 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found