1. Заголовок темы должен быть информативным. В противном случае тема удаляется ... 2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения. 3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали! 4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора). 5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM! 6. Одна тема - один вопрос (задача) 7.Проверяйте программы перед тем, как разместить их на форуме!!! 8.Спрашивайте и отвечайте четко и по существу!!!
Задача по удалению компонента из файла, Помогите, пожалуйста, найти ошибку в коде
Задача такова. Создаешь файл с символьными данными. Делаешь процедуру, которая удаляет из файла все '#' КРОМЕ первой '#'.
Вот я не долго думая написал:
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.
Я понимаю, что процедура косячная и работает далеко не всегда. Не подскажите как ее правильно написать?
не долго думая написал: ... процедура косячная и работает далеко не всегда. Не подскажите как ее правильно написать?
Как говаривал Люис Кэррол, "а подумать не мешало бы"
Во-первых, хотя в твоей программе есть намеки на форматирование, оно такое, что лучше бы их не было.. Я переформатировал твой код (без изменений, кроме удаления вредных 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.
Если я не прав, и тебе необходимо работать с одним файлом (например, по условию) - скажи, продолжим
--------------------
я - ветер, я северный холодный ветер я час расставанья, я год возвращенья домой
Если я не прав, и тебе необходимо работать с одним файлом (например, по условию) - скажи, продолжим
По заданию надо делать операции с одним файлом... Я подумал, что можно сделать с помощью дополнительной строки, куда я буду записывать нужное мне содержимое файла - получилось! Но преподаватель сказал, что длина строки всего 256 байт, а файл больше и значит работает не всегда...
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 и проверяю первая она или нет, а дальше я запутался... Вроде как в мозгах я понимаю, что надо считывать следующий элемент, потом переводить указатель на текущий и записывать
Именно. Нужно отслеживать отдельно позиции чтения и записи. Вот и все .
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, как у тебя. Иначе твой преподаватель опять скажет, что мало .
--------------------
я - ветер, я северный холодный ветер я час расставанья, я год возвращенья домой
ошибка 100... Ошибка чтения с диска. Я думаю дело в указателях, пытаюсь разобраться
Добавлено через 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###, например, норм работает)
ошибка 100... Ошибка чтения с диска. Я думаю дело в указателях, пытаюсь разобраться
В каких указателях? Нету же никаких указателей.
Ошибка в том, что 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.
--------------------
я - ветер, я северный холодный ветер я час расставанья, я год возвращенья домой