#!/Perl
# addrbook.pl
# AIM: To decode a BINARY compuserve addrbook,dat file,
# and output the email addresses found.
# geoff mclane - october, 2006
# http://geoffmclane.com/mperl/samples
require "logfile.pl" or die "Missing logfile.pl ...\n"; # my simple log file and some other utility subs
# log file stuff
my ($LF);
my $outfile = 'temp.'.$0.'.txt';
open_log($outfile);
prt( "$0 ... Hello, World...\n" );
# start of file
# 0000:0000 02 38 00 01 00 0E 4A 61  6D 65 73 20 41 6E 64 65 .8....James Ande
# 0000:0010 72 73 6F 6E 21 49 4E 54  45 52 4E 45 54 3A 73 76 rson!INTERNET:sv
# 0000:0020 67 40 73 69 6C 69 63 6F  6E 2D 76 61 6C 6C 65 79 g@silicon-valley
# 0000:0030 2E 63 6F 2E 75 6B 13 42  79 20 6C 65 74 74 65 72 .co.uk.By letter

##my $in_file = 'F:/FTEMP/Support/addrb2.dat';
my $in_file = 'F:/FTEMP/Support/addrbOOK.dat';
my $out_csv = 'tempemail.csv';
my $data = '';
my $dcnt = 0;
my $wrap = 16;
my $rows = 0;
my $buf = '';
my $n = 0;
my $dat = 0;
my $d16 = 0;
my $ch = '';
my $tot = 0;
my $of2 = 0;
my $ina = 0;
my $acnt = 0;
my $asc = '';
my $ac3 = 0;	# three block of ascci
my $hex = '';
my $lnhex = '';
my @emails = ();
my $sepln = ';-----------------------------------------------------------------------------';
open(INF, "<$in_file") or mydie( "ERROR: Can NOT open file [$in_file] ...\n");
binmode( INF );
#while (!eof(INF)) {
#	$dat = get_byte(INF);
#	$hex = sprintf("\x%02X", $dat);
#	$lnhex .= $hex;
#	$data .= chr($dat);
#	$dcnt++;
#	if ($dcnt == $wrap) {
#		$rows++;
#		prt( "$rows [$lnhex] [$data]\n" );
#		$data = '';
#		$dcnt = 0;
#		$lnhex = '';
#	}
#	$tot++;
#}
#$row++;
#prt( "$rows [$lnhex] [$data]\n" ) if ($dcnt);
#close( INF );
#open(INF, "<$in_file") or mydie( "ERROR: Can NOT open file [$in_file] ...\n");
#binmode( INF );
$tot = 0;
$n = 3;
# just eat first 3 bytes of file
while ($n && !eof(INF)) {
	$dat = get_byte(INF);
	$tot++;
	$n--;
}
while (!eof(INF)) {
	$n = get_word(INF);
	$asc = '';
	my $max = 3;
	my $w2 = ($n >> 8);
	if ($w2 == 128) {
		$max = 4;
		$n = $n - ($w2 << 8);
	}
	my $s = '';
	for (my $i = 0; $i < $max; $i++) {
		$s = get_string(INF);
		if ($i == 1) {
			if ($s =~ /^INTERNET:(.+)/) {
				$s = $1;
			} elsif ($s =~ /^\[(\d+,\d+)\]$/) {
				$s = $1;
				$s =~ s/,/\./;
				$s .= '@compuserve.com';
			} elsif ($s =~ /^(\d+,\d+)$/) {
				$s = $1;
				$s =~ s/,/\./;
				$s .= '@compuserve.com';
			}
			if (!($s =~ /@/)) {
				$s .= '@compuserve.com';
			}
		} elsif ($i > 1) {
			$s =~ s/\r//g;
			$s =~ s/\n/ /g;
			if ($s =~ /,/) {
				##$s = '"' . $s . '"';
				$s =~ s/,/ - /g;
			}
		}
		$asc .= $s;
		if ($i < 2) {
			$asc .= ',';
		} elsif (($i +1) < $max) {
			$asc .= ' ';
		}
	}
	prt( "$n [$asc]\n" );
	push(@emails, $asc);
}
$acnt = scalar @emails;
if ($acnt) {
	prt( "Got $acnt emails from $in_file ... writting to $out_csv ...\n" );
	open( OTF, ">$out_csv" ) or mydie( "ERROR: Unable to create $out_csv\n" );
	foreach my $em (@emails) {
		my @arr = split(",", $em);
		print OTF "$em\n";
		prt( "$sepln\n" );
		prt( $arr[0] . ",\n" );
		prt( "mailto: " . $arr[1] . "\n" );
		if (scalar @arr > 2) {
			prt( $arr[2] . "\n" );
		}
	}
	close OTF;
	##system($out_csv);
} else {
	prt( "WARNING: Failed to find any emails in $in_file ...\n" );
}
close_log($outfile,1);
exit(0);


sub get_byte {
	my ($h) = shift;
	my $d = -1;
	if (!eof($h)) {
		my $c = getc($h);
		$d = ord($c);
	}
	return $d;
}

sub get_word {
	my ($h) = shift;
	my $w  = -1;
	my $b1 = -1;
	my $b2 = -1;
	if (!eof($h)) {
		$b1 = get_byte($h);
		if (!eof($h)) {
			$b2 = get_byte($h);
			$w = ($b2 << 8) + $b1;
		}
	}
	return $w;
}

sub get_string {
	my ($h) = shift;
	my $s = '';
	if (!eof($h)) {
		my $l = get_byte($h);
		while ($l && !eof($h)) {
			$s .= chr(get_byte($h));
			$l--;
		}
	}
	return $s;
}

## eof - addrbook.pl




