Beefy Boxes and Bandwidth Generously Provided by pair Networks
There's more than one way to do things
 
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 making s'mores by the fire in the courtyard of the Monastery: (2)
As of 2024-04-20 04:45 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found