Category : Pascal Source Code
Archive   : CVTSRC21.ZIP
Filename : FONWRITE.PAS

Unit FonWrite;

{ Write the new phone directory. }

Interface

Uses FonGlobs,
MyFuncs,
FonFuncs;

procedure WriteFon;

Implementation

const fonwrite_id : string[33] = '@(#) fonwrite.pas 2.1 by D-ro 3.'#0;

procedure WriteFon;

function EON(Parity: char): tParity;
begin
case Parity of
'E': EON := even;
'O': EON := odd;
else EON := none;
end;
end; {EON}

function NoMS(Parity: char): char;
begin
case Parity of
'S',
'M': NoMS := 'N';
else NoMS := Parity;
end;
end; {NoMS}

function GTProto ( Protocol: Str2 ): char;
begin
if Protocol = 'TE' then GTProto := 'A'
else if Protocol = 'T1' then GTProto := 'B'
else if Protocol = 'KE' then GTProto := 'C'
else if Protocol[1] = 'X' then
if Protocol[2] = '1'
then GTProto := 'F'
else GTProto := 'D'
else if Protocol = 'WX' then GTProto := 'E'
else if Protocol[1] = 'Y' then GTProto := 'G'
else if Protocol = 'IM' then GTProto := 'G'
else if Protocol = 'ZM' then GTProto := 'H'
else if Protocol = 'SL' then GTProto := 'I'
else if Protocol = 'CB' then GTProto := 'J'
else if Protocol = 'ML' then GTProto := 'K'
else if Protocol <> DefProto
then GTProto := GTProto(DefProto)
else GTProto := ' ';
end; {GTProto}

function QmodemProto ( Protocol: Str2 ): char;
begin
if Protocol = 'AS' then QmodemProto := 'A'
else if Protocol[1] = 'T' then QmodemProto := 'T'
else if Protocol = 'KE' then QmodemProto := 'K'
else if Protocol[1] = 'X' then
if Protocol[2] = '1' then QmodemProto := 'Y'
else if Protocol[2] = 'C' then QmodemProto := 'C'
else if Protocol[2] = 'R' then QmodemProto := 'R'
else QmodemProto := 'X'
else if Protocol = 'WX' then QmodemProto := 'W'
else if Protocol[1] = 'Y' then
if Protocol[2] = 'G' then QmodemProto := 'I'
else QmodemProto := 'Y'
else if Protocol = 'IM' then QmodemProto := 'I'
else if Protocol = 'ZM' then QmodemProto := 'Z'
else if Protocol = 'SL' then QmodemProto := 'S'
else if Protocol = 'CB' then QmodemProto := 'R'
else if Protocol = 'ML' then QmodemProto := 'M'
else if Protocol = 'M7' then QmodemProto := 'X'
else if Protocol <> DefProto
then QmodemProto := QmodemProto(DefProto)
else QmodemProto := ' ';
end; {QmodemProto}

function ProPlusProto ( Protocol: Str2 ): tProProto;
{ Neglects YmodemGBatch, Ext1..3 }
begin
if Protocol = 'M7' then ProPlusProto := ppModem7
else if Protocol[1] = 'Y' then
if Protocol[2] = 'G' then ProPlusProto := ppYModemG
else if Protocol[2] = 'B' then ProPlusProto := ppYModemBatch
else ProPlusProto := ppYModem
else if Protocol[1] = 'T' then ProPlusProto := ppTelink
else if Protocol[1] = 'X' then
if Protocol[2] = '1'
then ProPlusProto := ppYModem
else ProPlusProto := ppXModem
else if Protocol = 'KE' then ProPlusProto := ppKermit
else if Protocol = 'AS' then ProPlusProto := ppASCII
else if Protocol = 'CB' then ProPlusProto := ppCISB
else if Protocol = 'WX' then ProPlusProto := ppWXModem
else if Protocol = 'IM' then ProPlusProto := ppIModem
else if Protocol = 'SL' then ProPlusProto := ppSEAlink
else if Protocol = 'ZM' then ProPlusProto := ppExt1
else if Protocol = 'ML' then ProPlusProto := ppExt2
else if Protocol <> DefProto
then ProPlusProto := ProPlusProto(DefProto)
else ProPlusProto := ppNone;
end; {ProPlusProto}

function TelixProto ( Protocol: Str2 ): char;
begin
if Protocol = 'AS' then TelixProto := 'A'
else if Protocol[1] = 'X' then
if Protocol[2] = '1' then TelixProto := '1'
else if Protocol[2] = 'G' then TelixProto := 'G'
else if Protocol[2] = 'R' then TelixProto := 'C'
else TelixProto := 'X'
else if Protocol[1] = 'Y' then
if Protocol[2] = 'G' then TelixProto := 'E'
else TelixProto := 'Y'
else if Protocol = 'KE' then TelixProto := 'K'
else if Protocol[1] = 'T' then TelixProto := 'T'
else if Protocol = 'ZM' then TelixProto := 'Z'
else if Protocol = 'SL' then TelixProto := 'S'
else if Protocol = 'CB' then TelixProto := 'C'
else if Protocol = 'M7' then TelixProto := 'M'
else if Protocol = 'ML' then TelixProto := 'L'
else if Protocol = 'IM' then TelixProto := 'E'
else if Protocol = 'WX' then TelixProto := 'Y'
else if Protocol <> DefProto
then TelixProto := TelixProto(DefProto)
else TelixProto := ' ';
end; {TelixProto}

function K9Proto ( Protocol: Str2 ): char;
begin
if Protocol = 'AS' then K9Proto := 'A'
else if Protocol[1] = 'T' then K9Proto := 'T'
else if Protocol = 'K9' then K9Proto := 'K'
else if Protocol[1] = 'X' then
if Protocol[2] = '1' then K9Proto := 'Y'
else if Protocol[2] = 'C' then K9Proto := 'C'
else K9Proto := 'X'
else if Protocol = 'WX' then K9Proto := 'W'
else if Protocol[1] = 'Y' then K9Proto := 'Y'
else if Protocol = 'ZM' then K9Proto := 'Z'
else if Protocol = 'M7' then K9Proto := '7'
else if Protocol <> DefProto
then K9Proto := K9Proto(DefProto)
else K9Proto := ' ';
end; {K9Proto}

function ProPlusTerm ( Term: Str3 ): tProTerm;
begin
if Term[1] = 'V' then
if Term[2] = '5'
then ProPlusTerm := ptVT52
else ProPlusTerm := ptVT102
else if (Term = 'ANS') or
(Term = 'AVT') then ProPlusTerm := ptANSI
{ nearest to AVATAR }
else if Term = 'TTY' then ProPlusTerm := ptTTY
else if Term = 'IBM' then ProPlusTerm := ptIBM3101
else if Term = '327' then ProPlusTerm := pt3270
else if Term = 'AVP' then ProPlusTerm := ptADDSVP
else if Term = 'AD5' then ProPlusTerm := ptADM5
else if Term = 'H19' then ProPlusTerm := ptHEATH19
else if (Term[1] = 'T') and
(Term[2] = '9') then
case Term[3] of
'1': ProPlusTerm := ptTVI910;
'2': ProPlusTerm := ptTVI920;
'3': ProPlusTerm := ptTVI925;
'5': ProPlusTerm := ptTVI950;
'6': ProPlusTerm := ptTVI955;
end
else if (Term[1] = 'W') and
(Term[2] = 'Y') then
if Term[3] = '5'
then ProPlusTerm := ptWYSE50
else ProPlusTerm := ptWYSE100
else if Term <> DefTerm
then ProPlusTerm := ProPlusTerm(DefTerm)
else ProPlusTerm := ptTTY;
end; {ProPlusTerm}

function Boyan40Term ( Term: Str3 ): char;
begin
if Term[1] = 'V' then
if Term[2] = '5'
then Boyan40Term := '5'
else Boyan40Term := '1'
else if (Term = 'ANS') or
(Term = 'AVT') or {Next best to AVATAR}
(Term = 'GSP') or
(Term = 'HST')
then Boyan40Term := Term[1]
else if Term = 'TTY' then Boyan40Term := 'D'
else if Term <> DefTerm
then Boyan40Term := Boyan40Term(DefTerm)
else Boyan40Term := ' ';
end; {Boyan40Term}

function Pib4Term ( Term: Str3 ): char;
begin
if Term[1] = 'V' then
if Term[2] = '5'
then Pib4Term := '1'
else Pib4Term := '3'
else if (Term = 'ANS') or
(Term = 'AVT') then Pib4Term := '2' {Next best to AVATAR}
else if Term = 'GSP' then Pib4Term := '4'
else if Term = 'HST' then Pib4Term := '5'
else if Term = 'TEK' then Pib4Term := '6'
else if (Term[1] = 'A') and
(Term[2] = 'D') then
if Term[3] = '3'
then Pib4Term := '7'
else Pib4Term := '8'
else if (Term[1] = 'T') and
(Term[2] = '9') then Pib4Term := '9'
else if Term <> DefTerm
then Pib4Term := Pib4Term(DefTerm)
else Pib4Term := ' ';
end; {Pib4Term}

function TelixTerm ( Term: Str3 ): tTelixTerm;
begin
if Term[1] = 'V' then
if Term[2] = '5'
then TelixTerm := ttVT52
else TelixTerm := ttVT102
else if Term = 'ANS' then TelixTerm := ttANSI
else if Term = 'AVT' then TelixTerm := ttAVATAR
else if Term = 'TTY' then TelixTerm := ttTTY
else if Term <> DefTerm
then TelixTerm := TelixTerm(DefTerm)
else TelixTerm := ttTTY;
end; {TelixTerm}

function To_tSpeed ( Speed : longint ): tSpeed;
begin
case trunc(Speed / 10) of
30: To_tSpeed := b300;
120: To_tSpeed := b1200;
240: To_tSpeed := b2400;
480: To_tSpeed := b4800;
960: To_tSpeed := b9600;
1920: To_tSpeed := b19200;
3840: To_tSpeed := b38400;
5760: To_tSpeed := b57600;
11520: To_tSpeed := b115200;
end;
end;


procedure WriteBoyan40;
var FileRec: Boyan40FileRec;
count: word;
c: byte;
begin
FillChar(FileRec, sizeof(FileRec), #0); {Start with null record.}

if ListSize > 200 then ListSize := 200;

for count := 1 to ListSize do
with List[count]^ do
begin
FileRec[count].Entry := count;

FileRec[count].Name := copy(Name, 1, 29);
FileRec[count].Phone := copy(Phone, 1, 16);

FileRec[count].Speed := To_tSpeed(Speed);
FileRec[count].Parity := EON(Parity);

delete(List[count]^.Script, pos('.', List[count]^.Script), 12);
FileRec[count].Script := Script;

if Date <> ''
then for c := 1 to 5 do
FileRec[count].Date[c] := Date[c]
else for c := 1 to 5 do
FileRec[count].Date[c] := #$FA; {Initial value.}

FileRec[count].Protocol := QmodemProto(Protocol);
FileRec[count].Term := Boyan40Term(Term);

if OrigFon = Boyan40 then
FileRec[count].Next := BNext;
end; {with List[count]^ do}
if ListSize < 200 then
for count := succ(ListSize) to 200 do
begin
FileRec[count].Entry := count;
FileRec[count].Speed := To_tSpeed(DefSpeed);
FileRec[count].Parity := EON(DefParity);
for c := 1 to 5 do
FileRec[count].Date[c] := #$FA; {Initial value.}
FileRec[count].Protocol := QmodemProto(DefProto);
FileRec[count].Term := Boyan40Term(DefTerm);
end; {for count := ...}

assign(FonDir, OutFonFile);
rewrite(FonDir, sizeof(Boyan40FileRec));
BlockWrite(FonDir, FileRec, 1);
close(FonDir);
end; {WriteBoyan40}


procedure WriteBoyan;
var FileRec: BoyanFileRec;
count: word;
begin
FillChar(FileRec, sizeof(FileRec), #0); {Start with null record.}

if ListSize > 200 then ListSize := 200;

for count := 1 to ListSize do
with List[count]^ do
begin
FileRec[count].Entry := count;

FileRec[count].Name := copy(Name, 1, 29);
FileRec[count].Phone := copy(Phone, 1, 16);

FileRec[count].Speed := To_tSpeed(Speed);
FileRec[count].Parity := EON(Parity);

delete(List[count]^.Script, pos('.', List[count]^.Script), 12);
FileRec[count].Script := Script;

if Date <> ''
then FileRec[count].Date := copy(Date, 1, 5)
else FileRec[count].Date := StringOf(5, #$FA); {Initial value.}

FileRec[count].Protocol := QmodemProto(Protocol);

if OrigFon = Boyan then
FileRec[count].Next := BNext;
end; {with List[count]^ do}
if ListSize < 200 then
for count := succ(ListSize) to 200 do
begin
FileRec[count].Entry := count;
FileRec[count].Speed := To_tSpeed(DefSpeed);
FileRec[count].Parity := EON(DefParity);
FileRec[count].Date := StringOf(5, #$FA); {Initial value.}
end; {for count := ...}

assign(FonDir, OutFonFile);
rewrite(FonDir, sizeof(BoyanFileRec));
BlockWrite(FonDir, FileRec, 1);
close(FonDir);
end; {WriteBoyan}


procedure WriteQmodem40;
var FileRec: Qmodem40FileRec;
count: word;
c: byte;
begin
FillChar(FileRec, sizeof(FileRec), #0); {Start with null record.}

if ListSize > 200 then ListSize := 200;

for count := 1 to ListSize do
with List[count]^ do
begin
FileRec[count].Name := copy(Name, 1, 27);
FileRec[count].Phone := copy(Phone, 1, 19);
if Speed >= 38400
then FileRec[count].Speed := 38400
else FileRec[count].Speed := Speed;
FileRec[count].Parity := EON(Parity);
case FileRec[count].Parity of
even,
odd: FileRec[count].DBits := 7;
none: FileRec[count].DBits := ord(DBits) - ord('0');
end;
FileRec[count].SBits := ord(SBits) - ord('0');
case Echo of
'Y': FileRec[count].Echo := 'H';
else FileRec[count].Echo := 'F';
end;
FileRec[count].Protocol := QmodemProto(Protocol);
FileRec[count].Calls := Trunc(Calls);
FileRec[count].Date := Date;

FileRec[count].Password := copy(Password,1,14);

FileRec[count].Script := Script;

FileRec[count].NoteNum := count;

if OrigFon = Qmodem40 then
begin
FileRec[count].Filler := QFiller;
FileRec[count].Filler2 := QFiller2;
FileRec[count].EntryNum := EntryNum;
FileRec[count].Marked := Marked;
FileRec[count].Term := QTerm;
FileRec[count].ScrLearn := ScrLearn;
{if HasNote
FileRec[count].NoteNum := NoteNum;} {could cause dupes}
FileRec[count].HasNote := HasNote;
for c := 1 to 8 do
FileRec[count].Spare[c] := Q4Spare[c];
end
end; {with List[count]^ do}
if ListSize < 200 then
for count := succ(ListSize) to 200 do
begin
if DefSpeed >= 38400
then FileRec[count].Speed := 38400
else FileRec[count].Speed := DefSpeed;
FileRec[count].Parity := EON(DefParity);
case FileRec[count].Parity of
even,
odd: FileRec[count].DBits := 7;
none: FileRec[count].DBits := ord(DefDBits) - ord('0');
end;
FileRec[count].SBits := ord(DefSBits) - ord('0');
case DefEcho of
'Y': FileRec[count].Echo := 'H';
else FileRec[count].Echo := 'F';
end;
FileRec[count].Protocol := QmodemProto(DefProto);
FileRec[count].NoteNum := count;
end; {for count := ...}

assign(FonDir, OutFonFile);
rewrite(FonDir, sizeof(Qmodem40FileRec));
BlockWrite(FonDir, FileRec, 1);
close(FonDir);
end; {WriteQmodem40}


procedure WriteQmodem21;
var FileRec: Qmodem21FileRec;
count: word;
c: byte;
begin
FillChar(FileRec, sizeof(FileRec), #0); {Start with null record.}

if ListSize > 200 then ListSize := 200;

for count := 1 to ListSize do
with List[count]^ do
begin
FileRec[count].Name := Name;
FileRec[count].Phone := copy(Phone, 1, 14);
if Speed >= 38400
then FileRec[count].Speed := 38400
else FileRec[count].Speed := Speed;
FileRec[count].Parity := EON(Parity);
case FileRec[count].Parity of
even,
odd: FileRec[count].DBits := 7;
none: FileRec[count].DBits := ord(DBits) - ord('0');
end;
FileRec[count].SBits := ord(SBits) - ord('0');
FileRec[count].Echo := Echo;
FileRec[count].Protocol := QmodemProto(Protocol);
FileRec[count].Calls := Calls;
FileRec[count].Date := Date;

FileRec[count].Password := copy(Password,1,14);

FileRec[count].Script := Script;

if OrigFon = Qmodem21 then
for c := 1 to 15 do
FileRec[count].Spare[c] := QSpare[c];
end; {with List[count]^ do}
if ListSize < 200 then
for count := succ(ListSize) to 200 do
begin
if DefSpeed >= 38400
then FileRec[count].Speed := 38400
else FileRec[count].Speed := DefSpeed;
FileRec[count].Parity := EON(DefParity);
case FileRec[count].Parity of
even,
odd: FileRec[count].DBits := 7;
none: FileRec[count].DBits := ord(DefDBits) - ord('0');
end;
FileRec[count].SBits := ord(DefSBits) - ord('0');
FileRec[count].Echo := DefEcho;
FileRec[count].Protocol := QmodemProto(DefProto);
end; {for count := ...}

assign(FonDir, OutFonFile);
rewrite(FonDir, sizeof(Qmodem21FileRec));
BlockWrite(FonDir, FileRec, 1);
close(FonDir);
end; {WriteQmodem21}


procedure WriteQmodem20;
var FileRec: Qmodem20FileRec;
count: word;
begin
FillChar(FileRec, sizeof(FileRec), #0); {Start with null record.}

if ListSize > 200 then ListSize := 200;

for count := 1 to ListSize do
with List[count]^ do
begin
FileRec[count].Name := Name;
FileRec[count].Phone := copy(Phone, 1, 14);
FileRec[count].Speed := Speed;
FileRec[count].Parity := EON(Parity);
case FileRec[count].Parity of
even,
odd: FileRec[count].DBits := 7;
none: FileRec[count].DBits := ord(DBits) - ord('0');
end;
FileRec[count].SBits := ord(SBits) - ord('0');

FileRec[count].Script := Script;
end;
if ListSize < 200 then
for count := succ(ListSize) to 200 do
begin
FileRec[count].Speed := DefSpeed;
FileRec[count].Parity := EON(DefParity);
case FileRec[count].Parity of
even,
odd: FileRec[count].DBits := 7;
none: FileRec[count].DBits := ord(DefDBits) - ord('0');
end;
FileRec[count].SBits := ord(DefSBits) - ord('0');
end;

assign(FonDir, OutFonFile);
rewrite(FonDir, sizeof(Qmodem20FileRec));
BlockWrite(FonDir, FileRec, 1);
close(FonDir);
end; {WriteQmodem20}


procedure WriteQmodem105;
var FileRec: Qmodem105FileRec;
count: word;
begin
FillChar(FileRec, sizeof(FileRec), #0); {Start with null record.}

if ListSize > 200 then ListSize := 200;

for count := 1 to ListSize do
with List[count]^ do
begin
FileRec[count].Name := copy(Name, 1, 25);
FileRec[count].Phone := copy(Phone, 1, 14);
FileRec[count].Speed := Speed;
FileRec[count].Parity := EON(Parity);
case FileRec[count].Parity of
even,
odd: FileRec[count].DBits := 7;
none: FileRec[count].DBits := ord(DBits) - ord('0');
end;
FileRec[count].SBits := ord(SBits) - ord('0');
end;
if ListSize < 200 then
for count := succ(ListSize) to 200 do
begin
FileRec[count].Name := '';
FileRec[count].Phone := '- --- --- ----';
FileRec[count].Phone := '';
FileRec[count].Speed := DefSpeed;
FileRec[count].Parity := EON(DefParity);
case FileRec[count].Parity of
even,
odd: FileRec[count].DBits := 7;
none: FileRec[count].DBits := ord(DefDBits) - ord('0');
end;
FileRec[count].SBits := ord(DefSBits) - ord('0');
end;

assign(FonDir, OutFonFile);
rewrite(FonDir, sizeof(Qmodem105FileRec));
BlockWrite(FonDir, FileRec, 1);
close(FonDir);
end; {WriteQmodem105}


procedure WriteTelix30;
var Hdr: Telix30Hdr;
Rec: Telix30Rec;
count: word;
c: byte;
HoldDate: string[8];
begin
FillChar(Hdr, sizeof(Hdr), #0); {Start with null header.}
Hdr.ID := $2E2B291A;
Hdr.DirVer := 1;

if ListSize > 1000 then ListSize := 1000;

Hdr.N_Entries := ListSize;

assign(FonDir, OutFonFile);
rewrite(FonDir, 1);
BlockWrite(FonDir, Hdr, sizeof(Hdr));

for count := 1 to ListSize do
with List[count]^ do
begin
FillChar(Rec, sizeof(Rec), #0); {Start with null record.}

for c := 1 to 25 do Rec.Name[c] := Name[c];
for c := 1 to 17 do Rec.Phone[c] := Phone[c];

Rec.Speed := To_tSpeed(Speed);
Rec.Parity := EON(Parity);
Rec.DBits := ord(DBits) - ord('0');
Rec.SBits := ord(SBits) - ord('0');
for c := 1 to 12 do Rec.Script[c] := Script[c];

if Date <> '' then { Remove /'s }
begin
HoldDate := concat(copy(Date, 1, 2),
copy(Date, 4, 2),
copy(Date, 7, 2));
for c := 1 to 8 do Rec.Date[c] := HoldDate[c];
end;

Rec.Calls := trunc(Calls);
Rec.Term := TelixTerm(Term);
Rec.Proto := TelixProto(Protocol);

for c := 1 to 14 do Rec.Password[c] := Password[c];

if Echo = 'Y' then Rec.Flags := 1;

{ Now a nice kludge to use a different dialing prefix
for numbers with area codes, to ease the transition. }
if length(RawPhone(Phone)) > 7
then Rec.DPrefix := 2
else Rec.DPrefix := 1;

case OrigFon of
Telix30:
begin
Rec.DPrefix := DPrefix;
Rec.Flags := TelixFlags;
Rec.Filler := TelixSpare;
end;
PibTerm4:
begin
if LineFeeds = 'Y' then Rec.Flags := Rec.Flags and 2;
if BackSpace = 'D' then Rec.Flags := Rec.Flags and 8;
end;
end;

BlockWrite(FonDir, Rec, sizeof(Rec));
end; {with List[count]^ do}
close(FonDir);
end; {WriteTelix30}

procedure WriteTelix21;
var count: word;
begin
assign(TextFileDir, OutFonFile);
SetTextBuf(TextFileDir, buf);
rewrite(TextFileDir);
for count := 1 to ListSize do { Min(ListSize, 150) }
with List[count]^ do
begin
case Parity of
'M': Parity := 'E';
'S': Parity := 'O';
end;
writeln(TextFileDir,
copy(Name + StringOf(30, ' '), 1, 30),
copy(Phone + StringOf(15, ' '), 1, 15),
Speed:5, NoMS(Parity), DBits, SBits, ' ',
copy(Script + StringOf(12, ' '), 1, 12));
end;
if ListSize < 150 then
for count := succ(ListSize) to 150 do
begin
case DefParity of
'M': DefParity := 'E';
'S': DefParity := 'O';
end;
writeln(TextFileDir,
StringOf(45, ' '), DefSpeed:5, NoMS(DefParity),
DefDBits, DefSBits, StringOf(13, ' '));
end;

flush(TextFileDir);
close(TextFileDir);
end; {WriteTelix21}


procedure WriteProCommPlus;
var FileRec: ProCommPlusFileRec;
HoldSpeed: string[5];
count: word;
c: byte;
ch: 'A'..'J';
begin
FillChar(FileRec, sizeof(FileRec), #0); {Start with null record.}

for ch := 'A' to 'J' do
for c := 1 to 25 do
begin
FileRec.LDCodes[ch][c] := LDCodes[ord(ch) - ord('@')][c];
end;

if ListSize > 200 then ListSize := 200;

for count := 1 to ListSize do
with FileRec.Directory[count] do
begin
for c := 1 to 24 do Name[c] := List[count]^.Name[c];
for c := 1 to 20 do Phone[c] := List[count]^.Phone[c];

if List[count]^.Speed >= 19200
then Speed := 19200
else Speed := List[count]^.Speed;

case List[count]^.Parity of
'E': Parity := peven;
'O': Parity := podd;
else Parity := pnone;
end;

DBits := ord(List[count]^.DBits) - ord('0');
SBits := ord(List[count]^.SBits) - ord('0');

if pos('.', List[count]^.Script) > 0
then for c := 1 to pos('.', List[count]^.Script) - 1
do Script[c] := List[count]^.Script[c]
else for c := 1 to 8
do Script[c] := List[count]^.Script[c];

for c := 1 to 8 do Date[c] := List[count]^.Date[c];

Total := trunc(List[count]^.Calls);

Protocol := ProPlusProto(List[count]^.Protocol);
Term := ProPlusTerm(List[count]^.Term);

if List[count]^.Echo = 'Y' then Duplex := dHalf
else Duplex := dFull;
end;
if ListSize < 200 then
for count := succ(ListSize) to 200 do
with FileRec.Directory[count] do
begin
if DefSpeed >= 19200
then Speed := 19200
else Speed := DefSpeed;

case DefParity of
'E': Parity := peven;
'O': Parity := podd;
else Parity := pnone;
end;

DBits := ord(DefDBits) - ord('0');
SBits := ord(DefSBits) - ord('0');

if DefEcho = 'Y' then Duplex := dHalf
else Duplex := dFull;

Protocol := ProPlusProto(DefProto);
Term := ProPlusTerm(DefTerm);
end;
assign(FonDir, OutFonFile);
rewrite(FonDir, sizeof(ProCommPlusFileRec));
BlockWrite(FonDir, FileRec, 1);
close(FonDir);
end; {WriteProCommPlus}

procedure WriteProComm;
var FileRec: ProCommFileRec;
HoldSpeed: string[5];
count: word;
c: byte;
code: Minus..Bang;
begin

FillChar(FileRec, sizeof(FileRec), #0); {Start with null record.}

for c := 1 to 25 do
begin
FileRec.ModemDial[c] := ModemDial[c];
for code := Minus to Bang do
FileRec.LDCodes[code][c] := LDCodes[code][c];
end;

if ListSize > 100 then ListSize := 100;

for count := 1 to 100 do
with FileRec.Directory[count] do
begin
for c := 1 to 24 do Name[c] := List[count]^.Name[c];
for c := 1 to 14 do Phone[c] := List[count]^.Phone[c];
str(List[count]^.Speed:3, HoldSpeed);
for c := 1 to length(HoldSpeed) do Speed[c] := HoldSpeed[c];
Parity := List[count]^.Parity;
DBits := List[count]^.DBits;
SBits := List[count]^.SBits;
Echo := List[count]^.Echo;
Script := ' '#0;
if pos('.', List[count]^.Script) > 0
then for c := 1 to pos('.', List[count]^.Script) - 1
do Script[c] := List[count]^.Script[c]
else for c := 1 to 8
do Script[c] := List[count]^.Script[c];
if List[count]^.OrigFon = ProComm then
begin
Spare := List[count]^.ProSpare;
Spare2 := List[count]^.ProSpare2;
end;
end;
if ListSize < 100 then
for count := succ(ListSize) to 100 do
with FileRec.Directory[count] do
begin
Name := '........................'#0; {24 dots + NUL}
Phone := '. ... ...-....'#0;
str(DefSpeed:3, HoldSpeed);
for c := 1 to length(HoldSpeed) do
Speed[c] := HoldSpeed[c];
Parity := DefParity;
DBits := DefDBits;
SBits := DefSBits;
Echo := DefEcho;
Script := ' '#0;
end;
assign(FonDir, OutFonFile);
rewrite(FonDir, sizeof(ProCommFileRec));
BlockWrite(FonDir, FileRec, 1);
close(FonDir);
end; {WriteProComm}

procedure WritePibTerm4;
var count: word;
begin
assign(TextFileDir, OutFonFile);
SetTextBuf(TextFileDir, buf);
rewrite(TextFileDir);
for count := 1 to ListSize do
with List[count]^ do
begin
if Speed = 450 then Speed := 300
else if Speed > 19200 then Speed := 19200;

write(TextFileDir,
copy(Name + StringOf(25, ' '), 1, 25),
copy(Phone, 1, 15):15, Speed:5, NoMS(Parity),
DBits, SBits, Echo);

case OrigFon of
PibTerm4:
write(TextFileDir, Backspace, LineFeeds);
Telix30:
begin
if ((TelixFlags and 8) > 0)
then write(TextFileDir, 'D')
else write(TextFileDir, 'B');
if ((TelixFlags and 2) > 0)
then write(TextFileDir, 'Y')
else write(TextFileDir, 'N');
end;
else
write(TextFileDir, ' ');
end;

write(TextFileDir, Pib4Term(Term), Protocol);
delete(Script, pos('.', Script), 12);
write(TextFileDir,
copy(Script + StringOf(9, ' '), 1, 9));

if (Date = '')
then write(TextFileDir, ' ':8)
else
begin
{ Convert to yy/mm/dd }
write(TextFileDir,
concat(copy(copy(Date,7,2) + ' ', 1, 2),
Date[3], copy(Date,1,5)):8)
end;

writeln(TextFileDir,
copy(Time + StringOf(8, ' '), 1, 8));
end;

if ListSize < 200 then
for count := succ(ListSize) to 200 do
begin
if DefSpeed = 450 then DefSpeed := 300
else if DefSpeed > 19200 then DefSpeed := 19200;

writeln(TextFileDir,
StringOf(25, '-'), ' # ### ###-####',
DefSpeed:5, NoMS(DefParity),
DefDBits, DefSBits, DefEcho, ' ',
Pib4Term(DefTerm), DefProto, StringOf(25, ' '));
end;

flush(TextFileDir);
close(TextFileDir);
end; {WritePibTerm4}


procedure WritePibTerm3;
var count: word;
begin
assign(TextFileDir, OutFonFile);
SetTextBuf(TextFileDir, buf);
rewrite(TextFileDir);
for count := 1 to ListSize do
with List[count]^ do
begin
if Speed = 450 then Speed := 300;
writeln(TextFileDir,
copy(Name + StringOf(25, ' '), 1, 25),
copy(Phone, 1, 15):15, Speed:5, NoMS(Parity),
DBits, SBits);
end;
if ListSize < 200 then
for count := succ(ListSize) to 200 do
begin
if DefSpeed = 450 then DefSpeed := 300;
writeln(TextFileDir,
StringOf(25, '-'), ' # ### ###-####',
DefSpeed:5, NoMS(DefParity),
DefDBits, DefSBits);
end;

flush(TextFileDir);
close(TextFileDir);
end; {WritePibTerm3}


procedure WriteK9X61;
var HoldStr: string[20];
count: word;
begin
assign(TextFileDir, OutFonFile);
SetTextBuf(TextFileDir, buf);
rewrite(TextFileDir);
for count := 1 to ListSize do
with List[count]^ do
begin
if Speed = 450 then Speed := 300;

write(TextFileDir,
copy(Name + StringOf(25, ' '), 1, 25),
copy(Phone, 1, 15):15, Speed:5, NoMS(Parity),
DBits, SBits);

if ffTime in ReadFields then
write(TextFileDir, Time, ' ':(10-length(Time)))
else
write(TextFileDir, ' ':10);

if (length(Date) > 5) and (length(Date) < 9) then
if Date[7] >= '8'
then insert('19', Date, 7)
else insert('20', Date, 7);
write(TextFileDir, Date, ' ':(10-length(Date)));

delete(Script, pos('.', Script), 12);
if Script = ''
then write(TextFileDir, '\', ' ':7)
else write(TextFileDir, Script, ' ':(8-length(Script)));

writeln(TextFileDir, K9Proto(Protocol));
end;
if ListSize < 200 then
for count := succ(ListSize) to 200 do
begin
if DefSpeed = 450 then DefSpeed := 300;
writeln(TextFileDir,
StringOf(25, '-'), ' - --- --- ----',
DefSpeed:5, NoMS(DefParity),
DefDBits, DefSBits, ' ':20, '\', ' ':7,
K9Proto(DefProto));
end;
flush(TextFileDir);
close(TextFileDir);
end; {WriteK9X61}


procedure WriteCommaSep;
var count: word;

procedure WriteStrData ( StrData : FieldStr );
begin
if StrData <> ''
then write(TextFileDir, '"', StrData, '"');
end; {WriteStrData}

begin
assign(TextFileDir, OutFonFile);
SetTextBuf(TextFileDir, buf);
rewrite(TextFileDir);
for count := 1 to ListSize do
with List[count]^ do
begin
WriteStrData(Name);
write(TextFileDir, ',');
WriteStrData(Phone);
write(TextFileDir,
',' , Speed:0,
',"' , Parity, '"',
',' , DBits,
',' , SBits,
',"' , Echo, '"');
if ReadFields * [ffScript, ffProtocol, ffTerm, ffCalls,
ffDate, ffTime, ffPassword, ffHours]
<> [] then
begin
write(TextFileDir, ',');
WriteStrData(Script);
end;
if ReadFields * [ffProtocol, ffTerm, ffCalls,
ffDate, ffTime, ffPassword, ffHours]
<> [] then
begin
write(TextFileDir, ',');
WriteStrData(Protocol);
end;
if ReadFields * [ffTerm, ffCalls,
ffDate, ffTime, ffPassword, ffHours]
<> [] then
begin
write(TextFileDir, ',');
WriteStrData(Term);
end;
if ReadFields * [ffCalls, ffDate, ffTime, ffPassword, ffHours]
<> [] then
begin
write(TextFileDir, ',', trunc(Calls));
end;
if ReadFields * [ffDate, ffTime, ffPassword, ffHours]
<> [] then
begin
write(TextFileDir, ',');
WriteStrData(Date);
end;
if ReadFields * [ffTime, ffPassword, ffHours]
<> [] then
begin
write(TextFileDir, ',');
WriteStrData(Time);
end;
if ReadFields * [ffPassword, ffHours]
<> [] then
begin
write(TextFileDir, ',');
WriteStrData(Password);
end;
if ffHours in ReadFields then
begin
write(TextFileDir, ',');
WriteStrData(Hours);
end;
writeln(TextFileDir);
end;

flush(TextFileDir);
close(TextFileDir);
end; {WriteCommaSep}


procedure WriteDIF;
type HeaderStr = string[7];
var count: word;
const
Fields = 15;

procedure WriteHeader ( Header : HeaderStr; Number : word );
begin
writeln(TextFileDir, Header);
writeln(TextFileDir, '0,', Number);
writeln(TextFileDir, '""');
end; {WriteHeader}

procedure WriteLabels;
const LabelArray : array [1..Fields] of string[12] =
('NAME', 'PHONE NUMBER', 'SPEED', 'PARITY', 'DATA BITS',
'STOP BITS', 'ECHO', 'SCRIPT', 'PROTOCOL', 'TERMINAL',
'CALLS', 'DATE', 'TIME', 'PASSWORD', 'HOURS');
var LabelCount : byte;
begin
for LabelCount := 1 to Fields do
begin
writeln(TextFileDir, 'LABEL');
writeln(TextFileDir, LabelCount, ',0');
writeln(TextFileDir, '"', LabelArray[LabelCount], '"');
end;
end; {WriteLabels}


procedure WriteStrData ( StrData : FieldStr );
begin
writeln(TextFileDir, '1,0');
writeln(TextFileDir, '"', StrData, '"');
end; {WriteStrData}

procedure WriteNumData ( NumData : longint );
begin
writeln(TextFileDir, '0,', NumData);
writeln(TextFileDir, 'V');
end; {WriteNumData}

begin
assign(TextFileDir, OutFonFile);
SetTextBuf(TextFileDir, buf);
rewrite(TextFileDir);

WriteHeader('TABLE', 1);
WriteHeader('VECTORS', Fields); {columns}
WriteHeader('TUPLES', ListSize); {rows}
WriteLabels;
WriteHeader('DATA', 0);

for count := 1 to ListSize do
with List[count]^ do
begin
writeln(TextFileDir, '-1,0');
writeln(TextFileDir, 'BOT'); {Beginning of Tuple}

WriteStrData(Name);
WriteStrData(Phone);
WriteNumData(Speed);
WriteStrData(Parity);
WriteNumData(ord(DBits)-ord('0'));
WriteNumData(ord(SBits)-ord('0'));

if ReadFields * [ffEcho, ffScript, ffProtocol, ffTerm,
ffCalls, ffDate, ffTime, ffPassword,
ffHours]
<> [] then
begin
write(TextFileDir, '0,');
case Echo of
'Y': begin
writeln(TextFileDir, '1');
writeln(TextFileDir, 'TRUE');
end;
else begin
writeln(TextFileDir, '0');
writeln(TextFileDir, 'FALSE');
end;
end;
end;

if ReadFields * [ffScript, ffProtocol, ffTerm, ffCalls,
ffDate, ffTime, ffPassword, ffHours]
<> [] then
WriteStrData(Script);
if ReadFields * [ffProtocol, ffTerm, ffCalls,
ffDate, ffTime, ffPassword, ffHours]
<> [] then
WriteStrData(Protocol);
if ReadFields * [ffTerm, ffCalls, ffDate, ffTime,
ffPassword, ffHours]
<> [] then
WriteStrData(Term);
if ReadFields * [ffCalls, ffDate, ffTime,
ffPassword, ffHours]
<> [] then
WriteNumData(trunc(Calls));
if ReadFields * [ffDate, ffTime, ffPassword, ffHours]
<> [] then
WriteStrData(Date);
if ReadFields * [ffTime, ffPassword, ffHours]
<> [] then
WriteStrData(Time);
if ReadFields * [ffPassword, ffHours]
<> [] then
WriteStrData(Password);
if ffHours in ReadFields then
WriteStrData(Hours);
end;
writeln(TextFileDir, '-1,0');
writeln(TextFileDir, 'EOD'); {End of Data}

flush(TextFileDir);
close(TextFileDir);
end; {WriteDIF}


procedure WritePCTalk3;
var Rec: PCTalk3Rec;
HoldStr: string;
count: word;
c: byte;

procedure MakeBlankRec;
var c: byte;
begin
FillChar(Rec, sizeof(Rec), #0); {Start with null record.}

for c := 1 to 24 do Rec.Name[c] := '-';
HoldStr := StringOf(22, ' ') + '- --- --- ----';
for c := 1 to 36 do Rec.Phone[c] := HoldStr[c];
str(DefSpeed:4, HoldStr);
for c := 1 to 4 do Rec.Speed[c] := HoldStr[c];
Rec.Parity := DefParity;
Rec.DBits := DefDBits;
Rec.SBits := DefSBits;
Rec.Echo := DefEcho;
Rec.Msgs := 'N';
for c := 1 to 26 do Rec.StripCvt[c] := '/';
Rec.Pacing := ' ';
for c := 1 to 24 do Rec.Spare[c] := ' ';
end; {MakeBlankRec}

begin
assign(FonDir, OutFonFile);
rewrite(FonDir, sizeof(PCTalk3Rec));
MakeBlankRec;

HoldStr := 'INITIALIII' + StringOf(14, ' ');
for c := 1 to 24 do Rec.Name[c] := HoldStr[c];
BlockWrite(FonDir, Rec, 1);

HoldStr := StringOf(36 - length(ModemDial), ' ') + ModemDial;
for c := 1 to 36 do Rec.Phone[c] := HoldStr[c];
Rec.PhoneLen := length(ModemDial);
BlockWrite(FonDir, Rec, 1);

HoldStr := StringOf(36 - length(LDCodes[Plus]), ' ') + LDCodes[Plus];
for c := 1 to 36 do Rec.Phone[c] := HoldStr[c];
Rec.PhoneLen := length(LDCodes[Plus]);
BlockWrite(FonDir, Rec, 1);

HoldStr := StringOf(36 - length(LDCodes[Minus]), ' ') + LDCodes[Minus];
for c := 1 to 36 do Rec.Phone[c] := HoldStr[c];
Rec.PhoneLen := length(LDCodes[Minus]);
BlockWrite(FonDir, Rec, 1);

if ListSize > 60 then ListSize := 60;

for count := 1 to ListSize do
with List[count]^ do
begin
FillChar(Rec, sizeof(Rec), #0); {Start with null record.}

HoldStr := Name + StringOf(24 - length(Name), ' ');
for c := 1 to 24 do Rec.Name[c] := HoldStr[c];
HoldStr := StringOf(36 - length(Phone), ' ') + Phone;
for c := 1 to 36 do Rec.Phone[c] := HoldStr[c];
Rec.PhoneLen := length(Phone);
str(Speed:4, HoldStr);
for c := 1 to 4 do Rec.Speed[c] := HoldStr[c];
Rec.Parity := Parity;
Rec.DBits := DBits;
Rec.SBits := SBits;
Rec.Echo := Echo;
for c := 1 to 24 do Rec.Spare[c] := ' ';

case OrigFon of
PCTalk3: begin
Rec.Msgs := Messages;
for c := 1 to 26 do
Rec.StripCvt[c] := StripCvt[c];
Rec.StripCvtLen := ord(StripCvt[0]);
for c := 1 to 3 do
Rec.Pacing[c] := Pacing[c];
Rec.PacingLen := ord(Pacing[0]);
for c := 1 to 24 do Rec.Spare[c] := PCTSpare[c];
end;
else begin
Rec.Msgs := 'N';
for c := 1 to 26 do Rec.StripCvt[c] := '/';
Rec.Pacing := ' ';
end;
end;
BlockWrite(FonDir, Rec, 1);
end;
if ListSize < 60 then
for count := succ(ListSize) to 60 do
begin
MakeBlankRec;
BlockWrite(FonDir, Rec, 1);
end;

close(FonDir);
end; {WritePCTalk3}


procedure WriteGT1400;
var
Rec: GT1400Rec;
count: word;
c: byte;
begin
assign(FonDir, OutFonFile);
rewrite(FonDir, sizeof(GT1400Rec));

FillChar(Rec, sizeof(Rec), #0); {Start with null record.}

if ListSize > 999 then ListSize := 999;

for count := 1 to ListSize do
begin
inc(Rec.Entries);
if Rec.Entries > 16 then
begin
Rec.Entries := 16;
BlockWrite(FonDir, Rec, 1);
FillChar(Rec, sizeof(Rec), #0); {Start w/null record.}
Rec.Entries := 1;
end;

with Rec.Entry[Rec.Entries] do
begin
for c := 1 to 30 do Name[c] := List[count]^.Name[c];
for c := 1 to 14 do Phone[c] := List[count]^.Phone[c];

if List[count]^.Speed >= 19200
then Speed := 19200
else Speed := List[count]^.Speed;

if List[count]^.Parity = 'M'
then Parity := mark
else Parity := EON(List[count]^.Parity);

DBits := ord(List[count]^.DBits) - ord('0');
SBits := ord(List[count]^.SBits) - ord('0');
for c := 1 to 12 do Script[c] := List[count]^.Script[c];
Protocol := GTProto(List[count]^.Protocol);
Calls := trunc(List[count]^.Calls);

for c := 1 to 8 do Date[c] := List[count]^.Date[c];

for c := 1 to 5 do Time[c] := List[count]^.Time[c];
for c := 1 to 30 do Password[c] := List[count]^.Password[c];
for c := 1 to 9 do Hours[c] := List[count]^.Hours[c];

case List[count]^.Echo of
'Y': HalfDplx := 'T';
'N': HalfDplx := 'F';
else HalfDplx := ' ';
end;

if List[count]^.Term = 'TTY' then VT100 := 'F'
else if (List[count]^.Term[1] = 'V') or
(List[count]^.Term = 'ANS') or
(List[count]^.Term = 'AVT') then VT100 := 'T'
else VT100 := ' ';

case List[count]^.OrigFon of GT1400..GT42:
begin
Redial := List[count]^.Redial;
Duration := trunc(List[count]^.Duration);
Upload := trunc(List[count]^.Upload);
Download := trunc(List[count]^.Download);
Strip8 := List[count]^.Strip8;
GTFuture := List[count]^.GTSpare;
end;
else
Redial := ' ';
Strip8 := ' ';
end; {case}
end; {with Rec...}
end; {for count...}
BlockWrite(FonDir, Rec, 1);

close(FonDir);
end; {WriteGT1400}

procedure WriteGT1300;
var
Rec: GT1300Rec;
count: word;
begin
assign(FonDir, OutFonFile);
rewrite(FonDir, sizeof(GT1300Rec));

FillChar(Rec, sizeof(Rec), #0); {Start with null record.}

if ListSize > 999 then ListSize := 999;

for count := 1 to ListSize do
begin
inc(Rec.Entries);
if Rec.Entries > 16 then
begin
Rec.Entries := 16;
Rec.Age1 := $93;
BlockWrite(FonDir, Rec, 1);
FillChar(Rec, sizeof(Rec), #0); {Start w/null record.}
Rec.Entries := 1;
end;

with Rec.Entry[Rec.Entries] do
begin
Name := copy(List[count]^.Name, 1, 30);
Phone := copy(List[count]^.Phone, 1, 14);

if List[count]^.Speed >= 19200
then Speed := 19200
else Speed := List[count]^.Speed;

case List[count]^.Parity of
'E', 'M': Parity := 1;
'O', 'S': Parity := 2;
end;

DBits := ord(List[count]^.DBits) - ord('0');
SBits := ord(List[count]^.SBits) - ord('0');
Script := List[count]^.Script;
Protocol := GTProto(List[count]^.Protocol);
Calls := trunc(List[count]^.Calls);
Date := List[count]^.Date;
Time := copy(List[count]^.Time,1,5);
Password := List[count]^.Password;
Hours := List[count]^.Hours;

case List[count]^.OrigFon of GT1400..GT42:
begin
Redial := List[count]^.Redial;
Duration := List[count]^.Duration;
Upload := List[count]^.Upload;
Download := List[count]^.Download;

Age2 := $63;
Age3 := $6C;
end;
else
Redial := ' ';
end; {case}
end; {with Rec...}
end; {for count...}
BlockWrite(FonDir, Rec, 1);

close(FonDir);
end; {WriteGT1300}


procedure WriteGT1100;
var
Rec: GT1100Rec;
count: word;
begin
assign(FonDir, OutFonFile);
rewrite(FonDir, sizeof(GT1100Rec));

FillChar(Rec, sizeof(Rec), #0); {Start with null record.}

if ListSize > 999 then ListSize := 999;

for count := 1 to ListSize do
begin
inc(Rec.Entries);
if Rec.Entries > 16 then
begin
Rec.Entries := 16;
BlockWrite(FonDir, Rec, 1);
FillChar(Rec, sizeof(Rec), #0); {Start w/null record.}
Rec.Entries := 1;

end;

with Rec.Entry[Rec.Entries] do
begin
Name := copy(List[count]^.Name, 1, 30);
Phone := copy(List[count]^.Phone, 1, 14);

if List[count]^.Speed >= 19200 { 19200 only 12.20+ }
then Speed := 19200
else Speed := List[count]^.Speed;

case List[count]^.Parity of
'E', 'M': Parity := 1;
'O', 'S': Parity := 2;
end;

DBits := ord(List[count]^.DBits) - ord('0');
SBits := ord(List[count]^.SBits) - ord('0');
Script := List[count]^.Script;
Protocol := GTProto(List[count]^.Protocol);
Calls := trunc(List[count]^.Calls);
Date := List[count]^.Date;
Time := copy(List[count]^.Time,1,5);
Password := List[count]^.Password;
Hours := List[count]^.Hours;

case List[count]^.OrigFon of GT1400..GT42:
begin
Redial := List[count]^.Redial;
Duration := List[count]^.Duration;
Upload := List[count]^.Upload;
Download := List[count]^.Download;
end;
else
Redial := ' ';
end; {case}
end; {with Rec...}
end; {for count...}
BlockWrite(FonDir, Rec, 1);

close(FonDir);
end; {WriteGT1100}


{$IFNDEF ONLYRECENTGT}
procedure WriteGT92;
var
Rec: GT92Rec;
count: word;
begin
assign(FonDir, OutFonFile);
rewrite(FonDir, sizeof(GT92Rec));

FillChar(Rec, sizeof(Rec), #0); {Start with null record.}

if ListSize > 999 then ListSize := 999;

for count := 1 to ListSize do
begin
inc(Rec.Entries);
if Rec.Entries > 16 then
begin
Rec.Entries := 16;
BlockWrite(FonDir, Rec, 1);
FillChar(Rec, sizeof(Rec), #0); {Start w/null record.}
Rec.Entries := 1;
end;
with Rec.Entry[Rec.Entries] do
begin
Name := copy(List[count]^.Name, 1, 30);
Phone := copy(List[count]^.Phone, 1, 14);

Speed := List[count]^.Speed;

case List[count]^.Parity of
'E', 'M': Parity := 1;
'O', 'S': Parity := 2;
else Parity := 0;
end;

DBits := ord(List[count]^.DBits) - ord('0');
SBits := ord(List[count]^.SBits) - ord('0');
Calls := trunc(List[count]^.Calls);
Date := List[count]^.Date;
Time := copy(List[count]^.Time,1,5);
Password := List[count]^.Password;
Hours := List[count]^.Hours;

case List[count]^.OrigFon of GT1400..GT42:
begin
Redial := List[count]^.Redial;
Duration := List[count]^.Duration;
Upload := List[count]^.Upload;
Download := List[count]^.Download
end;
else
Redial := ' ';
end; {case}
end; {with Rec...}
end; {for count...}
BlockWrite(FonDir, Rec, 1);

close(FonDir);
end; {WriteGT92}


procedure WriteGT91;
var
Rec: GT91Rec;
count: word;
begin
assign(FonDir, OutFonFile);
rewrite(FonDir, sizeof(GT91Rec));

FillChar(Rec, sizeof(Rec), #0); {Start with null record.}

if ListSize > 999 then ListSize := 999;

for count := 1 to ListSize do
begin
inc(Rec.Entries);
if Rec.Entries > 16 then
begin
Rec.Entries := 16;
BlockWrite(FonDir, Rec, 1);
FillChar(Rec, sizeof(Rec), #0); {Start w/null record.}
Rec.Entries := 1;
end;
with Rec.Entry[Rec.Entries] do
begin
Name := copy(List[count]^.Name, 1, 30);
Phone := copy(List[count]^.Phone, 1, 14);

Speed := List[count]^.Speed;

case List[count]^.Parity of
'E', 'M': Parity := 1;
'O', 'S': Parity := 2;
end;

DBits := ord(List[count]^.DBits) - ord('0');
SBits := ord(List[count]^.SBits) - ord('0');
Calls := trunc(List[count]^.Calls);
Date := List[count]^.Date;
Time := copy(List[count]^.Time,1,5);
Password := List[count]^.Password;
Hours := copy(List[count]^.Hours, 1, 5);

case List[count]^.OrigFon of GT1400..GT42:
begin
Redial := List[count]^.Redial;
Duration := List[count]^.Duration;
Upload := List[count]^.Upload;
Download := List[count]^.Download
end;
else
Redial := ' ';
end; {case}
end; {with Rec...}
end; {for count...}
BlockWrite(FonDir, Rec, 1);

close(FonDir);
end; {WriteGT91}


procedure WriteGT90;
var
Rec: GT90Rec;
count: word;
begin
assign(FonDir, OutFonFile);
rewrite(FonDir, sizeof(GT90Rec));

FillChar(Rec, sizeof(Rec), #0); {Start with null record.}

if ListSize > 999 then ListSize := 999;

for count := 1 to ListSize do
begin
inc(Rec.Entries);
if Rec.Entries > 16 then
begin
Rec.Entries := 16;
BlockWrite(FonDir, Rec, 1);
FillChar(Rec, sizeof(Rec), #0); {Start w/null record.}
Rec.Entries := 1;
end;
with Rec.Entry[Rec.Entries] do
begin
Name := copy(List[count]^.Name, 1, 30);
Phone := copy(List[count]^.Phone, 1, 14);

Speed := List[count]^.Speed;

case List[count]^.Parity of
'E', 'M': Parity := 1;
'O', 'S': Parity := 2;
end;

DBits := ord(List[count]^.DBits) - ord('0');
SBits := ord(List[count]^.SBits) - ord('0');
Calls := trunc(List[count]^.Calls);
Date := List[count]^.Date;
Time := copy(List[count]^.Time,1,5);
Password := List[count]^.Password;

case List[count]^.OrigFon of GT1400..GT42:
begin
Redial := List[count]^.Redial;
Duration := List[count]^.Duration;
Upload := List[count]^.Upload;
Download := List[count]^.Download
end;
else
Redial := ' ';
end;
end; {with Rec...}
end; {for count...}
BlockWrite(FonDir, Rec, 1);

close(FonDir);
end; {WriteGT90}


procedure WriteGT80;
var
Rec: GT80Rec;
count: word;
begin
assign(FonDir, OutFonFile);
rewrite(FonDir, sizeof(GT80Rec));

FillChar(Rec, sizeof(Rec), #0); {Start with null record.}

if ListSize > 999 then ListSize := 999;

for count := 1 to ListSize do
begin
inc(Rec.Entries);
if Rec.Entries > 16 then
begin
Rec.Entries := 16;
BlockWrite(FonDir, Rec, 1);
FillChar(Rec, sizeof(Rec), #0); {Start w/null record.}
Rec.Entries := 1;
end;
with Rec.Entry[Rec.Entries] do
begin
Name := copy(List[count]^.Name, 1, 30);
Phone := copy(List[count]^.Phone, 1, 14);

Speed := List[count]^.Speed;

case List[count]^.Parity of
'E', 'M': Parity := 1;
'O', 'S': Parity := 2;
end;

DBits := ord(List[count]^.DBits) - ord('0');
SBits := ord(List[count]^.SBits) - ord('0');
Calls := trunc(List[count]^.Calls);
Date := List[count]^.Date;
Time := copy(List[count]^.Time,1,5);
Password := List[count]^.Password;

case List[count]^.OrigFon of GT1400..GT42:
begin
Redial := List[count]^.Redial;
Duration := List[count]^.Duration
end;
else
Redial := ' ';
end;
end; {with Rec...}
end; {for count...}
BlockWrite(FonDir, Rec, 1);

close(FonDir);
end; {WriteGT80}


procedure WriteGT42;
var
Rec: GT42Rec;
count: word;
begin
assign(FonDir, OutFonFile);
rewrite(FonDir, sizeof(GT42Rec));

FillChar(Rec, sizeof(Rec), #0); {Start with null record.}

if ListSize > 999 then ListSize := 999;

for count := 1 to ListSize do
begin
inc(Rec.Entries);
if Rec.Entries > 16 then
begin
Rec.Entries := 16;
BlockWrite(FonDir, Rec, 1);
FillChar(Rec, sizeof(Rec), #0); {Start w/null record.}
Rec.Entries := 1;
end;
with Rec.Entry[Rec.Entries] do
begin
Name := copy(List[count]^.Name, 1, 30);
Phone := copy(List[count]^.Phone, 1, 14);

Speed := List[count]^.Speed;

case List[count]^.Parity of
'E', 'M': Parity := 1;
'O', 'S': Parity := 2;
end;

DBits := ord(List[count]^.DBits) - ord('0');
SBits := ord(List[count]^.SBits) - ord('0');

Date := List[count]^.Date;
Time := copy(List[count]^.Time,1,5);

case List[count]^.OrigFon of GT1400..GT42:
Redial := List[count]^.Redial;
else
Redial := ' ';
end; {case}
end; {with Rec...}
end; {for count...}
BlockWrite(FonDir, Rec, 1);

close(FonDir);
end; {WriteGT42}


procedure WriteGTPre42;
var
Rec: GTPre42Rec;
count: word;
begin
assign(FonDir, OutFonFile);
rewrite(FonDir, sizeof(GTPre42Rec));

FillChar(Rec, sizeof(Rec), #0); {Start with null record.}

if ListSize > 999 then ListSize := 999;

for count := 1 to ListSize do
begin
inc(Rec.Entries);
if Rec.Entries > 16 then
begin
Rec.Entries := 16;
BlockWrite(FonDir, Rec, 1);
FillChar(Rec, sizeof(Rec), #0); {Start w/null record.}
Rec.Entries := 1;
end;
with Rec.Entry[Rec.Entries] do
begin
Name := copy(List[count]^.Name, 1, 30);
Phone := copy(List[count]^.Phone, 1, 30);

Speed := List[count]^.Speed;

case List[count]^.Parity of
'E', 'M': Parity := 1;
'O', 'S': Parity := 2;
end;

DBits := ord(List[count]^.DBits) - ord('0');
SBits := ord(List[count]^.SBits) - ord('0');
end; {with Rec...}
end; {for count...}
BlockWrite(FonDir, Rec, 1);

close(FonDir);
end; {WriteGTPre42}
{$ENDIF}


begin
case OutFon of
Qmodem40 : WriteQmodem40;
Qmodem21 : WriteQmodem21;
Boyan40 : WriteBoyan40;
Boyan : WriteBoyan;
ProCommPlus : WriteProCommPlus;
GT1400 : WriteGT1400;
Telix30 : WriteTelix30;
PibTerm4 : WritePibTerm4;
PibTerm3 : WritePibTerm3;
K9X61 : WriteK9X61;
Telix21 : WriteTelix21;
CommaSep : WriteCommaSep;
ProComm : WriteProComm;
PCTalk3 : WritePCTalk3;
Qmodem20 : WriteQmodem20;
Qmodem105 : WriteQmodem105;
DIF : WriteDIF;
GT1300 : WriteGT1300;
GT1100 : WriteGT1100;
{$IFNDEF ONLYRECENTGT}
GT92 : WriteGT92;
GT91 : WriteGT91;
GT90 : WriteGT90;
GT80 : WriteGT80;
GT42 : WriteGT42;
GTPre42 : WriteGTPre42;
{$ENDIF}
end;
end; {WriteFon}

End.