root/trunk/licq/bin/licq.winconvert99a

#!/usr/bin/perl
#
# ICQ99a contact list converter, version 2
# (tested with builds 1547, 1677, 1700 and 1800)
#
# (c)1999 Erwin Aitenbichler <eait@gmx.at>
# This program is released under the terms of the GPL.
#

$path=(getpwuid($<))[7]."/.licq/";
$pathUsers=$path."users/";
$fnOwner=$path."owner.uin";
$fnUsers=$path."users.conf";
$verbose=1;
$|=1;

foreach $arg (@ARGV)
 {
  if ($arg eq "-q")
   { $verbose=0; }
  elsif ($arg eq "-v")
   { $verbose=2; }
  elsif ($arg eq "-vv")
   { $verbose=3; }
  else
   { $fn=$arg; }
 }

if (!defined($fn))
 {
  print STDERR "\nsyntax: licq.winconvert99a [options] <your_uin>.dat\n";
  print STDERR "Extracts all UINs out of an ICQ99a database and creates licq .uin files.\n";
  print STDERR "(tested with builds 1547, 1677, 1700 and 1800)\n";
  print STDERR "\nThe .dat-file is usually located in: <your_win_drive>/Program Files/icq/NewDB/\n";
  print STDERR "\noptions:\n";
  print STDERR "   -q   quiet\n";
  print STDERR "   -v   verbose\n";
  print STDERR "   -vv  verbose more\n";
  print STDERR "\n";
  exit 0;
 }

# get owner uin

open(INFH, "<$fnOwner") || die "can't open '$fnOwner'.\n";
while(<INFH>)
 {
  if ($_=~/Uin = (\d+)/)
   {
    $own_uin=$1;
   }
 }
close(INFH);
die "canŽt determine owner uin.\n" if (!defined($own_uin));
print "owner uin: $own_uin\n\n" if $verbose>=2;

# read users from users.conf

%uins=(); 
if (open(INFH, "<$fnUsers"))
 {
  while (<INFH>)
   {
    $uins{$1}=1 if ($_=~/User\d+ = (\d+)/);
   }
  close(INFH);
 }
else
 {
  print "Ž$fnUsersŽ not found - will create a new one.\n" if $verbose>=1;
 }

# import users

$count=0;
readFile($fn);

# write new users.conf

open(OUTFH, ">$fnUsers") || die "canŽt open Ž$fnUsersŽ for writing.\n";
@list=sort {$a <=> $b} (keys %uins);
print OUTFH "[users]\nNumOfUsers = ", $#list+1, "\n";
$i=1;
foreach $key (@list)
 {
  print OUTFH "User", $i++, " = ", $key, "\n";
 }
close(OUTFH);

print "$count users add.\n" if $verbose>=1;

if ($verbose>=1)
 {
  print "NOTE: This script doesn't support all user information fields.\n";
  print "Select 'Users/Update All Users' in licq to get full user information.\n";
 }

sub readFile()
 {
  my $fn=shift;
  open(INFH, "<$fn") || die "can't open file '$fn'\n";
  binmode INFH;    # for M$...
  my @buf;
  for ($pos=0; $pos<7; $pos++)
   {
    $buf[$pos]=ord(getc(INFH));
   }
  print "reading" if $verbose==1;
  while (!eof(INFH))
   {
    # find pattern: 00 id 00 n 00 00 00
    if ($buf[0]==0 &&
        $buf[1]!=0 &&
        $buf[2]==0 &&
        $buf[3]!=0 &&
        $buf[4]==0 &&
        $buf[5]==0 &&
        $buf[6]==0)
     {
      readRecord (1, $buf[3]);
      seek INFH, $pos, 0;
      readRecord (2, $buf[3]);
      seek INFH, $pos, 0;
     }
    shift (@buf);
    push (@buf, ord(getc(INFH)));
    $pos++;
    print "." if ($pos%10000==0 && $verbose==1);
   }
  close(INFH);
  print "\n" if $verbose==1;
 }

sub readRecord()
 {
  my $version=shift;
  my $n=shift;
  if ($version==1)
   {
    for ($i=0; $i<$n; $i++)
     {
      last if !readField1();
     }
   }
  else
   {
    for ($i=0; $i<$n; $i++)
     {
      last if !readField2();
     }
   }
  return if ($i<$n);
  return if !readString();             # display name
  my $displayName=$str;
  return if !readString();             # nick name
  return if $str eq "";
  my $nickName=$str;
  return if !readString();             # first name
  my $firstName=$str;
  return if !readString();             # last name
  my $lastName=$str;
  return if !readString();             # email
  my $email=$str;
  read(INFH, $buffer, 4);
  $uin=unpack("V", $buffer);
  return if ($uin==$own_uin);
  $count++ if (!$uins{$uin});
  $uins{$uin}=1;

  my $fnUIN=$pathUsers.$uin.".uin";
  if (!-f $fnUIN)
   {
    open(OUTFH, ">$fnUIN") || die "can't open '$fnUIN' for writing.\n";
    print OUTFH "[user]\n";
    print OUTFH "Alias = ", $displayName ne "" ? $displayName : $nickName;
    print OUTFH "\nFirstName = $firstName\n";
    print OUTFH "LastName = $lastName\n";
    print OUTFH "EMail = $email\n";
    print OUTFH "History = default\n";
    print OUTFH "Authorization =\n";
    print OUTFH "OnlineNotify =\n";
    print OUTFH "NewUser =\n";
    print OUTFH "NewMessages =\n";
    print OUTFH "Group =\n";
    print OUTFH "City =\n";
    print OUTFH "State =\n";
    print OUTFH "Homepage =\n";
    print OUTFH "Age =\n";
    print OUTFH "Sex =\n";
    print OUTFH "About =\n";
    print OUTFH "PhoneNumber =\n";
    print OUTFH "Country =\n";
    print OUTFH "VisibleList =\n";
    print OUTFH "InvisibleList =\n";
    close(OUTFH);
   }
  
  if ($verbose>=2)
   {
    print "display name : $displayName\n";
    print "nick name    : $nickName\n";
    print "first name   : $firstName\n";
    print "last name    : $lastName\n";
    print "email        : $email\n";
    print "uin          : $uin\n\n";
   }
 }

# read Žold styleŽ fields
sub readField1()
 {
  if (readString())
   {
    if ($str ne "")
     {
      print "$str\n" if $verbose>=3;
      my $n=2;
      $n=5 if ($str eq "ClientFeatures" ||
               $str eq "Picture Update Date");
      $n=3 if ($str eq "UserHomepageDescription" ||
               $str eq "UserHomepageCategory");
      read(INFH, $buffer, $n);
      return 1;
     }
   }
  return 0;
 }

# read Žnew styleŽ fields
sub readField2()
 {
  if (readString())
   {
    if ($str ne "")
     {
      print "$str\n" if $verbose>=3;
      my $c=getc(INFH);
      my $n=-1;
      $n=1 if $c eq "e";
      $n=2 if $c eq "f";
      $n=4 if ($c eq "i" || $c eq "h");
      if ($c eq "k")
       {
        $n=get();
        get();
       }
      return 0 if $n==-1;
      read(INFH, $buffer, $n) if $n>0;
      return 1;
     }
   }
  return 0;
 }
  
sub readString()
 {
  $str="";
  my $len=get();
  return 0 if get()!=0;
  return 1 if ($len==0);
  my $i, $c;
  for ($i=0; $i<$len-1; $i++)
   {
    $c=getc(INFH);
    return 0 if (ord($c)==0);
    $str.=$c;
   }
  return 0 if get()!=0;
  return 1;
 }

sub get()
 {
  my $c=getc(INFH);
  return $c if !defined($c);
  $c=ord($c);
  return $c;
 }