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; } #### sub regexec { my $computer = shift; my $outkey = ""; my $key = `reg query \\\\\\\\$computer\\\\HKLM\\\\Software\\\\Microsoft\\\\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; } #### 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() { $flag = 1 if (m/2000<\/key>/); $section++ if ($section == 1); $section = 1 if (m// && $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);