Help with convert a program from c++ to delphi and add some fetures.

On
http://nd-net.com/icq2xml.html

there is a c++ program  insidei icqhist-0.91a.zip
that is called icq2xml.cpp

What I like to do is to translate this to delphi and then modify it so It' instead of generating a xml file' add the history to a database (for example an access database)

Can someone help me with that? (it vill be worth a lot of points for me)  
LVL 2
wqclatreAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

zebadaCommented:
I have written the code in Delphi but I can't test it because I have no data to test it with.
Can you post some test data? I'll make sure it works and then post the code.

Regards
Paul
0
wqclatreAuthor Commented:
I leave for another country in one hour. I will try to get som time to send you test-data on thursday (I will leave country again on friday so for the moment I'm a bit bizzy). Do you have an e-mail where I can send a test dat file?
0
zebadaCommented:
How about: wqclatre@blacky.co.nz

Cheers
Paul
0
Introducing Cloud Class® training courses

Tech changes fast. You can learn faster. That’s why we’re bringing professional training courses to Experts Exchange. With a subscription, you can access all the Cloud Class® courses to expand your education, prep for certifications, and get top-notch instructions.

zebadaCommented:
No test data so here's the code - untested.

// ICQ database to XML converter
// (database formats 99b to 2001b)
//
// (c)1999-2001 Erwin Aitenbichler <eait@gmx.at>
// This program is released under the terms of the GPL.

program icq2xml;
{$APPTYPE CONSOLE}
uses
  SysUtils;

const
  MAX_FIELDS = 5;
  MAXCONTACTS = 1024;
  DATE_UNIX2DELPHI = 25569;

type
  TContacts = record
    uin: LongWord;
    fields: array[0..MAX_FIELDS-1] of PChar;
  end;

  TIntelLongWord = Record
    case boolean of
      true: (bytes: array[0..3] of char);
      false: (value: LongWord);
  end;

  TIntelWord = Record
    case boolean of
      true: (bytes: array[0..1] of char);
      false: (value: Word);
  end;

var
  fieldNames: array[0..4] of string = ('MyDefinedHandle','NickName','FirstName','LastName','PrimaryEmail');
  fields: array[0..MAX_FIELDS-1] of PChar;
  cnt: integer = 0;
  contacts: array[0..MAXCONTACTS] of TContacts;

// _________________________________________________________________________
function btol(b: PChar): LongWord;
var
  v: TIntelLongWord;
begin
  v.bytes[0] := b[0];
  v.bytes[1] := b[1];
  v.bytes[2] := b[2];
  v.bytes[3] := b[3];
  Result := v.value;
end;

// _________________________________________________________________________
function btos(b: PChar): Word;
var
  v: TIntelWord;
begin
  v.bytes[0] := b[0];
  v.bytes[1] := b[1];
  Result := v.value;
end;

// _________________________________________________________________________
procedure Bwrite(var fd: File; line: string);
begin
  BlockWrite(fd,line,Length(line));
end;

// _________________________________________________________________________
procedure Bwriteln(var fd: File; line: string);
begin
  Bwrite(fd,line);
  BlockWrite(fd,#13#10,2);
end;

// _________________________________________________________________________
procedure contacts_put(uin: WORD);
var
  n,i: integer;
begin
  for n:=0 to cnt-1 do
    if ( uin=contacts[n].uin ) then
      break;
  contacts[n].uin := uin;
  for i:=0 to MAX_FIELDS-1 do
    contacts[n].fields[i] := fields[i];
  if( n=cnt ) then
    Inc(cnt);
end;

// _________________________________________________________________________
function getdate(p: PChar): string;
var
  i: LongWord;
begin
  i := btol(p);
  if ( i<$80000000 ) then
    Result := FormatDateTime('dd.mm.yy',Trunc(i)+DATE_UNIX2DELPHI)
  else
    Result := 'Invalid';
end;

// _________________________________________________________________________
function gettime(p: PChar): string;
var
  i: LongWord;
begin
  i := btol(p);
  if ( i<$80000000 ) then
    Result := FormatDateTime('dd.mm.yy',((i mod 86400)/86400)+DATE_UNIX2DELPHI)
  else
    Result := 'Invalid';
end;

// _________________________________________________________________________
function check_str(buf: PChar; s,l,sz: integer): boolean;
var
  i: integer;
  e: integer;
begin
  Result := false;
  e := s+l-1;
  if ( e>=sz ) then
    exit;
  for i:=s to e-1 do
    if ( buf[i]=chr(0) ) then
      exit;
  result := buf[e]=chr(0);
end;

// _________________________________________________________________________
procedure print_xml(var fd: File ; buf: PChar; l: integer);
var
  i: integer;
begin
  for i:=0 to l-1 do
  begin
    if ( buf[i]='<' ) then
      Bwrite(fd,'&lt;')
    else if ( buf[i]='&' ) then
      Bwrite(fd,'&amp;')
    else
      BlockWrite(fd,buf[i],1);
  end;
end;

// _________________________________________________________________________
function lookup_field(key: PChar): integer;
var
  i: integer;
begin
  for i:=0 to MAX_FIELDS-1 do
    if ( key=fieldNames[i] ) then
    begin
      Result := i;
      exit;
    end;
  Result := -1;
end;

// _________________________________________________________________________
var
  fd: File;
  sz: LongInt;
  buf: array of char;

  i,l,f: integer;
  entryOpen: boolean;
  invalid: boolean;

  dir: string;
  key: PChar;
  vlen: integer;
  uin: integer;

// _________________________________________________________________________
begin
  entryOpen := false;
  invalid := false;

  if ( ParamCount<2 ) then
  begin
    Writeln('ICQ database to XML converter 0.91 - (c)2001 Erwin Aitenbichler');
    Writeln('(For database formats 99b and newer)');
    Writeln('This program is released under the terms of the GPL');
    Writeln('syntax: icq2xml <datfile>');
    Writeln('        generates "contacts.xml" and "history.xml"');
    exit;
  end;

  try
    AssignFile(fd,ParamStr(1));
    FileMode := 1; {Set file access to readonly }
    Reset(fd,1);
    sz := FileSize(fd);
    SetLength(buf,sz);
    BlockRead(fd,buf,sz);
    closeFile(fd);
  except
    on Exception do
    begin
      Writeln('Can''t open input file: ',ParamStr(1));
      exit;
    end;
  end;

  try
    AssignFile(fd,'history.xml');
    FileMode := 2; {Set file access to read/write }
    Rewrite(fd,1);
  except
    on Exception do
    begin
      Writeln('Can''t create/open output file: history.xml for writing');
      exit;
    end;
  end;

  Bwriteln(fd,'<?xml version="1.0" encoding="iso-8859-1"?>');
  Bwriteln(fd,'<?xml-stylesheet type="text/xsl" href="history.xsl"?>');
  Bwriteln(fd,'<history>');

  for i:=0 to MAX_FIELDS-1 do
    fields[i] := nil;

  i := 0;
  while ( i<sz ) do
  begin
    l := btos(@buf[i]);

    if ( (i>=9) and
         (l>1) and
         (
           (
             (Ord(buf[i-9]) or Ord(buf[i-8]) or Ord(buf[i-7]) or Ord(buf[i-5]))=0) and
             (Ord(buf[i-6])=1)
           ) and
           check_str(@buf[0],i+2,l,sz) and
           (Ord(buf[i+l+15])>$32)
         ) then              // newer than 01.08.1996
      begin
        if ( Ord(buf[i+l+6])=0 ) then
          dir := 'incomming'
        else
          dir := 'outgoing';

        Bwriteln(fd,Format('<entry uin="%d" secs="%d" date="%s" time="%s" dir="%s">',
                          [btol(@buf[i-4]),btol(@buf[i+l+12]),getdate(@buf[i+l+12]),gettime(@buf[i+l+12]),dir]));
        print_xml(fd,@buf[i+2],l-1);
        Bwriteln(fd,'</entry>');
        invalid := true;
      end
    else if ( (l>1) and check_str(@buf[0],i+2,l,sz) ) then
    begin
      if ( invalid ) then
      begin
        for f:=0 to MAX_FIELDS-1 do
          fields[f] := nil;
        invalid := false;
      end;
      key := @buf[i+2];
      if ( buf[i+l+2]='k' ) then
      begin
        vlen := btos(@buf[i+l+3]);
        if ( check_str(@buf[0],i+l+5,vlen,sz) ) then
        begin
          if ( vlen>1 ) then
          begin
            f := lookup_field(key);
            if ( f>=0 ) then
              fields[f] := @buf[i+l+5];
          end;
          Inc(i,2+l+1+2+vlen-1);
        end;
      end
      else if ( buf[i+l+2]='i' ) then
      begin
        if ( key='UIN' ) then
        begin
          uin := btol(@buf[i+l+3]);
          if ( (fields[1]<>nil) or (fields[2]<>nil) ) then
            contacts_put(uin);
        end;
        Inc(i,2+l+1+4-1);
      end
      else if ( (buf[i+l+2]='d') or (buf[i+l+2]='e') ) then
      begin
        // skip 1 byte
        Inc(i,2+l+1);
      end
      else if ( (buf[i+l+2]='f') or (buf[i+l+2]='g') ) then
      begin
        // skip 2 bytes
        Inc(i,2+l+1+1);
      end
      else
        invalid := true
    end
    else
      invalid := true;
  end;
  if ( entryOpen ) then
    Bwriteln(fd,'</entry>');
  Bwriteln(fd,'</history>');
  CloseFile(fd);

  try
    AssignFile(fd,'contacts.xml');
    FileMode := 2; {Set file access to read/write }
    Rewrite(fd,1);
  except
    on Exception do
    begin
      Writeln('Can''t create/open output file: contacts.xml for writing');
      exit;
    end;
  end;

  Bwriteln(fd,'<?xml version="1.0" encoding="iso-8859-1"?>');
  Bwriteln(fd,'<?xml-stylesheet type="text/xsl" href="contacts.xsl"?>');
  Bwriteln(fd,'<contacts>');
  for i:=0 to cnt-1 do
  begin
    Bwriteln(fd,Format('<entry uin="%d">',[contacts[i].uin]));
    for f:=0 to MAX_FIELDs-1 do
    begin
      if ( contacts[i].fields[f]<>nil ) then
      begin
        Bwrite(fd,Format('<%s>',[fieldNames[f]]));
        print_xml(fd,contacts[i].fields[f],Length(contacts[i].fields[f]));
        Bwrite(fd,Format('</%s>',[fieldNames[f]]));
      end;
    end;
    Bwriteln(fd,'</entry>');
  end;
  Bwriteln(fd,'</contacts>');
  CloseFile(fd);
end.




0
wqclatreAuthor Commented:
Sorry for my late comment. Had to much to do before I went on vacation. Just got back so I will try this tomorrow (or send you test-data)
0
wqclatreAuthor Commented:
It seems like it doesn't work for me... I will send you a test file now.
0
wqclatreAuthor Commented:
done
0
zebadaCommented:
Ok, here's the fixed version (there were a couple of bugs) that appears to work OK with the test data.

It could be written a whole lot better in Delphi using different Delphi datatypes and constructs - I just did a line for line translation of the C code to the Delphi code.

// ICQ database to XML converter
// (database formats 99b to 2001b)
//
// (c)1999-2001 Erwin Aitenbichler <eait@gmx.at>
// This program is released under the terms of the GPL.
//
// Program translated from C to Delphi by
// Paul Blackmore <delphi@blacky.co.nz>

program icq2xml;
{$APPTYPE CONSOLE}
uses
  SysUtils;

const
  MAX_FIELDS = 5;
  MAXCONTACTS = 1024;
  DATE_UNIX2DELPHI = 25569;

type
  TContacts = record
    uin: LongWord;
    fields: array[0..MAX_FIELDS-1] of PChar;
  end;

  TIntelLongWord = Record
    case boolean of
      true: (bytes: array[0..3] of char);
      false: (value: LongWord);
  end;

  TIntelWord = Record
    case boolean of
      true: (bytes: array[0..1] of char);
      false: (value: Word);
  end;

var
  fieldNames: array[0..4] of string = ('MyDefinedHandle','NickName','FirstName','LastName','PrimaryEmail');
  fields: array[0..MAX_FIELDS-1] of PChar;
  cnt: integer = 0;
  contacts: array[0..MAXCONTACTS] of TContacts;

// _________________________________________________________________________
function btol(b: PChar): LongWord;
var
  v: TIntelLongWord;
begin
  v.bytes[0] := b[0];
  v.bytes[1] := b[1];
  v.bytes[2] := b[2];
  v.bytes[3] := b[3];
  Result := v.value;
end;

// _________________________________________________________________________
function btos(b: PChar): Word;
var
  v: TIntelWord;
begin
  v.bytes[0] := b[0];
  v.bytes[1] := b[1];
  Result := v.value;
end;

// _________________________________________________________________________
procedure Bwrite(var fd: File; line: string);
var
  written: integer;
begin
  BlockWrite(fd,line[1],Length(line),written);
end;

// _________________________________________________________________________
procedure Bwriteln(var fd: File; line: string);
begin
  Bwrite(fd,line);
  BlockWrite(fd,#13#10,2);
end;

// _________________________________________________________________________
procedure contacts_put(uin: WORD);
var
  n,i: integer;
begin
  n := 0;
  while ( n<cnt ) do
  begin
    if ( uin=contacts[n].uin ) then
      break;
    Inc(n);
  end;
  contacts[n].uin := uin;
  for i:=0 to MAX_FIELDS-1 do
    contacts[n].fields[i] := fields[i];
  if( n=cnt ) then
    Inc(cnt);
end;

// _________________________________________________________________________
function getdate(p: PChar): string;
var
  i: LongWord;
begin
  i := btol(p);
  if ( i<$80000000 ) then
    Result := FormatDateTime('dd.mm.yy',Trunc(i)+DATE_UNIX2DELPHI)
  else
    Result := 'Invalid';
end;

// _________________________________________________________________________
function gettime(p: PChar): string;
var
  i: LongWord;
begin
  i := btol(p);
  if ( i<$80000000 ) then
    Result := FormatDateTime('dd.mm.yy',((i mod 86400)/86400)+DATE_UNIX2DELPHI)
  else
    Result := 'Invalid';
end;

// _________________________________________________________________________
function check_str(buf: PChar; s,l,sz: integer): boolean;
var
  i: integer;
  e: integer;
begin
  Result := false;
  e := s+l-1;
  if ( e>=sz ) then
    exit;
  for i:=s to e-1 do
    if ( buf[i]=chr(0) ) then
      exit;
  result := buf[e]=chr(0);
end;

// _________________________________________________________________________
procedure print_xml(var fd: File ; buf: PChar; l: integer);
var
  i: integer;
begin
  for i:=0 to l-1 do
  begin
    if ( buf[i]='<' ) then
      Bwrite(fd,'&lt;')
    else if ( buf[i]='&' ) then
      Bwrite(fd,'&amp;')
    else
      BlockWrite(fd,buf[i],1);
  end;
end;

// _________________________________________________________________________
function lookup_field(key: PChar): integer;
var
  i: integer;
begin
  for i:=0 to MAX_FIELDS-1 do
    if ( key=fieldNames[i] ) then
    begin
      Result := i;
      exit;
    end;
  Result := -1;
end;

// _________________________________________________________________________
var
  fd: File;
  sz: LongInt;
  buf: array of char;

  i,l,f,r: integer;
  entryOpen: boolean;
  invalid: boolean;

  dir: string;
  key: PChar;
  vlen: integer;
  uin: integer;

// _________________________________________________________________________
begin
  entryOpen := false;
  invalid := false;

  if ( ParamCount<1 ) then
  begin
    Writeln('ICQ database to XML converter 0.91 - (c)2001 Erwin Aitenbichler');
    Writeln('(For database formats 99b and newer)');
    Writeln('This program is released under the terms of the GPL');
    Writeln('');
    Writeln('Program translated from C to Delphi by');
    Writeln('Paul Blackmore <delphi@blacky.co.nz>');
    Writeln('');
    Writeln('syntax: icq2xml <datfile>');
    Writeln('        generates "contacts.xml" and "history.xml"');
    exit;
  end;

  try
    AssignFile(fd,ParamStr(1));
    FileMode := 2; {Set file access to read/write }
    Reset(fd,1);
    sz := FileSize(fd);
    SetLength(buf,sz);
    try
      BlockRead(fd,buf[0],sz,r);
      if ( r<>sz ) then
        Raise Exception.Create('Unexpected end of file');
    except
      on e:Exception do
      begin
        closeFile(fd);
        Writeln('Can''t read from input file: ',ParamStr(1),'. ',e.Message);
        exit;
      end;
    end;
    closeFile(fd);
  except
    on e:Exception do
    begin
      Writeln('Can''t open input file: ',ParamStr(1),'. ',e.Message);
      exit;
    end;
  end;

  try
    AssignFile(fd,'history.xml');
    FileMode := 2; {Set file access to read/write }
    Rewrite(fd,1);
  except
    on Exception do
    begin
      Writeln('Can''t create/open output file: history.xml for writing');
      exit;
    end;
  end;

  Bwriteln(fd,'<?xml version="1.0" encoding="iso-8859-1"?>');
  Bwriteln(fd,'<?xml-stylesheet type="text/xsl" href="history.xsl"?>');
  Bwriteln(fd,'<history>');

  for i:=0 to MAX_FIELDS-1 do
    fields[i] := nil;

  i := 0;
  while ( i<sz ) do
  begin
    l := btos(@buf[i]);

    if ( (i>=9) and
         (l>1) and
         (
           (
             (Ord(buf[i-9]) or Ord(buf[i-8]) or Ord(buf[i-7]) or Ord(buf[i-5]))=0) and
             (Ord(buf[i-6])=1)
           ) and
           check_str(@buf[0],i+2,l,sz) and
           (Ord(buf[i+l+15])>$32)
         ) then              // newer than 01.08.1996
      begin
        if ( Ord(buf[i+l+6])=0 ) then
          dir := 'incomming'
        else
          dir := 'outgoing';

        Bwriteln(fd,Format('<entry uin="%d" secs="%d" date="%s" time="%s" dir="%s">',
                          [btol(@buf[i-4]),btol(@buf[i+l+12]),getdate(@buf[i+l+12]),gettime(@buf[i+l+12]),dir]));
        print_xml(fd,@buf[i+2],l-1);
        Bwriteln(fd,'</entry>');
        invalid := true;
      end
    else if ( (l>1) and check_str(@buf[0],i+2,l,sz) ) then
    begin
      if ( invalid ) then
      begin
        for f:=0 to MAX_FIELDS-1 do
          fields[f] := nil;
        invalid := false;
      end;
      key := @buf[i+2];
      if ( buf[i+l+2]='k' ) then
      begin
        vlen := btos(@buf[i+l+3]);
        if ( check_str(@buf[0],i+l+5,vlen,sz) ) then
        begin
          if ( vlen>1 ) then
          begin
            f := lookup_field(key);
            if ( f>=0 ) then
              fields[f] := @buf[i+l+5];
          end;
          Inc(i,2+l+1+2+vlen-1);
        end;
      end
      else if ( buf[i+l+2]='i' ) then
      begin
        if ( key='UIN' ) then
        begin
          uin := btol(@buf[i+l+3]);
          if ( (fields[1]<>nil) or (fields[2]<>nil) ) then
            contacts_put(uin);
        end;
        Inc(i,2+l+1+4-1);
      end
      else if ( (buf[i+l+2]='d') or (buf[i+l+2]='e') ) then
      begin
        // skip 1 byte
        Inc(i,2+l+1);
      end
      else if ( (buf[i+l+2]='f') or (buf[i+l+2]='g') ) then
      begin
        // skip 2 bytes
        Inc(i,2+l+1+1);
      end
      else
        invalid := true
    end
    else
      invalid := true;
    Inc(i);
  end;
  if ( entryOpen ) then
    Bwriteln(fd,'</entry>');
  Bwriteln(fd,'</history>');
  CloseFile(fd);

  try
    AssignFile(fd,'contacts.xml');
    FileMode := 2; {Set file access to read/write }
    Rewrite(fd,1);
  except
    on Exception do
    begin
      Writeln('Can''t create/open output file: contacts.xml for writing');
      exit;
    end;
  end;

  Bwriteln(fd,'<?xml version="1.0" encoding="iso-8859-1"?>');
  Bwriteln(fd,'<?xml-stylesheet type="text/xsl" href="contacts.xsl"?>');
  Bwriteln(fd,'<contacts>');
  for i:=0 to cnt-1 do
  begin
    Bwriteln(fd,Format('<entry uin="%d">',[contacts[i].uin]));
    for f:=0 to MAX_FIELDs-1 do
    begin
      if ( contacts[i].fields[f]<>nil ) then
      begin
        Bwrite(fd,Format('<%s>',[fieldNames[f]]));
        print_xml(fd,contacts[i].fields[f],Length(contacts[i].fields[f]));
        Bwrite(fd,Format('</%s>',[fieldNames[f]]));
      end;
    end;
    Bwriteln(fd,'</entry>');
  end;
  Bwriteln(fd,'</contacts>');
  CloseFile(fd);
end.


0
zebadaCommented:
I've just compared outputs - still some bugs with data format - I'll fix and repost.
0
zebadaCommented:
Bugs fixed :)

// ICQ database to XML converter
// (database formats 99b to 2001b)
//
// (c)1999-2001 Erwin Aitenbichler <eait@gmx.at>
// This program is released under the terms of the GPL.
//
// Program translated from C to Delphi by
// Paul Blackmore <delphi@blacky.co.nz>

program icq2xml;
{$APPTYPE CONSOLE}
uses
  SysUtils;

const
  MAX_FIELDS = 5;
  MAXCONTACTS = 1024;
  DATE_UNIX2DELPHI = 25570;
  SEC_PER_DAY = 86400;

type
  TContacts = record
    uin: LongWord;
    fields: array[0..MAX_FIELDS-1] of PChar;
  end;

  TIntelLongWord = Record
    case boolean of
      true: (bytes: array[0..3] of char);
      false: (value: LongWord);
  end;

  TIntelWord = Record
    case boolean of
      true: (bytes: array[0..1] of char);
      false: (value: Word);
  end;

var
  fieldNames: array[0..4] of string = ('MyDefinedHandle','NickName','FirstName','LastName','PrimaryEmail');
  fields: array[0..MAX_FIELDS-1] of PChar;
  cnt: integer = 0;
  contacts: array[0..MAXCONTACTS] of TContacts;

// _________________________________________________________________________
function btol(b: PChar): LongWord;
var
  v: TIntelLongWord;
begin
  v.bytes[0] := b[0];
  v.bytes[1] := b[1];
  v.bytes[2] := b[2];
  v.bytes[3] := b[3];
  Result := v.value;
end;

// _________________________________________________________________________
function btos(b: PChar): Word;
var
  v: TIntelWord;
begin
  v.bytes[0] := b[0];
  v.bytes[1] := b[1];
  Result := v.value;
end;

// _________________________________________________________________________
procedure Bwrite(var fd: File; line: string);
var
  written: integer;
begin
  BlockWrite(fd,line[1],Length(line),written);
end;

// _________________________________________________________________________
procedure Bwriteln(var fd: File; line: string);
begin
  Bwrite(fd,line);
  BlockWrite(fd,#13#10,2);
end;

// _________________________________________________________________________
procedure contacts_put(uin: LongWord);
var
  n,i: integer;
begin
  n := 0;
  while ( n<cnt ) do
  begin
    if ( uin=contacts[n].uin ) then
      break;
    Inc(n);
  end;
  contacts[n].uin := uin;
  for i:=0 to MAX_FIELDS-1 do
    contacts[n].fields[i] := fields[i];
  if( n=cnt ) then
    Inc(cnt);
end;

// _________________________________________________________________________
function getdate(p: PChar): string;
var
  i: LongWord;
begin
  i := btol(p);
  if ( i<$80000000 ) then
    Result := FormatDateTime('dd.mm.yyyy',Trunc(i/SEC_PER_DAY)+DATE_UNIX2DELPHI)
  else
    Result := 'Invalid';
end;

// _________________________________________________________________________
function gettime(p: PChar): string;
var
  i: LongWord;
begin
  i := btol(p);
  if ( i<$80000000 ) then
    Result := FormatDateTime('hh:nn',((i mod SEC_PER_DAY)/SEC_PER_DAY))
  else
    Result := 'Invalid';
end;

// _________________________________________________________________________
function check_str(buf: PChar; s,l,sz: integer): boolean;
var
  i: integer;
  e: integer;
begin
  Result := false;
  e := s+l-1;
  if ( e>=sz ) then
    exit;
  for i:=s to e-1 do
    if ( buf[i]=chr(0) ) then
      exit;
  result := buf[e]=chr(0);
end;

// _________________________________________________________________________
procedure print_xml(var fd: File ; buf: PChar; l: integer);
var
  i: integer;
begin
  for i:=0 to l-1 do
  begin
    if ( buf[i]='<' ) then
      Bwrite(fd,'&lt;')
    else if ( buf[i]='&' ) then
      Bwrite(fd,'&amp;')
    else
      BlockWrite(fd,buf[i],1);
  end;
end;

// _________________________________________________________________________
function lookup_field(key: PChar): integer;
var
  i: integer;
begin
  for i:=0 to MAX_FIELDS-1 do
    if ( key=fieldNames[i] ) then
    begin
      Result := i;
      exit;
    end;
  Result := -1;
end;

// _________________________________________________________________________
var
  fd: File;
  sz: LongInt;
  buf: array of char;

  i,l,f,r: integer;
  entryOpen: boolean;
  invalid: boolean;

  dir: string;
  key: PChar;
  vlen: integer;
  uin: LongWord;

// _________________________________________________________________________
begin
  entryOpen := false;
  invalid := false;

  if ( ParamCount<1 ) then
  begin
    Writeln('ICQ database to XML converter 0.91 - (c)2001 Erwin Aitenbichler');
    Writeln('(For database formats 99b and newer)');
    Writeln('This program is released under the terms of the GPL');
    Writeln('');
    Writeln('Program translated from C to Delphi by');
    Writeln('Paul Blackmore <delphi@blacky.co.nz>');
    Writeln('');
    Writeln('syntax: icq2xml <datfile>');
    Writeln('        generates "contacts.xml" and "history.xml"');
    exit;
  end;

  try
    AssignFile(fd,ParamStr(1));
    FileMode := 2; {Set file access to read/write }
    Reset(fd,1);
    sz := FileSize(fd);
    SetLength(buf,sz);
    try
      BlockRead(fd,buf[0],sz,r);
      if ( r<>sz ) then
        Raise Exception.Create('Unexpected end of file');
    except
      on e:Exception do
      begin
        closeFile(fd);
        Writeln('Can''t read from input file: ',ParamStr(1),'. ',e.Message);
        exit;
      end;
    end;
    closeFile(fd);
  except
    on e:Exception do
    begin
      Writeln('Can''t open input file: ',ParamStr(1),'. ',e.Message);
      exit;
    end;
  end;

  try
    AssignFile(fd,'history.xml');
    FileMode := 2; {Set file access to read/write }
    Rewrite(fd,1);
  except
    on Exception do
    begin
      Writeln('Can''t create/open output file: history.xml for writing');
      exit;
    end;
  end;

  Bwriteln(fd,'<?xml version="1.0" encoding="iso-8859-1"?>');
  Bwriteln(fd,'<?xml-stylesheet type="text/xsl" href="history.xsl"?>');
  Bwriteln(fd,'<history>');

  for i:=0 to MAX_FIELDS-1 do
    fields[i] := nil;

  i := 0;
  while ( i<sz ) do
  begin
    l := btos(@buf[i]);

    if ( (i>=9) and
         (l>1) and
         (
           (
             (Ord(buf[i-9]) or Ord(buf[i-8]) or Ord(buf[i-7]) or Ord(buf[i-5]))=0) and
             (Ord(buf[i-6])=1)
           ) and
           check_str(@buf[0],i+2,l,sz) and
           (Ord(buf[i+l+15])>$32)
         ) then              // newer than 01.08.1996
      begin
        if ( Ord(buf[i+l+6])=0 ) then
          dir := 'incomming'
        else
          dir := 'outgoing';

        Bwriteln(fd,Format('<entry uin="%d" secs="%d" date="%s" time="%s" dir="%s">',
                          [btol(@buf[i-4]),btol(@buf[i+l+12]),getdate(@buf[i+l+12]),gettime(@buf[i+l+12]),dir]));
        print_xml(fd,@buf[i+2],l-1);
        Bwriteln(fd,'</entry>');
        invalid := true;
      end
    else if ( (l>1) and check_str(@buf[0],i+2,l,sz) ) then
    begin
      if ( invalid ) then
      begin
        for f:=0 to MAX_FIELDS-1 do
          fields[f] := nil;
        invalid := false;
      end;
      key := @buf[i+2];
      if ( buf[i+l+2]='k' ) then
      begin
        vlen := btos(@buf[i+l+3]);
        if ( check_str(@buf[0],i+l+5,vlen,sz) ) then
        begin
          if ( vlen>1 ) then
          begin
            f := lookup_field(key);
            if ( f>=0 ) then
              fields[f] := @buf[i+l+5];
          end;
          Inc(i,2+l+1+2+vlen-1);
        end;
      end
      else if ( buf[i+l+2]='i' ) then
      begin
        if ( key='UIN' ) then
        begin
          uin := btol(@buf[i+l+3]);
          if ( (fields[1]<>nil) or (fields[2]<>nil) ) then
            contacts_put(uin);
        end;
        Inc(i,2+l+1+4-1);
      end
      else if ( (buf[i+l+2]='d') or (buf[i+l+2]='e') ) then
      begin
        // skip 1 byte
        Inc(i,2+l+1);
      end
      else if ( (buf[i+l+2]='f') or (buf[i+l+2]='g') ) then
      begin
        // skip 2 bytes
        Inc(i,2+l+1+1);
      end
      else
        invalid := true
    end
    else
      invalid := true;
    Inc(i);
  end;
  if ( entryOpen ) then
    Bwriteln(fd,'</entry>');
  Bwriteln(fd,'</history>');
  CloseFile(fd);

  try
    AssignFile(fd,'contacts.xml');
    FileMode := 2; {Set file access to read/write }
    Rewrite(fd,1);
  except
    on Exception do
    begin
      Writeln('Can''t create/open output file: contacts.xml for writing');
      exit;
    end;
  end;

  Bwriteln(fd,'<?xml version="1.0" encoding="iso-8859-1"?>');
  Bwriteln(fd,'<?xml-stylesheet type="text/xsl" href="contacts.xsl"?>');
  Bwriteln(fd,'<contacts>');
  for i:=0 to cnt-1 do
  begin
    Bwriteln(fd,Format('<entry uin="%d">',[contacts[i].uin]));
    for f:=0 to MAX_FIELDs-1 do
    begin
      if ( contacts[i].fields[f]<>nil ) then
      begin
        Bwrite(fd,Format('<%s>',[fieldNames[f]]));
        print_xml(fd,contacts[i].fields[f],Length(contacts[i].fields[f]));
        Bwrite(fd,Format('</%s>',[fieldNames[f]]));
      end;
    end;
    Bwriteln(fd,'</entry>');
  end;
  Bwriteln(fd,'</contacts>');
  CloseFile(fd);
end.


0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
wqclatreAuthor Commented:
Thanks... works wounderfoul
0
wqclatreAuthor Commented:
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Delphi

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.