#!/usr/bin/env perl
#
# usage: decode-registry-into-product-key <file>
#
# ...where "file" is obtained by doing this:
#
#   * Run regedit
#
#   * Go to "File->Export"
#
#   * Choose to export a "selected branch" and save as type 
#     "Registration Files (*.reg)".  The key should be:
# 
#       HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion
#
# Run with the sole argument "test" to check that the script works!
#
#   $ ./decode-registry-into-product-key test
#   KC62T-4CV9X-X9RK4-39C8F-PJ2G2
#   KC62T-4CV9X-X9RK4-39C8F-PJ2G2
#
# Edward Speyer, 2007
#

use strict;

#
# Original implementation of "decode_product_key" was done in Delphi.
#
# There is a C# version here that I copied:
#
#   http://geekswithblogs.net/willemf/archive/2006/04/23/76125.aspx
#
sub decode_product_key {
    my $digital_product_id = shift;
    my $key_start_index = 52;
    my $key_end_index = $key_start_index + 15;

    my @digits = 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 $decode_length = 29;
    my $decode_string_length = 15;
    my @decoded_chars = ();
    my @hex_product_id;

    for (my $i = $key_start_index; $i <= $key_end_index; $i++) {
        push(@hex_product_id, hex $digital_product_id->[$i]);
    }

    for (my $i = $decode_length-1; $i>=0; $i--) {
        if (($i+1)%6==0) {
            $decoded_chars[$i] = '-';
        }
        else {
            my $digit_map_index = 0;
            for (my $j = $decode_string_length-1; $j>=0; $j--) {
                my $byte_value = ($digit_map_index<<8) | $hex_product_id[$j];
                $hex_product_id[$j] = $byte_value / 24;
                $digit_map_index = $byte_value % 24;
                $decoded_chars[$i] = $digits[$digit_map_index];
            }
        }
    }

    return join('', @decoded_chars);
}

sub extract_product_key {
    my $string = shift;
    $string =~ s/\0//g;
    if ($string =~ /^"DigitalProductId"=hex:(.+?)"/ms) {
        my $digital_product_id = $1;
        my @digits = $digital_product_id =~ m[([0-9a-f][0-9a-f])]g;
        return decode_product_key \@digits;
    }
    else {
        die "unable to find Digital Product Id in string";
    }
}

sub test {
}

if ($ARGV[0] eq 'test') {
    my @key_example = qw(
        00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
        00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
        00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
        00 00 00 00 b1 7a 93 f4 1b 79 49 81 9b bd eb 65
        f0 14 ec 00 00 00 00 00 00 00 00 00 00 00 00 00
        00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
        00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
        00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
        00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
        00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
        00 00 00 00
    );

    print decode_product_key \@key_example;
    print "\n";

    my $registry_example = <<'...';
"ProductId"="11111-OEM-1111111-11111"
"DigitalProductId"=hex:00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,\
  00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,\
  00,00,00,00,00,00,00,00,00,b1,7a,93,f4,1b,79,49,81,9b,bd,eb,65,f0,14,ec,00,\
  00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,\
  00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,\
  00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,\
  00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00
"LicenseInfo"=hex:
...

    print extract_product_key $registry_example;
    print "\n";
}

else {
    use File::Basename;
    open(FILE, $ARGV[0]) or die basename($0).": couldn't open file $ARGV[0]\n";
    my $string = join('', <FILE>);
    close FILE;
    print extract_product_key $string;
    print "\n";
}