wqclatre
asked on
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)
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)
ASKER
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?
How about: wqclatre@blacky.co.nz
Cheers
Paul
Cheers
Paul
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','NickNa
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(
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',
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',
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,'<')
else if ( buf[i]='&' ) then
Bwrite(fd,'&')
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-stylesh
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
(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
[btol(@buf[i-4]),btol(@buf
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
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,vl
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.xm
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-stylesh
Bwriteln(fd,'<contacts>');
for i:=0 to cnt-1 do
begin
Bwriteln(fd,Format('<entry
for f:=0 to MAX_FIELDs-1 do
begin
if ( contacts[i].fields[f]<>nil
begin
Bwrite(fd,Format('<%s>',[f
print_xml(fd,contacts[i].f
Bwrite(fd,Format('</%s>',[
end;
end;
Bwriteln(fd,'</entry>');
end;
Bwriteln(fd,'</contacts>')
CloseFile(fd);
end.
// 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','NickNa
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(
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',
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',
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,'<')
else if ( buf[i]='&' ) then
Bwrite(fd,'&')
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-stylesh
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
(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
[btol(@buf[i-4]),btol(@buf
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
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,vl
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.xm
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-stylesh
Bwriteln(fd,'<contacts>');
for i:=0 to cnt-1 do
begin
Bwriteln(fd,Format('<entry
for f:=0 to MAX_FIELDs-1 do
begin
if ( contacts[i].fields[f]<>nil
begin
Bwrite(fd,Format('<%s>',[f
print_xml(fd,contacts[i].f
Bwrite(fd,Format('</%s>',[
end;
end;
Bwriteln(fd,'</entry>');
end;
Bwriteln(fd,'</contacts>')
CloseFile(fd);
end.
ASKER
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)
ASKER
It seems like it doesn't work for me... I will send you a test file now.
ASKER
done
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','NickNa
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],Leng
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',
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',
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,'<')
else if ( buf[i]='&' ) then
Bwrite(fd,'&')
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('Unexpect
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-stylesh
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
(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
[btol(@buf[i-4]),btol(@buf
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
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,vl
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.xm
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-stylesh
Bwriteln(fd,'<contacts>');
for i:=0 to cnt-1 do
begin
Bwriteln(fd,Format('<entry
for f:=0 to MAX_FIELDs-1 do
begin
if ( contacts[i].fields[f]<>nil
begin
Bwrite(fd,Format('<%s>',[f
print_xml(fd,contacts[i].f
Bwrite(fd,Format('</%s>',[
end;
end;
Bwriteln(fd,'</entry>');
end;
Bwriteln(fd,'</contacts>')
CloseFile(fd);
end.
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','NickNa
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],Leng
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',
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',
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,'<')
else if ( buf[i]='&' ) then
Bwrite(fd,'&')
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('Unexpect
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-stylesh
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
(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
[btol(@buf[i-4]),btol(@buf
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
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,vl
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.xm
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-stylesh
Bwriteln(fd,'<contacts>');
for i:=0 to cnt-1 do
begin
Bwriteln(fd,Format('<entry
for f:=0 to MAX_FIELDs-1 do
begin
if ( contacts[i].fields[f]<>nil
begin
Bwrite(fd,Format('<%s>',[f
print_xml(fd,contacts[i].f
Bwrite(fd,Format('</%s>',[
end;
end;
Bwriteln(fd,'</entry>');
end;
Bwriteln(fd,'</contacts>')
CloseFile(fd);
end.
I've just compared outputs - still some bugs with data format - I'll fix and repost.
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Thanks... works wounderfoul
ASKER
Do you think you can look into my question :
https://www.experts-exchange.com/jsp/qManageQuestion.jsp?ta=delphi&qid=20330633
https://www.experts-exchange.com/jsp/qManageQuestion.jsp?ta=delphi&qid=20330633
Can you post some test data? I'll make sure it works and then post the code.
Regards
Paul