Здравствуйте, Хощенко Артём Владимирович!
Решение первой и второй задач в приложении.

Приложение:
{ генерация перестановок }
uses crt;
const n = 5; { количество элементов в перестановке}
var a:array[1..n] of integer;{массив элементов перестановки}
j:integer;{счетчик}
kol : longint;{количество перестановок}
procedure generate (l,r:integer;var k:longint);
{рекурсивная процедура генерации перестановок, входные параметры-границы перестановок, выходной-количество их}
var i,v:integer; {счетчик цикла и буфер при обмене}
begin
if (l=r) then {если дошли до конца}
begin
for i:=1 to n do write(a[i],' '); {выводим на экран очередную перестановку}
writeln;
k:=k+1;{считаем}
if k mod 20 = 0 then readln;{для удобства просмотра делаем задержки после каждых 20 перестановок}
end
else {если еще не дошли}
begin
for i := l to r do {от данного положения начала (L) до конца}
begin
v:=a[l]; a[l]:=a[i]; a[i]:=v; {обмен a[i],a[l]} {обмениваем текущий первый элемент с очередным}
generate(l+1,r,k); {вызов новой генерации}{увеличиваем на 1 начало перестановки}
v:=a[l]; a[l]:=a[i]; a[i]:=v; {обмен a[i],a[l]} {снова меняем}
end;
end;
end;
begin
clrscr;
for j := 1 to n do {заполняем первоначальный массив}
a[j]:=j;{или порядковыми номерами(обычно) или как Вам нравится}
generate( 1,n,kol); {генерация}
writeln('kol=',kol);{вывод количества}
readln
end.
{нумерация страниц
Чтобы не заморачиваться с Вашим навороченным кодом, сделал по своему. Использовал девиз скульпторов, сначала создаю неправильную строку, потом от нее отсекаю все лишнее.}
uses crt;
const nmax=100;
var a:array[1..nmax] of word;
s,c:string;
n,i,j,k:word;
begin
clrscr;
repeat
write('Vvedite kolichestvo stranic n=');
readln(n);
until (n>1)and(n<=nmax);
repeat
writeln('Vvedite ',n,' nomerov stranic po vozrastaniyu:');
for i:=1 to n do
read(a[i]);
readln;
k:=0;
for i:=2 to n do {проверяем правильность ввода}
if a[i]<=a[i-1] then
begin
k:=1;
break;
end;
if k=1 then writeln('Dopushena oshibka! Povtorite vvod.');
until k=0;
str(a[1],c); {преобразуем в строку первое число}
s:=c;{начальная строка}
i:=2;{начинаем со второго}
while i<=n do
begin
str(a[i],c);{преобразуем}
if a[i]-a[i-1]<>1 then s:=s+', '+c;{если не по порядку, запятая +число}
if (a[i]-a[i-1]=1)and(a[i+1]-a[i]<>1) then s:=s+'-'+c;{если по порядку, а следующее не по порядку, то дефис+число}
if (a[i]-a[i-1]=1)and(a[i+1]-a[i]=1) then {если 3 по порядку, то}
begin
s:=s+'-';{пишем дефис}
inc(i);{переходим к следующему}
end
else inc(i);{если не 3 попорядку, к следующему}
end;
for i:=length(s)downto 1 do {удаляем сочетания (,-)}
if (s[i]='-')and(s[i+1]=',') then
delete(s,i+1,2);
while pos('--',s)>0 do {удаляем лишние дефисы}
delete(s,pos('--',s),1);
write(s);
readln
end.