addrbook.pl to HTML.

index -|- end

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

index -|- top