Monks,

At work I often have the need to do a licence audit.

A few years ago I rewrote this small section of code in perl, based on another script (which I seem to recall was visual basic). This will decode the licence keys from your registry for Windows and Office, for all the versions I have come across.

For Windows, you will need to look in HKLM\Software\Microsoft\Windows Nt\CurrentVersion\DigitalProductID

sub decodekey {
  my @digits = ('B','C','D','F','G','H','J','K','M','P','Q','R','T','V
+','W','X','Y','2','3','4','6','7','8','9');
  return "No key found\n" if ($_[0] eq "");
  my @id = split(/,/,shift);
  my $key="";
  for (my $i=28; $i>=0; $i--) {
    if (($i+1)%6) {
      my $ac=0;
      for (my $j=66; $j>=52; $j--) {
        $ac<<=8;
        $ac+=hex $id[$j];
        $id[$j]=sprintf("%x",($ac/24)&255);
        $ac%=24;
      }
      $key=$digits[$ac].$key;
    } else {
      $key='-'.$key;
    }
  }
  return $key;
}

[download]

This can be used by feeding the hexadecimal found in the registry (separated by single commas) to the function.

I also use the following snippet to pull that key remotely using samba4's reg command. (this isn't pretty, but it gives you an idea of usage)

sub regexec {
  my $computer = shift;
  my $outkey = "";
  my $key = `reg query \\\\\\\\$computer\\\\HKLM\\\\Software\\\\Micros
+oft\\\\Windows\\\ Nt\\\\CurrentVersion /v DigitalProductID 2>&1`;
  foreach (split(/\n/,$key)) {
    if (m/\s+DigitalProductID\s+REG_BINARY\s+([A-F0-9]+)/) {
      $_ = $1;
      s/([A-F0-9][A-F0-9])/$1,/g;
      $outkey = $_;
    }
  }
  return $outkey;
}

[download]

Just yesterday, I realised that Office 2008 for the Mac also uses the same format, only it is base64 encoded in this file: /Applications/Microsoft Office 2008/Office/OfficePID.plist

You can use something like this to extract the key from this file.

use strict;
use MIME::Base64;

my $file = '/Applications/Microsoft Office 2008/Office/OfficePID.plist
+';
open (FILE,'<',$file);
my $flag = 0;
my $section = 0;
my $string;
foreach(<FILE>) {
  $flag = 1 if (m/<key>2000<\/key>/);
  $section++ if ($section == 1);
  $section = 1 if (m/<data>/ && $flag==1);
  if (m/<\/data>/) {
    $flag = 0;
    $section = 0;
  }
  if ($section == 2) {
    $string .= $_;
  }
}
close(FILE);
$string =~ s/\s//g;
my $hex = uc(unpack("H*", decode_base64(shift)));
$hex =~ s/(..)/$1,/g;
chop($hex);
decodekey($hex);

[download]

Yes, this is an odd way to parse XML, but it seems that Mac's put some illegal characters in there, causing XML::Parser to die.

I have been pondering whether to post this or not, but considering there are many programs available to do this job hopefully it is OK.

In reply to Retrieving Microsoft licence keys from your computer by lilphil

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.