Версия для печати темы

Нажмите сюда для просмотра этой темы в обычном формате

Форум «Всё о Паскале» _ Задачи _ Задача по удалению компонента из файла

Автор: Eskel 22.12.2008 6:07

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

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


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 22.12.2008 10:07

Цитата(Eskel @ 22.12.2008 2:07) *
не долго думая написал:
...
процедура косячная и работает далеко не всегда. Не подскажите как ее правильно написать?
Как говаривал Люис Кэррол, "а подумать не мешало бы" smile.gif

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

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

Автор: Eskel 22.12.2008 12:55

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

По заданию надо делать операции с одним файлом... Я подумал, что можно сделать с помощью дополнительной строки, куда я буду записывать нужное мне содержимое файла - получилось! Но преподаватель сказал, что длина строки всего 256 байт, а файл больше и значит работает не всегда...

Автор: Eskel 22.12.2008 13:20

 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;
.

Вот фрагмент процедуры. Е сли запустить прогу и вбить в файл 1##4, то она работает... Если же протестить ее несколько раз - вылезают ошибки...
Во внешнем цикле я перебираю все элементы до конца. Далее считываю элемент. Если это не # - оставляю в покое, если #, то к n плюсую 1 и проверяю первая она или нет, а дальше я запутался... Вроде как в мозгах я понимаю, что надо считывать следующий элемент, потом переводить указатель на текущий и записывать
  seek(f1,i+1);
                   read(f1,a);
                   seek(f1,i);
                   write(f1,a)
.

Автор: Lapp 22.12.2008 13:29

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

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, как у тебя. Иначе твой преподаватель опять скажет, что мало smile.gif.

Автор: Eskel 22.12.2008 13:51

Цитата
Read(f,c);
ошибка 100... Ошибка чтения с диска. Я думаю дело в указателях, пытаюсь разобраться unsure.gif

Добавлено через 6 мин. 
 procedure first(var f1:tyfile);
Var
x:char; i,j:longint; ok:boolean;
Begin
reset(f1); ok:=true; i:=0; j:=0;
while not eof(f1) do begin
       seek(f1,i);
       read(f1,x);
       i:=i+1;
       if (x<>'#') or ok then begin
       seek(f1,j); write(f1,x); j:=j+1 end;
       ok:=ok and (x<>'#') end;
       seek(f1,j);
       truncate(f1);
       close(f1) end;

Вот как я переписал под мою процедуру... Может опять прокосячил

Как раз в моем любимом примере 1##4 вылетает. в 2###, например, норм работает)

Автор: Lapp 22.12.2008 14:20

Цитата(Eskel @ 22.12.2008 9:51) *
ошибка 100... Ошибка чтения с диска. Я думаю дело в указателях, пытаюсь разобраться unsure.gif
В каких указателях? Нету же никаких указателей.

Ошибка в том, что EoF сбивается после записи (точнее, после Seek).
Извиняюсь. Вот исправленный вариант:
var
  f: file of char;
  c: char;
  Flag: boolean;
  i,j,l: LongInt;

begin
  Assign(f,'pavel.txt');
  ReSet(f);
  Flag:=true;
  i:=0;
  j:=0;
  l:=FileSize(f);
  while i<l 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.

Автор: Eskel 22.12.2008 20:34

Цитата
В каких указателях? Нету же никаких указателей.


Спасибо большое! Я имел ввиду seek smile.gif