# addrbook.pl (c) 1999-2000 Scott Leighton # Example code for accessing the Palm desktop address.dat file # By: Scott Leighton Jan 2, 1999 # Permission granted to freely distribute provided that no # money changes hands, otherwise contact me: helphand@pacbell.net # # IMPORTANT NOTE REGARDING PORTABILITY #The code, as written, works fine on Intel systems, but is not portable #to systems that are not little endian. To make the code portable, follow #the advice of Beat Seeliger as noted below... thanks Beat for the #pointer . Scott # # #"By the way I run the script on a Sparc machine with Debian Linux, and #a found a little portability problem, that produces strange errors" # #"To read / write Short and Long values in binary format, you use #(un)pack with the "l" or "s" Format String. This works as long as you #are on an little endian byte order system (like Intel). If you would #be compatible to other systems use v for shorts and V for longs. This #produces you on every sytem a little endian binary." # # Beat Seeliger April 2000 $copyright$ = "Copyright 1999, Scott Leighton email:helphand@pacbell.net" use Strict; # Support routines for reading / writing Cstrings sub read_Cstring { read (CF, $_, 4) or die "unable to get always_zero : $!\n"; read (CF, $x, 1) or die "unable to get x : $!\n"; $x = unpack "C", $x; if ($x == 0xFF) { read (CF, $x, 2) or die "unable to get x : $!\n"; $x = unpack "s", $x; }; $_=""; read (CF, $_, $x) or die "unable to get cstring: $!\n" unless ($x == 0); return $_; } sub write_CString { my $cs = pop @_; my $x; print OF pack "l", 0x00; $x = length($cs); if ($x > 254) { print OF pack "C", 0xFF; print OF pack "s", $x; } else { print OF pack "C", $x; } print OF $cs unless ($x == 0); return; } # Grab input file from the current directory (NOT YOUR ORIGINAL I HOPE) # NOTE: For testing, copy address.dat to a work directory and run this # from there. DO NOT USE YOUR REAL FILE FOR TESTING!!!!! $buf = ""; my $fdir = ".\\"; open(CF, "<${fdir}address.dat") or die "Can't open address.dat : $!\n"; binmode (CF); # Read thru all of the stuff at the front of the file structure # print statements and error checking are part of the discovery # process of finding out what's in these fields when they are # not fully documented. read (CF, $tag, 4) or die "unable to get Tag: $!\n"; $buf .=$tag; read (CF, $gh_s, 1) or die "unable to get gh_s: $!\n"; $buf .=$gh_s; $gh_s = unpack "C", $gh_s; read (CF, $gh, $gh_s) or die "unable to get gh: $!\n" unless ($gh_s == 0); $buf .=$gh; read (CF, $x, 1) or die "unable to get x $i: $!\n"; $buf .=$x; $x = unpack "C", $x; if ($x == 0xFF) { # print "x was $x getting a short for length on custom labels\n"; read (CF, $x, 2) or die "unable to get x: $!\n"; $buf .=$x; $x = unpack "s", $x; # print "x is $x\n"; }; read (CF, $custom_labels, $x) or die "unable to get custom labels size $x $!\n" unless ($x == 0); $buf .=$custom_labels; read (CF, $c_u, 4) or die "unable to get c_u: $!\n"; $buf .=$c_u; read (CF, $c_n, 4) or die "unable to get c_n: $!\n"; $buf .=$c_n; $c_n = unpack "l", $c_n; @ci=(); @cid=(); @cname_dirty=(); @clong_name=(); @cshort_name=(); $i = 0; while ($i < $c_n) { read (CF, $ci[$i], 4) or die "unable to get ci $i: $!\n"; $buf .=$ci[$i]; read (CF, $cid[$i], 4) or die "unable to get cid $i: $!\n"; $buf .=$cid[$i]; read (CF, $cname_dirty[$i], 4) or die "unable to get cname_dirty $i: $!\n"; $buf .=$cname_dirty[$i]; read (CF, $cl, 1) or die "unable to get cl $i: $!\n"; $buf .=$cl; $cl = unpack "C", $cl; read (CF, $clong_name[$i], $cl) or die "unable to get clong_name $i: $!\n"; $buf .=$clong_name[$i]; read (CF, $cs, 1) or die "unable to get cs $i: $!\n"; $buf .=$cs; $cs = unpack "C", $cs; read (CF, $cshort_name[$i], $cs) or die "unable to get cshort_name $i: $!\n"; $buf .=$cshort_name[$i]; $i++; }; read (CF, $td_u1, 4) or die "unable to get td_u1: $!\n"; $buf .=$td_u1; read (CF, $td_n, 4) or die "unable to get td_n: $!\n"; $buf .=$td_n; read (CF, $td_u2, 4) or die "unable to get td_u2: $!\n"; $buf .=$td_u2; read (CF, $td_u3, 4) or die "unable to get td_u3: $!\n"; $buf .=$td_u3; read (CF, $td_u4, 4) or die "unable to get td_u4: $!\n"; $buf .=$td_u4; read (CF, $td_nf, 2) or die "unable to get td_nf: $!\n"; $buf .=$td_nf; $td_nf = unpack "s", $td_nf; $i = 0; @td_ft=(); while ($i < $td_nf) { read (CF, $td_ft[$i], 2) or die "unable to get td_ft $i: $!\n"; $buf .=$td_ft[$i]; $i++; }; # $buf has all header entries pre-loaded to this point. We stop # at entry_size in case we are going to add entries to the # file. read (CF, $entry_size, 4) or die "unable to get entry_size: $!\n"; $entry_size = unpack "l", $entry_size; $entries = $entry_size / 30; print "Entries were $entries, entry size $entry_size\n"; # clear the arrays we use to hold the 'records' we read. This is # not the optimum way of handling this. We have to read in ALL of # the records since the entry_size field might change if we add # or delete a record during this run. For testing and discovery # purposes, we've established a separate array for each field. # in production code, a different approach would be taken.... @ab_ft1 = (); @ab_ft2 = (); @ab_ft3 = (); @ab_ft4 = (); @ab_ft5 = (); @ab_ft6 = (); @ab_ft7 = (); @ab_ft8 = (); @ab_ft9 = (); @ab_ft10 = (); @ab_ft11 = (); @ab_ft12 = (); @ab_ft13 = (); @ab_ft14 = (); @ab_ft15 = (); @ab_ft16 = (); @ab_ft17 = (); @ab_ft18 = (); @ab_ft19 = (); @ab_ft20 = (); @ab_ft21 = (); @ab_ft22 = (); @ab_ft23 = (); @ab_ft24 = (); @ab_ft25 = (); @ab_ft26 = (); @ab_ft27 = (); @ab_ft28 = (); @ab_ft29 = (); @ab_ft30 = (); @ab_record_id = (); @ab_status = (); @ab_position = (); @ab_name=(); @ab_first=(); @ab_title = (); @ab_company = (); @ab_phone1_label = (); @ab_phone1_string = (); @ab_phone2_label = (); @ab_phone2_string = (); @ab_phone3_label = (); @ab_phone3_string = (); @ab_phone4_label = (); @ab_phone4_string = (); @ab_phone5_label = (); @ab_phone5_string = (); @ab_address = (); @ab_city = (); @ab_state = (); @ab_zip = (); @ab_country = (); @ab_note = (); @ab_private = (); @ab_category = (); @ab_custom1 = (); @ab_custom2 = (); @ab_custom3 = (); @ab_custom4 = (); @ab_display_phone = (); $i = 0; # Loop thru and load the arrays with the records present in # address book. while ($i < $entries) { read (CF, $ab_ft1[$i], 4) or die "unable to get ab_ft1 $i: $!\n"; read (CF, $ab_record_id[$i], 4) or die "unable to get ab_record_id $i: $!\n"; read (CF, $ab_ft2[$i], 4) or die "unable to get ab_ft2 $i: $!\n"; read (CF, $ab_status[$i], 4) or die "unable to get ab_status $i: $!\n"; $w = unpack "l", $ab_status[$i]; if ($w !=0) { printf "record id is %d", unpack "l", $ab_record_id[$i]; printf " status is %d", unpack "l", $ab_status[$i]; print " PENDING" if ($w & 0x08); print " ADD" if ($w & 0x01); print " UPDATE" if ($w & 0x02); print " DELETE" if ($w & 0x04); print " ARCHIVE" if ($w & 0x80); print "\n"; } $ab_status[$i] = pack "l" ,$w & 0xF7 if ($w & 0x08); #turn of pending bit read (CF, $ab_ft3[$i], 4) or die "unable to get ab_ft3 $i: $!\n"; read (CF, $ab_position[$i], 4) or die "unable to get ab_position $i: $!\n"; # printf " position id is %ld\n", unpack "l",$ab_position[$i]; read (CF, $ab_ft4[$i], 4) or die "unable to get ab_ft4 $i: $!\n"; $ab_name[$i] = &read_Cstring; read (CF, $ab_ft5[$i], 4) or die "unable to get ab_ft5 $i: $!\n"; $ab_first[$i] = &read_Cstring; read (CF, $ab_ft6[$i], 4) or die "unable to get ab_ft6 $i: $!\n"; $ab_title[$i] = &read_Cstring; read (CF, $ab_ft7[$i], 4) or die "unable to get ab_ft7 $i: $!\n"; $ab_company[$i] = &read_Cstring; read (CF, $ab_ft8[$i], 4) or die "unable to get ab_ft8 $i: $!\n"; read (CF, $ab_phone1_label[$i],4) or die "unable to get ab_phone1_label $i: !\n"; read (CF, $ab_ft9[$i], 4) or die "unable to get ab_ft9 $i: $!\n"; $ab_phone1_string[$i] = &read_Cstring; read (CF, $ab_ft10[$i], 4) or die "unable to get ab_ft10 $i: $!\n"; read (CF, $ab_phone2_label[$i],4) or die "unable to get ab_phone2_label $i: !\n"; read (CF, $ab_ft11[$i], 4) or die "unable to get ab_ft11 $i: $!\n"; $ab_phone2_string[$i] = &read_Cstring; read (CF, $ab_ft12[$i], 4) or die "unable to get ab_ft12 $i: $!\n"; read (CF, $ab_phone3_label[$i],4) or die "unable to get ab_phone3_label $i: !\n"; read (CF, $ab_ft13[$i], 4) or die "unable to get ab_ft13 $i: $!\n"; $ab_phone3_string[$i] = &read_Cstring; read (CF, $ab_ft14[$i], 4) or die "unable to get ab_ft14 $i: $!\n"; read (CF, $ab_phone4_label[$i],4) or die "unable to get ab_phone4_label $i: !\n"; read (CF, $ab_ft15[$i], 4) or die "unable to get ab_ft15 $i: $!\n"; $ab_phone4_string[$i] = &read_Cstring; read (CF, $ab_ft16[$i], 4) or die "unable to get ab_ft16 $i: $!\n"; read (CF, $ab_phone5_label[$i],4) or die "unable to get ab_phone5_label $i: !\n"; read (CF, $ab_ft17[$i], 4) or die "unable to get ab_ft17 $i: $!\n"; $ab_phone5_string[$i] = &read_Cstring; read (CF, $ab_ft18[$i], 4) or die "unable to get ab_ft18 $i: $!\n"; $ab_address[$i] = &read_Cstring; read (CF, $ab_ft19[$i], 4) or die "unable to get ab_ft19 $i: $!\n"; $ab_city[$i] = &read_Cstring; read (CF, $ab_ft20[$i], 4) or die "unable to get ab_ft20 $i: $!\n"; $ab_state[$i] = &read_Cstring; read (CF, $ab_ft21[$i], 4) or die "unable to get ab_ft21 $i: $!\n"; $ab_zip[$i] = &read_Cstring; read (CF, $ab_ft22[$i], 4) or die "unable to get ab_ft22 $i: $!\n"; $ab_country[$i] = &read_Cstring; read (CF, $ab_ft23[$i], 4) or die "unable to get ab_ft23 $i: $!\n"; $ab_note[$i] = &read_Cstring; read (CF, $ab_ft24[$i], 4) or die "unable to get ab_ft24 $i: $!\n"; read (CF, $ab_private[$i],4) or die "unable to get ab_private $i: !\n"; read (CF, $ab_ft25[$i], 4) or die "unable to get ab_ft25 $i: $!\n"; read (CF, $ab_category[$i],4) or die "unable to get ab_category $i: !\n"; read (CF, $ab_ft26[$i], 4) or die "unable to get ab_ft26 $i: $!\n"; $ab_custom1[$i] = &read_Cstring; read (CF, $ab_ft27[$i], 4) or die "unable to get ab_ft27 $i: $!\n"; $ab_custom2[$i] = &read_Cstring; read (CF, $ab_ft28[$i], 4) or die "unable to get ab_ft28 $i: $!\n"; $ab_custom3[$i] = &read_Cstring; read (CF, $ab_ft29[$i], 4) or die "unable to get ab_ft29 $i: $!\n"; $ab_custom4[$i] = &read_Cstring; read (CF, $ab_ft30[$i], 4) or die "unable to get ab_ft30 $i: $!\n"; read (CF, $ab_display_phone[$i],4) or die "unable to get ab_display_phone $i: !\n"; # print " $ab_company[$i] $ab_first[$i] $ab_name[$i]\n"; $i++; }; # address.dat file is loaded entirely now in the arrays. # $i has # of entries , $entries has number of entries, # $entry_size has $entries * 30 close (CF); # exit; # This unused code sets up a dummy record to add to the # address book for testing purposes. We actually aren't # doing it in this version of the code. $ab_ft1[$i] = pack "l", "1"; $ab_record_id[$i] = pack "l", "0"; $ab_ft2[$i] = pack "l", "1"; $ab_status[$i] = pack "l", (0x01 | 0x02); $ab_ft3[$i] = pack "l", "1"; $ab_position[$i] = pack "l", "0"; $ab_ft4[$i] = pack "l", "5"; $ab_name[$i] = "Perl Last Name"; $ab_ft5[$i] = pack "l", "5"; $ab_first[$i] = "Perl First Name"; $ab_ft6[$i] = pack "l", "5"; $ab_title[$i] = "Perl Title"; $ab_ft7[$i] = pack "l", "5"; $ab_company[$i] = " Perl Company"; $ab_ft8[$i] = pack "l", "1"; $ab_phone1_label[$i] = pack "l", "0"; $ab_ft9[$i] = pack "l", "5"; $ab_phone1_string[$i] = "949-555-1212"; $ab_ft10[$i] = pack "l", "1"; $ab_phone2_label[$i] = pack "l", "1"; $ab_ft11[$i] = pack "l", "5"; $ab_phone2_string[$i] = ""; $ab_ft12[$i] = pack "l", "1"; $ab_phone3_label[$i] = pack "l", "2"; $ab_ft13[$i] = pack "l", "5"; $ab_phone3_string[$i] = ""; $ab_ft14[$i] = pack "l", "1"; $ab_phone4_label[$i] = pack "l", "3"; $ab_ft15[$i] = pack "l", "5"; $ab_phone4_string[$i] = ""; $ab_ft16[$i] = pack "l", "1"; $ab_phone5_label[$i] = pack "l", "4"; $ab_ft17[$i] = pack "l", "5"; $ab_phone5_string[$i] = ""; $ab_ft18[$i] = pack "l", "5"; $ab_address[$i] = "123 Main Street"; $ab_ft19[$i] = pack "l", "5"; $ab_city[$i] = "Mission Viejo"; $ab_ft20[$i] = pack "l", "5"; $ab_state[$i] = "CA"; $ab_ft21[$i] = pack "l", "5"; $ab_zip[$i] = "92222"; $ab_ft22[$i] = pack "l", "5"; $ab_country[$i] = ""; $ab_ft23[$i] = pack "l", "5"; $ab_note[$i] = "This is a note added by Perl"; $ab_ft24[$i] = pack "l", "6"; $ab_private[$i] = pack "l", "0"; $ab_ft25[$i] = pack "l", "1"; $ab_category[$i] = pack "l", "0"; $ab_ft26[$i] = pack "l", "5"; $ab_custom1[$i] = "Perl Custom 1"; $ab_ft27[$i] = pack "l", "5"; $ab_custom2[$i] = "Perl Custom 2"; $ab_ft28[$i] = pack "l", "5"; $ab_custom3[$i] = "Perl Custom 3"; $ab_ft29[$i] = pack "l", "5"; $ab_custom4[$i] = "Perl Custom 4"; $ab_ft30[$i] = pack "l", "1"; $ab_display_phone[$i] = pack "l", "0"; # uncomment the following two lines to actually add # the above "test" record to the addressbook database. # $entries++; # $entry_size = $entries * 30; # write out the address book that's now in memory in the arrays # we created. If our program logic is correct, it should be # identical to the original address book. open(OF, ">${fdir}address.new") or die "Can't open address.new : $!\n"; binmode (OF); print OF $buf; print OF pack "l", $entry_size; $i = 0; while ($i < $entries) { print OF $ab_ft1[$i]; print OF $ab_record_id[$i]; # printf "Iteration %d record id %d ", $i, unpack "l",$ab_record_id[$i]; print OF $ab_ft2[$i]; print OF $ab_status[$i]; # printf " status %d", unpack "l",$ab_status[$i]; print OF $ab_ft3[$i]; print OF $ab_position[$i]; print OF $ab_ft4[$i]; # print " $ab_name[$i]\n"; &write_CString ($ab_name[$i]); print OF $ab_ft5[$i]; &write_CString ($ab_first[$i]); print OF $ab_ft6[$i]; &write_CString ($ab_title[$i]); print OF $ab_ft7[$i]; &write_CString ($ab_company[$i]); print OF $ab_ft8[$i]; print OF $ab_phone1_label[$i]; print OF $ab_ft9[$i]; &write_CString ($ab_phone1_string[$i]); print OF $ab_ft10[$i]; print OF $ab_phone2_label[$i]; print OF $ab_ft11[$i]; &write_CString ($ab_phone2_string[$i]); print OF $ab_ft12[$i]; print OF $ab_phone3_label[$i]; print OF $ab_ft13[$i]; &write_CString ($ab_phone3_string[$i]); print OF $ab_ft14[$i]; print OF $ab_phone4_label[$i]; print OF $ab_ft15[$i]; &write_CString ($ab_phone4_string[$i]); print OF $ab_ft16[$i]; print OF $ab_phone5_label[$i]; print OF $ab_ft17[$i]; &write_CString ($ab_phone5_string[$i]); print OF $ab_ft18[$i]; &write_CString ($ab_address[$i]); print OF $ab_ft19[$i]; &write_CString ($ab_city[$i]); print OF $ab_ft20[$i]; &write_CString ($ab_state[$i]); print OF $ab_ft21[$i]; &write_CString ($ab_zip[$i]); print OF $ab_ft22[$i]; &write_CString ($ab_country[$i]); print OF $ab_ft23[$i]; &write_CString ($ab_note[$i]); print OF $ab_ft24[$i]; print OF $ab_private[$i]; print OF $ab_ft25[$i]; print OF $ab_category[$i]; print OF $ab_ft26[$i]; &write_CString ($ab_custom1[$i]); print OF $ab_ft27[$i]; &write_CString ($ab_custom2[$i]); print OF $ab_ft28[$i]; &write_CString ($ab_custom3[$i]); print OF $ab_ft29[$i]; &write_CString ($ab_custom4[$i]); print OF $ab_ft30[$i]; print OF $ab_display_phone[$i]; $i++; }; print "$i records\n"; close (OF); exit; # Done... compare address.dat to address.new, they should be # identical if our logic worked.