Задача по удалению компонента из файла, Помогите, пожалуйста, найти ошибку в коде Опции

[Eskel]

Задача такова. Создаешь файл с символьными данными. Делаешь процедуру, которая удаляет из файла все '#' КРОМЕ первой '#'.

Вот я не долго думая написал:

program pavel;
uses crt;
type tyfile=file of char;
Var
k:tyfile; i,n:integer; b:char;
procedure first(var f1:tyfile);
Var
x,a:char; i,n,t,k:integer;
Begin
reset(f1); n:=0;
while not eof(f1) do begin
       t:=filepos(f1);
       read(f1,x);
       if (x='#') then n:=n+1;
       if (x='#') and (n>1) then
       for i:=filepos(f1)-1 to filesize(f1)-2 do begin
       seek(f1,i+1);
       read(f1,a);
       seek(f1,i);
        write(f1,a) end;
       seek(f1,t+1) end;
       seek(f1,filesize(f1)-n+1); truncate(f1);
       close(f1) end;
procedure vivod(var f:tyfile);
var t:char;
begin
   reset(f);
   while not eof(f) do begin
       read(f,t);
       write(t)
   end;
   close(f);
end;
BEGIN
   clrscr;
   assign(k,'E:/Pavel.txt');
   rewrite(k);
   write('Введите кол-во символов в файле ');
   readln(n);
   for i:=1 to n do begin
       write('Символ '); readln(b);
       write(k,b) end;
   close(k);
   vivod(k); writeln;
   writeln('FIRST');
   first(k);
   vivod(k);
   readln
End. 

Я понимаю, что процедура косячная и работает далеко не всегда. Не подскажите как ее правильно написать?

[Lapp]

Именно. Нужно отслеживать отдельно позиции чтения и записи. Вот и все .

var
  f: file of char;
  c: char;
  Flag: boolean;
  i,j: LongInt;

begin
  Assign(f,'pavel.txt');
  ReSet(f);
  Flag:=true;
  i:=0;
  j:=0;
  while not EoF(f) do begin
    Seek(f,i);
    Read(f,c);
    Inc(i);
    if (c<>'#')or Flag then begin
      Seek(f,j);
      Write(f,c);
      Inc(j)
    end;
    Flag:=Flag and (c<>'#')
  end;
  Seek(f,j);
  Truncate(f);
  Close(f)
end.

Добавлено через 1 мин.
Кстати, заметь, что позицию хорошо бы делать LongInt, а не integer, как у тебя. Иначе твой преподаватель опять скажет, что мало .