2012-03-16 15:17:56 -04:00

161 lines
3.3 KiB
Perl

#-----------------------------------------------------------
# bagtest2.pl
#
# copyright 2009 H. Carvey, keydet89@yahoo.com
#-----------------------------------------------------------
package bagtest2;
use strict;
my %config = (hive => "NTUSER\.DAT",
osmask => 22,
hasShortDescr => 1,
hasDescr => 0,
hasRefs => 0,
version => 20090828);
sub getConfig{return %config}
sub getShortDescr {
return "Test -- BagMRU";
}
sub getDescr{}
sub getRefs {}
sub getHive {return $config{hive};}
sub getVersion {return $config{version};}
my $VERSION = getVersion();
my %bagmru;
sub pluginmain {
my $class = shift;
my $hive = shift;
::logMsg("Launching bagtest v.".$VERSION);
my $reg = Parse::Win32Registry->new($hive);
my $root_key = $reg->get_root_key;
my $key_path = "Software\\Microsoft\\Windows\\Shell\\BagMRU";
my $key;
if ($key = $root_key->get_subkey($key_path)) {
::rptMsg($key_path);
# ::rptMsg("LastWrite Time ".gmtime($key->get_timestamp())." (UTC)");
::rptMsg("");
traverse($key);
foreach my $i (sort keys %bagmru) {
my $str = sprintf "%-30s ".$bagmru{$i},$i;
::rptMsg($str);
}
}
else {
::rptMsg($key_path." not found.");
::logMsg($key_path." not found.");
}
}
sub traverse {
my $key = shift;
my $name = (split(/BagMRU/,$key->get_path()))[1];
my @bags;
foreach my $val ($key->get_list_of_values()) {
next unless ($val->get_name() =~ m/\d+/);
my $path;
my $data = $val->get_data();
my $size = unpack("v",substr($data,0,20));
my $type = unpack("C",substr($data,2,1));
if ($type == 0x47 || $type == 0x46 || $type == 0x42 || $type == 0x41 ||
$type == 0xc3) {
my $str1 = getStrings1($data);
$path = $str1;
}
elsif ($type == 0x31 || $type == 0x32 || $type == 0xb1) {
my($ascii,$uni) = getStrings2($data);
$path = $uni;
}
elsif ($type == 0x2f) {
# bytes 3-5 of $data contain a drive letter
$path = substr($data,0x03,3);
}
else {
# Nothing
}
$bagmru{$name."\\".$val->get_name()} = $path;
}
foreach my $subkey ($key->get_list_of_subkeys()) {
traverse($subkey);
}
}
sub getStrings1 {
my $data = shift;
my $d = substr($data,0x05,length($data) - 1);
$d =~ s/\00/-/g;
$d =~ s/[[:cntrl:]]//g;
my @t = split(/-/,$d);
my @s;
for my $i (1..scalar(@t) - 1) {
push(@s,$t[$i]) if (length($t[$i]) > 2);
}
return $t[0]." (".join(',',@s).")";
}
sub getStrings2 {
# ASCII short name starts at 0x0E, and is \00 terminated; 0x14 bytes
# after that is the null-term Unicode name
my $data = shift;
my ($ascii,$uni);
my $cursor = 0x0e;
my $tag = 1;
while($tag) {
my $byte = substr($data,$cursor,1);
if (unpack("C",$byte) == 0x00) {
$tag = 0;
}
else {
$ascii .= $byte;
$cursor += 1;
}
}
$cursor += 0x14;
if ($ascii eq "RECENT") {
$uni = substr($data,$cursor,length($data) - 1);
$uni =~ s/\00//g;
$uni =~ s/[[:cntrl:]]//g;
}
else {
my $tag = 1;
my $count = 0;
while($tag) {
my $byte = substr($data,$cursor,2);
if ($count > 2 && unpack("v",$byte) == 0x00) {
$tag = 0;
}
else {
$uni .= $byte;
$count++;
$cursor += 2;
}
}
$uni =~ s/\00//g;
$uni =~ s/[[:cntrl:]]//g;
}
return ($ascii,$uni);
}
1;