Составить вектор В из упорядоченных по возрастанию всех повторяющихся членов последовательности А

uses crt;
const nmax=100;
var a,b:array[1..nmax] of integer;
    n,m,i,j:byte;
    x:integer;
begin
clrscr;
randomize;
repeat
write('Размер последовательности А до ',nmax,' n=');
readln(n);
until n in [1..nmax];
writeln('Последовательность А:');
for i:=1 to n do
 begin
  a[i]:=random(10);
  write(a[i]:3);
 end;
writeln;
writeln;
for i:=1 to n-1 do
for j:=i+1 to n do
if a[i]>a[j] then
 begin
  x:=a[i];
  a[i]:=a[j];
  a[j]:=x;
 end;
m:=0;
for i:=1 to n do
if(a[i]=a[i+1]) or(a[i]=a[i-1]) then
 begin
  m:=m+1;
  b[m]:=a[i];
 end;
if m=0 then write('Повторяющихся элементов нет!')
else
 begin
  writeln('Все повторяющиеся элементы:');
  for i:=1 to m do
  write(b[i]:3);
 end;
readln
end.

uses crt;
const nmax=100;
var a,b:array[1..nmax] of integer;
    n,m,i,j,k:byte;
    x:integer;
begin
clrscr;
randomize;
repeat
write('Размер последовательности А до ',nmax,' n=');
readln(n);
until n in [1..nmax];
writeln('Последовательность А:');
for i:=1 to n do
 begin
  a[i]:=random(10);
  write(a[i]:3);
 end;
writeln;
writeln;
for i:=1 to n-1 do
for j:=i+1 to n do
if a[i]>a[j] then
 begin
  x:=a[i];
  a[i]:=a[j];
  a[j]:=x;
 end;
m:=0;
for i:=1 to n do
if(a[i]=a[i+1]) or(a[i]=a[i-1]) then
 begin
  m:=m+1;
  b[m]:=a[i];
 end;
if m=0 then write('Повторяющихся элементов нет!')
else
 begin
  writeln('Все повторяющиеся элементы:');
  for i:=1 to m do
  write(b[i]:3);
 end;
writeln;
i:=1;
while i<=m-1 do
if b[i]=b[i+1] then
 begin
  for j:=i to m-1 do
  b[j]:=b[j+1];
  m:=m-1;
 end
else i:=i+1;
writeln('Повторяющиеся элементы по 1 разу:');
for i:=1 to m do
write(b[i]:3);
readln
end.

uses crt;
const nmax=100;
{процедура преобразования русских букв из кодировки DOS в программе в WIN в файле}
procedure Convert(var a:string);{ASCII->ANSI}
var i:integer;
begin
for i:=1 to length(a) do
if ord(a[i]) in [128..175] then a[i]:=chr(ord(a[i])+64)
else if ord(a[i]) in [224..239] then a[i]:=chr(ord(a[i])+16)
else if ord(a[i])=240 then a[i]:=chr(ord(168))
else if ord(a[i])=241 then a[i]:=chr(ord(184));
end;
type vec=array[1..nmax] of integer;
{подпрограмма-функция поиска повторяющихся элементов}
function Povt(v:vec;k,n:byte):boolean;
var i:byte;
begin
Povt:=((k=1)and(v[k]=v[k+1]))or((k=n)and(v[k]=v[k-1]))
or((k in [2..n-1])and((v[k]=v[k+1])or(v[k]=v[k-1])));
end;
var a,b:vec;
    f:text;
    n,m,i,j,k:byte;
    x:integer;
    s:string;
begin
clrscr;
randomize;
assign(f,'vector.txt');
rewrite(f);
s:='Задание:'+#13#10+
' Дана последовательность А размерности N.'+#13#10+
' Составить вектор В из упорядоченных по возрастанию'+#13#10+
' всех повторяющихся членов последовательности А.'+#13#10+
' Вывести исходную и полученную последовательности.'+#13#10;
convert(s);{перевод строки для файла}
write(f,s);
s:=' Нахождение повторяющегося члена последовательности оформить подпрограммой.';
convert(s);
writeln(f,s);
writeln(f);
repeat
write('Размер последовательности А до ',nmax,' n=');
readln(n);
until n in [1..nmax];
s:='Исходная последовательность А:';
writeln(s);
convert(s);
writeln(f,s);
{создаем исходный вектор}
for i:=1 to n do
 begin
  a[i]:=random(10);
  write(a[i]:3);{на экран}
  write(f,a[i]:3);{в файл}
 end;
writeln;
writeln;
writeln(f);
{сортируем по возрастанию}
for i:=1 to n-1 do
for j:=i+1 to n do
if a[i]>a[j] then
 begin
  x:=a[i];
  a[i]:=a[j];
  a[j]:=x;
 end;
{Создание вектора повторяющихся}
m:=0;
for i:=1 to n do
if Povt(a,i,n) then
 begin
  m:=m+1;
  b[m]:=a[i];
 end;
if m=0 then
  begin
   s:='Повторяющихся элементов нет!';
   write(s);
   convert(s);
   write(f,s);
  end
else
 begin
  s:='Все повторяющиеся элементы:';
  writeln(s);
  convert(s);
  writeln(f,s);
  for i:=1 to m do
   begin
    write(b[i]:3);
    write(f,b[i]:3);
   end;
  writeln;
  writeln(f);
  {Сжатие вектора - по 1 элементу}
  i:=1;
  while i<=m-1 do
  if b[i]=b[i+1] then
   begin
    for j:=i to m-1 do
    b[j]:=b[j+1];
    m:=m-1;
   end
  else i:=i+1;
  s:='Повторяющиеся элементы по 1 разу:';
  writeln(s);
  convert(s);
  writeln(f,s);
  for i:=1 to m do
   begin
    write(b[i]:3);
    write(f,b[i]:3);
   end;
 end;
close(f);
readln
end.