Below is a more or less literal translation of the VBS code linked to in the OP (identical subroutine structure; similar variable names).
That code does the right thing on 2 WinXP machines with messaging installed. But I learnt during testing that the path to follow to get the PST names was different on both, so I assume there are different versions of Windows Messaging involved here, and probably there are even more variants where the code will fail ;-).
use strict;
use warnings;
use Win32::TieRegistry (Delimiter => '/');
use Encode;
use Data::Dumper;
my %r = (
PSTGuidLocation => '01023d00',
MasterConfig => '01023d0e',
PSTCheckFile => '00033009',
PSTFile => '001f6700',
PSTFile1 => '001e6700',
keyMaster => '9207f3e0a3b11019908b08002b2a56c2',
ProfilesRoot => 'CUser/Software/Microsoft/Windows NT/CurrentVersion/
+Windows Messaging Subsystem/Profiles/',
DefaultProfileString => '/DefaultProfile',
);
my $MessagingRoot = $Registry->{$r{ProfilesRoot}} # points to the Prof
+iles reg path of the current user
or die "Windows Messaging not installed here!?\n";
my $DefaultProfileName = $MessagingRoot->{$r{DefaultProfileString}}
or die "There are no messaging profiles for this user on this machin
+e.\n";
my %Out = ("DefaultProfile" => $DefaultProfileName, Profiles => {});
my @Profiles = grep {s/\/$//} keys %{$MessagingRoot};
for my $profileName (@Profiles) {
$Out{Profiles}{$profileName} = [ GetPSTsForProfile($profileName) ];
}
print Dumper(\%Out);
sub GetPSTsForProfile {
my $profileName = shift;
my $regProfile = $MessagingRoot->{"$profileName/"};
my $strValue = $MessagingRoot->{"$profileName/$r{keyMaster}//$r{Mast
+erConfig}"};
my $fmt = '%02x' x 16;
my @PSTFileNames;
for my $strPSTGuid (map {sprintf $fmt, unpack('C16', $_)} $strValue
+=~ /.{16}/g) {
my $PSTGuid2 = PSTlocation($regProfile->{"$strPSTGuid/"}) or next;
push @PSTFileNames, PSTFileName($regProfile->{$PSTGuid2})
if IsAPST($regProfile->{"$strPSTGuid/"});
}
return @PSTFileNames;
}
sub IsAPST {
my $PSTGuid = shift or return;
my $PSTGuildValue = $PSTGuid->{"/$r{PSTCheckFile}"}
or return;
unpack('L', $PSTGuildValue) == 0x20;
}
sub PSTlocation {
my $PSTGuid = shift or return;
my $PSTGuildValue = $PSTGuid->{"/$r{PSTGuidLocation}"}
or return;
my $len = length($PSTGuildValue);
my @PSTGuildValue = unpack("C$len",$PSTGuildValue);
my $fmt = '%02x' x $len;
sprintf($fmt, @PSTGuildValue);
}
sub PSTFileName {
my $PSTGuid = shift or return;
my $PSTName = $PSTGuid->{$r{PSTFile}};
defined $PSTName ? decode('UCS2-LE', $PSTName) : $PSTGuid->{$r{PSTFi
+le1}};
}