Beefy Boxes and Bandwidth Generously Provided by pair Networks Cowboy Neal with Hat
Your skill will accomplish
what the force of many cannot
 
PerlMonks

Finding Windows XP CD Key

by wgannon (Novice)
 | Log in | Create a new user | The Monastery Gates | Super Search | 
 | Seekers of Perl Wisdom | Meditations | PerlMonks Discussion | 
 | Obfuscation | Reviews | Cool Uses For Perl | Perl News | Q&A | Tutorials | 
 | Poetry | Recent Threads | Newest Nodes | Donate | What's New | 

on Oct 05, 2005 at 14:47 UTC ( #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;
}

Comment on Finding Windows XP CD Key
Download Code
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 ww (Abbot) 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 Mr. Muskrat (Monsignor) 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.

Back to Code Catacombs

Login:
Password
remember me
What's my password?
Create A New User

Node Status?
node history
Node Type: sourcecode [id://497616]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others surveying the Monastery: (25)
BrowserUk
Corion
GrandFather
Fletch
ysth
ww
FunkyMonk
holli
Gavin
kennethk
thezip
Eyck
pileofrogs
erix
SuicideJunkie
hominid
redlemon
meraxes
ahmad
ssandv
VinsWorldcom
thedoe
MikeDexter
cmg
brp4h
As of 2010-02-09 20:59 GMT
Sections?
The Monastery Gates
Seekers of Perl Wisdom
Meditations
PerlMonks Discussion
Categorized Q&A
Tutorials
Obfuscated Code
Perl Poetry
Cool Uses for Perl
Perl News
Information?
PerlMonks FAQ
Guide to the Monastery
What's New at PerlMonks
Voting/Experience System
Tutorials
Reviews
Library
Perl FAQs
Other Info Sources
Find Nodes?
Nodes You Wrote
Super Search
List Nodes By Users
Newest Nodes
Recently Active Threads
Selected Best Nodes
Best Nodes
Worst Nodes
Saints in our Book
Leftovers?
The St. Larry Wall Shrine
Offering Plate
Awards
Craft
Snippets Section
Code Catacombs
Quests
Editor Requests
Buy PerlMonks Gear
PerlMonks Merchandise
Planet Perl
Perlsphere
Use Perl
Perl.com
Perl 5 Wiki
Perl Jobs
Perl Mongers
Perl Directory
Perl documentation
CPAN
Random Node
Voting Booth?

What level of existential comfort do you require?

Palace
Executive suite at the best hotel
Regular hotel in a decent part of town
Motel
Boarding house
Sleeping Bag on Couch in Basement
Any port in a storm
Camping under the freeway overpass
Jail
Other

Results (279 votes), past polls