Помогите, пожалуйста, решить задачу по файлах

[Guest]

Сформировать файл "B", записями которого является: фамилии писателей, инициалы, названия книг, год издания. Используя эти данные, сформировать файл "E", где разместить фамилии писателей, которые выдают больше двух книг за год.

З. Ы. - просьба, как можна побыстрее, ПОЖАЛУЙСТА!



С файлом "B" я разобрался, вот исходники:

[codebox]PROGRAM ob4_8_8;
TYPE zap=record
fam:string[10];
ini:string[10];
naz:string[10];
god:integer;
end;
zapus=FILE OF zap;
VAR B,E:zapus;
bd:zap;
i:integer;
BEGIN assign(B,'B.PAS');
rewriterolleyes:;
FOR i:=1 TO 5 DO
begin
WRITE('Введите фамилию писателя - ');
READLN(bd.fam);
WRITE('Введите инициалы - ');
READLN(bd.ini);
WRITE('Введите название книги - ');
READLN(bd.naz);
WRITE('Введите год издания - ');
READLN(bd.god);
WRITE(B,bd);
end;
close(;
WRITELN;
WRITELN('B.PAS');
reset(;
FOR i:=1 TO 5 DO
begin
READ(B,bd);
WRITELN(bd.fam:10,bd.ini:10,bd.naz:10,bd.god:10);
end;
...
...
...[/codebox]

Пожалуйста, помогите с файлом "E"!

 

[Froex]

я пишу без учета годов, а просто тех писателей, которые больше одной книги сделалти. Времени маловато, чтоб все писать. Думаю, что сам добавишь, что надо.
[codebox]program ob4_8_8;
type
zap=
record
fam:string[20];
ini:string[5];
naz:string[30];
god:integer;
end;
zapus=file of zap;

var
B:zapus;
E:text;
bd:zap;
Abd:array[1..100]of zap;
Abd2:array[1..100]of integer;
i,j:integer;
check:string;

begin
assign(B,'B.PAS');
rewriterolleyes:;
for i:=1 to 100
writeln('Введите фамилию писателя - ');
read(bd.fam);
writeln('Введите инициалы - ');
read(bd.ini);
writeln('Введите название книги - ');
read(bd.naz);
writeln('Введите год издания - ');
read(bd.god);
writeln(B,bd);
for j:=1 to i do
begin
if Abd[j]=db.fam then begin Abd2[j]:=Abd2[j]+1; break end;
if j=i then begin Abd[j+1]:=bd; Abd2[j+1]:=Abd2[j+1]+1 end;
end;
write('enter one more data? (y/n)');
readln(check);
writeln;
if (check='n') or (check='N') then break;
end;
close(;
writeln;
writeln('B.PAS');
reset(;
assign(E,'E.TXT');
rewrite(E);
for i:=1 to 100 do
if Abd2>1 then writeln(E, Abd);[/codebox]