Generated: Tue Feb 2 17:54:17 2010 from addrbook.pl 2006/10/21 3.9 KB.
#!/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