Здравствуйте, Невалёный Виталий Владимирович!

Итак. По результатам обсуждения мы решили ограничиться 3-м заданием (остальные вы сделали). Получилось два неплохих варианта:

а)
В структуру zap добавляется поле "neprosmotren:boolean;"
Теперь код:
[code h=200]
procedure zapros3(j,k:integer);
var i,n,m,s:integer;
z:zap;
begin
for i:=1 to j do
base2[i].kol:=0;
for n:=1 to k do
base3[n].neprosmotren:=true;

// Подсчёт
for n:=1 to k do
if base3[n].neprosmotren then
begin
base3[n].neprosmotren:=false;
s:=1;
for m:=n+1 to k do
if base3[m].neprosmotren and (base3[n].book_nomber=base3[m].book_nomber) then
begin
base3[m].neprosmotren:=false;
inc(s);
end;
i:=1;
while base3[n].book_nomber<>base2[i].book_nomber do
inc(i);
base2[i].kol:=s;
end;

//Сортировка прямым выбором
for i:=1 to j do
begin
m:=i;
//Поиск максимальной по kol записи начиная с i-й
for n:=i+1 to j do
if base2[n].kol>base2[m].kol then
m:=n;
//Обмен i-й и максимальной (m-ой) записи
if i<>m then
begin
z:=base2[i];
base2[i]:=base2[m];
base2[m]:=z;
end;
end;
//Вывод
for i:=1 to 3 do
writeln(base2[i].book_nomber, ' ',base2[i].avtor, ' ',base2[i].nazvanie,' ', base2[i].god,' ',base2[i].kol);
end;
[/code]

Вариант б)

[code h=200]
procedure zapros3(j,k:integer);
var i,n,m:integer;
z:zap;
begin
// Подсчёт
for i:=1 to j do
base2[i].kol:=0;


for n:=1 to k do
begin
i:=1;
while base3[n].book_nomber<>base2[i].book_nomber do
inc(i);
inc(base2[i].kol);
end;

//Сортировка прямым выбором
for i:=1 to j do
begin
m:=i;
//Поиск максимальной по kol записи начиная с i-й
for n:=i+1 to j do
if base2[n].kol>base2[m].kol then
m:=n;
//Обмен i-й и максимальной (m-ой) записи
if i<>m then
begin
z:=base2[i];
base2[i]:=base2[m];
base2[m]:=z;
end;
end;
//Вывод
for i:=1 to 3 do
writeln(base2[i].book_nomber, ' ',base2[i].avtor, ' ',base2[i].nazvanie,' ', base2[i].god,' ',base2[i].kol);
end;[/code]

Удачи!