Оригинал статьи: http://www.cyberforum.ru/pascal/thread133142.html
Благодарен всем авторам, которые внесли свой вклад в сборку кода.

Удалить все элементы, которые встречаются больше 1 раза

 

var
  a: array[1..100] of integer;
  n, i, j, k, p, x: integer;
  f: boolean;

begin
  randomize;
  write('n=');readln(n);
  writeln('Исходный массив:');
  for i := 1 to n do
  begin
    a[i] := random(10);
    write(a[i], ' ');
  end;
  writeln;
  i := 1;
  while i < n do
  begin
    f := false;
    j := i + 1; //смотрим впереди
    while (j <= n) and not f do
      if a[j] = a[i] then f := true//если есть такой же, меняем флаг
      else j := j + 1; //иначе идем дальше
    if f then //если есть повторы
    begin
      x := a[i];//запомним элемент
      p := i;//и его текущую позицию
      while p <= n do //идем к концу
        if a[p] = x then //если такой же
        begin
          if p = n then n := n - 1 //если последний, убавляем размер массива
          else //иначе
          begin
            for k := p to n - 1 do //сдвигаем на него конец массива
              a[k] := a[k + 1];
            n := n - 1; //убавляем
          end
        end
        else p := p + 1;//если не такой, дальше
    end
    else i := i + 1;//если не удаляли, дальше
  end;
  if n = 0 then write('Все элементы более 1 раза, массив пустой')
  else
  begin
    writeln('Более 1 раза удалены:');
    for i := 1 to n do
      write(a[i], ' ');
  end;
  readln
end.