J’ Abide

It kinda pisses me off that you cannot open all you contacts/messages/information from the blackberry desktop manager.  I have my old backup.ipd file that has a bunch of contacts and information that I want on my new blackberry (Bold for thoses that care) but I dont want to replace all the information on my new BB, mostly because I am unclear as to what would happen and dont want to redo any of my existing work.

It also ticked me off that the only tool ABC Amber BlackBerry Converter available was going to cost me.  Not that the tools isnt any good, it very well could be, but for certain I am cheap and I have perl.  So I create a parser for the ipd file.  This parser will list all the databases, and create a CSV file for any specific database.

./extipd.pl -l file.ipd    ( to list all the databases in the file)
./extipd.pl 53 file.ipd  (to extract database #53 as a CSV to standard out)
./extipd.pl ‘Address Book’ file.ipd (to extract database ‘Address Book’ as a CSV to standard out

I have only tested the address book dump, as that is all I was interested in.  Should you have a specific need please feel free to contact me.

Here it is free for you use.
Update Jan 12, 2010: Added a custom output routine only for ‘Address Book - All’
Update July 23, 2009: Added a custom output routine only for ‘Phone Call Logs’
Update: Added some functionality to extipd.pl to output the fields order by their ‘type’

extipd3

#!/usr/bin/perl -w
use strict;
use Data::Dumper;

my $bDump = 0;

my $f = $ARGV[0];

# $0 -l file.ipd
# $0 53 file.ipd
# $0 'Address Book' file.ipd
if($#ARGV != 1 || ! -f $ARGV[1]){
    print "Usage $0 -l file.ipdn";
    print "Usage $0 53 file.ipdn";
    print "Usage $0 'Address Book' file.ipdn";
    exit();
}

my $bInfoOnly = 0;
my $dbRequired = -1;
my $dbRequiredName = '';

if($ARGV[0] eq '-l'){
    $bInfoOnly = 1;
}elsif( $ARGV[0] =~ /[0-9]+/ ){
    $dbRequired = $ARGV[0];
}else{
    $dbRequiredName = $ARGV[0];
}

my %CustomOutput =( 'Phone Call Logs' => &PhoneCallLogs,
    'Address Book - All' => &AddressBookAll );

sub ProcessFields($){
    my $f = shift;
    my @fields = ();
    my ($flen, $ftype, $fdata);

    while(length($f) > 0){
        ($flen, $ftype, $f) = unpack('SCa*', $f);
        ($fdata, $f) = unpack("a[$flen]a*", $f);
        my $field = { 'type' => $ftype, 'len' => $flen, 'data' => $fdata};
        push @fields, $field;
    }
    return @fields;
}

my $buf;
my @dbnames = ();

open(FF, $ARGV[1]) or die "Cannot open file $!n";

read(FF, $buf, 38); # Inter@ctive Pager Backup/Restore Filen
read(FF, $buf, 4); # Version(1) numdb(2) dbname_sep(1)

# WTF I thought this was little-endian?????
# if it was then I could use 's' instead of 'n' .. but its not 
my ($v, $numdb, $dname_sep) = unpack('cnc',$buf);

if($bInfoOnly){
    print "Version [$v]nNumber of databases [$numdb]n";
}

for(my $i = 0; $i < $numdb; $i++){
    read(FF, $buf, 2);
    my $len = unpack('S',$buf); #Whereas this is most defnitely 's' not 'n'
    read(FF, $buf, $len);
    my $name = unpack('A*',$buf);
    if($bInfoOnly){
        print "Database $i : $namen";
    }
    push @dbnames, $name;
    if($dbRequired == -1){
        if($name eq $dbRequiredName){
            $dbRequired = $i;
        }
    }elsif($i == $dbRequired){
        $dbRequiredName = $name;
    }
}

if($bInfoOnly){
    close FF;
    exit();
}

my @dbRecs = ();
while (not eof(FF)){
    read(FF, $buf, 6);
    my ($id, $len) = unpack('SL', $buf);

    read(FF, $buf, $len);
    my ($v, $rh, $uniq, $fields) = unpack('CSLa*', $buf);

    my @fields = ProcessFields($fields);
    #sort fields by type
    if($dbRequired == $id){
        my @ofields = sort { $a->{'type'} <=> $b->{'type'} } @fields;
        push @dbRecs, @ofields;
    }

}
close FF;

if(! @dbRecs){
    exit();
}

foreach my $r (@dbRecs){
    if($bDump){
        print "[" . Dumper($r) . "]n";
    }else{
        my $bFirst = 1;
        foreach my $f (@{$r}){
            if(!$bFirst){print ',';}
            if($f->{'len'} > 0){
                if(exists $CustomOutput{$dbRequiredName}){
                    $CustomOutput{$dbRequiredName}->($f);
                }else{
                    print '"'.unpack('A*', $f->{'data'}).'"';
                }
            }else{
                print '""';
            }
            $bFirst = 0;
        }
        print "n";
    }
}

exit;

{
use bigint;  # using bigint globally slows this puppy down
    sub GetEpoch(@){
        my @b = @_;
        my $exp = 0;
        my $V = 0;
        foreach my $b (@b){
            $V = $V + $b * (256 ** $exp);
            $exp++;
        }
        $V = $V / 1000;
        return int($V);
    }
}

sub PhoneCallLogs {
    my $f = shift;
    if($f->{'type'} == 4){
        # 8 byte trickery
        my @b = unpack('C8', $f->{'data'});
        my $e = GetEpoch(@b);
        print '"'.$e.'"';
    }elsif ($f->{'type'} == 2){
        my $dir = unpack('I', $f->{'data'});
        if($dir == 0){
            print '"Received"';
        }elsif($dir == 1){
            print '"Placed"';
        }elsif($dir == 2){
            print '"Missed"';
        }else{
            print '"Unknown"';
        }
    }elsif ($f->{'type'} == 3){
        print '"'.unpack('I', $f->{'data'}).'"';
    }elsif ($f->{'type'} == 12){
        print '"'.unpack('A*', $f->{'data'}).'"';
    }elsif ($f->{'type'} == 31){
        print '"'.unpack('A*', $f->{'data'}).'"';
    }else{
        print '""';
    }
}
# ADDRESS BOOK - ALL
# Has format
# 'len' => 8, 'type' => 2 'data' => 'ÿÿÿÿÿÿÿÿ',
# 'len' => 7, 'type' => 3 'data' => 'Default',
# 'len' => 4, 'type' => 5 'data' => '_<89>BV',
# 'len' => XXYY, 'type' => 10
# This is the data part
## length->SS, type->C, data->xzxczxc
## length->SS, type->C, data->xzxczxc
## length->SS, type->C, data->xzxczxc

sub AddressBookAll {
    # not used .. simply going to sort by type and
    # print if printable
    my %ATYPE = ( 32 => 'Name', 1 => 'Email', 6 => 'Work',
        16 => 'Work 2', 7 => 'Home', 17 => 'Home 2', 8 => 'Mobile',
        35 => 'Address', 38 => 'City', 39 => 'Province', 40 => 'Postal Code',
        41 => 'Country', 10 => 'Pin', 42 => 'Title', 33 => 'Company');

    my $f = shift;
    if($f->{'type'} == 10){
        my @Afields;
        my $adlen;
        my $adtype;
        my $addata;
        my $data = $f->{'data'};
        while(length($data) > 0){
            ($adlen, $adtype, $data) = unpack('SCa*', $data);
            ($addata, $data) = unpack("a[$adlen]a*", $data);
#print "[$adtype]n";
#           if($adtype == 49){
            if(($addata =~ m/^([[:print:]]+)$/) && ($adtype != 100)){
                $addata = $1;
                my $Afield = { 'type'=>$adtype, 'len'=>$adlen, 'data'=>$addata};
                push @Afields, $Afield;
            }
        }
        @Afields = sort { $a->{'type'} <=> $b->{'type'} } @Afields;
        my $bFirst = 1;
        foreach my $f (@Afields){
            if(!$bFirst){
                print ',';
            }
            $bFirst = 0;
            print '"';
            if(exists($ATYPE{$f->{'type'}})){
                print '[' .$ATYPE{$f->{'type'}} .']' ." : ";
            }else{
                print '[' . ord($f->{'type'}).'] : ';
            }
            print $f->{'data'};
            print '"';
        }
    }

    # not outputting anything else
}