Процедура First(var f1:tyfile) вашей программы оставляет в файле типа tyfile только первые 3 вхождения символа- Pascal(Паскаль)

type 
fs=file of char;

uses crt;

type
  tyfile = file of char;

procedure First(var f1: tyfile);
var
  i, j, k, p: integer;
  a, b: char;
begin
  { считаем * }
  reset(f1);
  k := 0;
  p := 0;
  for i := 0 to filesize(f1) - 1 do
  begin
    seek(f1, i);
    read(f1, a);
    if (a = '*') and (k <= 3) then
      k := k + 1; { считаем }
    if (k > 3) and (p = 0) then
      p := i; { если уже больше трех, но первый раз, лишнии * }
  end;
  close(f1);
  if p = 0 then
    write('В файле не более 3х символов *')
  else
  begin
    reset(f1);
    i := p;
    k := 0;
    while i < filesize(f1) - 2 - k do
    begin
      seek(f1, i);
      read(f1, a);
      if a = '*' then
      begin
        k := k + 1; { считаем лишние }
        for j := i to filesize(f1) - 2 do { идем вперед }
        begin
          seek(f1, j + 1);
          { переставляем - сдвигаем - записи вверх на 1(удаляем) }
          read(f1, b);
          seek(f1, j);
          write(f1, b);
        end
      end
      else
        i := i + 1; { если нет вперед }
    end;
    seek(f1, filesize(f1) - 1 - k);
    { проверяем последнюю, она сдвинулась на k вверх }
    read(f1, a);
    if a = '*' then
      k := k + 1;
    seek(f1, filesize(f1) - 1 - k); { встаем в последнюю не удаленную запись }
    truncate(f1); { обрезаем файл }
    close(f1);
    writeln('Удаление символов *, входящих более 3 раз:');
    reset(f1);
    while not eof(f1) do
    begin
      read(f1, a);
      write(a);
    end;
    close(f1);
  end;
end;

var
  f: tyfile;
  a: char;
  n, i: integer;

begin
  clrscr;
  assign(f, 'simbol');
  rewrite(f);
  write('Сколько символов ввести в файл n=');
  readln(n);
  writeln('Введите в файл символы, в том числе *');
  for i := 1 to n do
  begin
    readln(a);
    write(f, a);
  end;
  clrscr;
  writeln('Исходный файл:');
  reset(f);
  while not eof(f) do
  begin
    read(f, a);
    write(a);
  end;
  writeln;
  close(f);
  First(f);
  readln

end.