Finding Windows XP CD Key

[wgannon]

Category:

Win32

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