#!/usr/bin/perl

# a utility for extracting folder names from dbx files

use strict;
use IO::File;

my $file;
for(@ARGV)
{
	my $filename = $_;
	$file = IO::File->new("<$filename");
	$file->binmode();
	my $header;
	$file->read($header, 0x24bc);
	(my $magic, my $clsid, my $unknown, my $fileinfolen) = unpack("VVA20V", $header);
	if ($magic != 0xfe12adcf)
	{
		print STDERR "$filename doesn't look like an outlook dbx file. Skipping...\n";
		next;
	}
	if ($clsid != 0x6f74fdc5)
	{
		print STDERR "$filename doesn't look like a message database file. Skipping...\n";
		next;
	}
	if (($fileinfolen < 0) || ($fileinfolen > 100000))
	{
		$fileinfolen = 100000;
		print STDERR "Warning: $filename has unexpected file info object length: $fileinfolen.\n";
	}

	my $fileinfo;
	$file->read($fileinfo, $fileinfolen);
	(my $magic, my $srctype, my $regkey, my $foldername) = unpack("VCa256a256", $fileinfo);
	if ($magic != 0x00000001)
	{
		print STDERR "$filename doesn't seem to have a valid info header. Skipping...\n";
		next;
	}
	if ($srctype != 3)
	{
		print STDERR "$filename doesn't look like a local message store. Skipping...\n";
		next;
	}
	$foldername =~ s/\0//g;
	printf "$filename\t$foldername\n";
} continue {
	$file->close();
}