Запись. Помогите!

[Krugan]

Вот у меня есть программа, которая записывает даные у файл d.txt но почему то записать можно только один раз, а на второй ошибка. не пойму почему. Помогите плиз!

Program Spravo4nik; 
Uses CRT; 
Type user = record 
             num: String; 
             god: Word; 
             fam: String; 
             adr: String; 
             dlg: Word; 
             end; 
Const fl = 'd.txt';
Var f: File of user; 
     a: user; 
     c: Char; 

Procedure AddUser; 
Begin 
Repeat 
ClrScr; 
Writeln('dobavlenie novogo polzovatelia'); 
Write('vvedite familiy polzovatelz: '); Readln(a.fam); 
Write('vvedit nomer telefona: '); Readln(a.num); 
Write('Najmit ENTER'); 
c := Readkey; 
Until c = #13; 
Assign(f, fl); 
{$I-} 
ReSet(f); 
{$I+} 
IF IOResult <> 0 THEN ReWrite(f); 
Seek(f, FileSize(f)); 
Write(f, a); 
Close(f); 
End; 

Procedure PrintFile; 
Begin 
ClrScr; 
Assign(f, fl); 
{$I-} 
ReSet(f); 
{$I+} 
If IOResult <> 0 Then 
    Begin 
    Writeln('fail ne nayden'); 
    Exit; 
    End; 
While Not EoF(f) do 
       Begin 
       Read(f,a); 
       Write('Familiya: ',a.fam,' (',a.num,')',#13#10); 
       End; 
ReadKey; 
End; 

Procedure ClearFile; 
Begin 
ClrScr; 
Write('najmi ENTER dlia otchistki ili drygyy kl dliya otmeni'); 
c := ReadKey; 
If (c = #13) then 
    Begin 
    Assign(f, fl); 
    ReWrite(f); 
    Close(f); 
    Writeln('fail otchischen'); 
    End 
Else Writeln('otmeneno'); 
ReadKey; 
End; 

Procedure SearchNumber; 
Var s: String; 
     flag: Boolean; 
Begin 
ClrScr; 
flag := False; 
Write('Vvedit fragment familii: '); Readln(s); 
Assign(f, fl); 
{$I-} 
ReSet(f); 
{$I+} 
If IOResult <> 0 Then 
    Begin 
    Writeln('fayl ne naiden'); 
    Exit; 
    End; 
While Not EoF(f) do 
       Begin 
       Read(f,a); 
       If (Pos(s,a.fam)<>0) then 
          Begin 
          flag := True; 
          Write(a.fam,' -- ',a.num,#13#10); 
          End; 
       End; 
If (flag = False) then Writeln('Nitchogo ne naideno'); 
Readkey; 
End; 

Procedure SearchAdress; 
Var s: String; 
     flag: Boolean; 
Begin 
ClrScr; 
flag := False; 
Write('vvedit nomer abonenta: '); Readln(s); 
Assign(f, fl); 
{$I-} 
ReSet(f); 
{$I+} 
If IOResult <> 0 Then 
    Begin 
    Writeln('fail ne naiden'); 
    Exit; 
    End; 
While Not EoF(f) do 
       Begin 
       Read(f,a); 
       If (a.num = s) then 
          Begin 
          flag := True; 
          Write(a.adr,#13#10); 
          End; 
       End; 
If (flag = False) then Writeln('nitchogo ne naideno'); 
Readkey; 
End; 

Procedure PrintUsers; 
Var flag: Boolean; 
Begin 
ClrScr; 
Assign(f, fl); 
{$I-} 
ReSet(f); 
{$I+} 
If IOResult <> 0 Then 
    Begin 
    Writeln('fail ne naiden'); 
    Exit; 
    End; 
While Not EoF(f) do 
       Begin 
       Read(f,a); 
       If (a.dlg > 0) then 
          Begin 
          flag := True; 
          Write(a.fam,' (Dolg ',a.dlg,')',#13#10); 
          End; 
       End; 
If (flag = False) then Writeln('Dоljnikov net'); 
Readkey; 
End; 

Procedure Menu; 
Begin 
Repeat 
ClrScr; 
Writeln('[0] Pokazat knigy'); 
Writeln('[1] dobavit polzovatelia'); 
Writeln('[2] ochistit fail'); 
Writeln('[3] naiti nomer po familii'); 
Writeln('[ESC] vihod'); 
c := ReadKey; 
Case c of 
'0': PrintFile; 
'1': AddUser; 
'2': Clearfile; 
'3': SearchNumber; 
End; 
Until c = #27; 
End; 

Begin 
ClrScr; 
Menu; 
End.

[Serge_Bliznykov]

Const fl = 'd.txt';
Var f: File of user;

Вы понимаете, что "File of user" - это БИНАРНЫЙ (двоичный) файл?
Он к текстовым файлам вообще никакого отношения не имеет..

[Krugan]

как оно относится к тому, что даные записываются у файл только один раз? а на остальные ошибка 101 в этой строке "Write(f, a); "?

[Krugan]

Вот наконец то сделал программу. Может кому то пригодится))

uses crt;
const nmax=20;

type telephone = record
tel: string[9];
nom: string[10];
fam: string;
end;
mas=array [1..nmax] of telephone;

var t: mas;
n,v:byte;

procedure Vvod (var r: byte; var z: mas);
var c: char;
begin
c:='n';
if r>=20 then writeln('limit') else
repeat
clrscr;
inc(r);
writeln('vnesit ',r,' zapis v telefonniy spravochnik:');
with z[r] do
begin
repeat
write('Telefon (000-00-00): '); readln(tel);
until (length(tel)=9) and ((tel[4]='-') and (tel[7]='-'));
write('Familia: '); readln(fam);
end;
write('Zapisat ischo? (y/n) '); readln(c);
until c<>'y';
end;



procedure Familie (r: byte; z: mas);
var i,k: byte;
s: string;
begin
clrscr;
k:=0;
write('vvedit fam dlia poiska: '); readln(s);
for i:=1 to r do
with z[i] do
if pos(s,fam)<>0 then
begin
inc(k);
writeln('familia: ',s);
writeln('telefon: ',tel);
end;
if k=0 then writeln('net danih');
writeln('Enter to continue..');
readln;
end;

begin
repeat
clrscr;
writeln('0-zakrit');
writeln('1-dob danih');
writeln('2-po fam');
readln(v);
case v of
1: Vvod (n,t);
2: Familie (n,t);
end;
until v=0;
end.