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

[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]

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

Как говаривал Люис Кэррол, "а подумать не мешало бы"

Во-первых, хотя в твоей программе есть намеки на форматирование, оно такое, что лучше бы их не было.. Я переформатировал твой код (без изменений, кроме удаления вредных clearscr и 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
  assign(k,'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.

Далее..
Читать из файла и писать в него одновременно в принципе можно, но не во всех случаях желательно. Я бы даже сказал, нежелательно везде, кроме случаев, где этого избежать нельзя либо слишком накладно. И мне кажется, что это не тот случай.. Обычная схема такова:
1. пишешь во временный файл;
2. по окончании удаляешь исходный файл;
3. переименовываешь временный файл.

Вот, примерно так:

var
  f,g: file of char;
  c: char;
  Flag: boolean;

begin
  Assign(f,'pavel.txt');
  ReSet(f);
  Assign(g,'pavel.tmp');
  ReWrite(g);
  Flag:=true;
  while not EoF(f) do begin
    Read(f,c);
    if (c<>'#')or Flag then Write(g,c);
    Flag:=Flag and (c<>'#')
  end;
  Close(f);
  Close(g);
  Erase(f);
  ReName(g,'pavel.txt')
end.

Если я не прав, и тебе необходимо работать с одним файлом (например, по условию) - скажи, продолжим