IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

> Удалить слово, Из текстового файла
сообщение
Сообщение #1


Гость






дан текстовый файл... Пользователь вводит слово. Если оно есть в файле, то прога удаляет его. Напишите, плиз, основную процедуру удаления. А то, что только не делал, и слова отделял, и сравнивал - не пашет...

Код
program ex1;
uses crt;
procedure deleting(infile,outfile, word:string);
var f_,v:text; st,wt:string; chars:set of char;i:byte;
begin
chars:=['a'..'z'];
assign(f_,infile);
reset(f_);
assign(v,outfile);
rewrite(v);
while not eof(f_) do begin
readln(f_,st);
i:=1;
repeat
while not (st[i] in chars) and (i<=length(st)) do inc(i);
wt:='';
while (st[i] in chars) and (i<=length(st)) do
begin
wt:=wt+st[i];
inc(i);
end;
if length(wt)<>0 then writeln(v,wt);
until (i>length(st))
end;
close(f_);
close(v);
reset(v);
while not eof(v) do
begin
readln(v,st);
if st=word then delete(st,1,length(word));
end;
close(v);
reset(v);
end;
var word1,st1,filename:string; f:text;
begin
write('word: ');
readln(word1);
writeln('from <f>ile?');
if (readkey='f') then
begin
write('filename: ');
readln(filename)
end else
begin
assign(f,'d:\bin\b.dat');
rewrite(f);
writeln('input text');
repeat
readln(st1);
if st1<>'' then writeln(f,st1);
until st1='';
close(f);
filename:='d:\bin\b.dat';
end;
deleting(filename,'d:\bin\res.dat',word1);
assign(f,'d:\bin\res.dat');
reset(f);
while not eof(f) do
begin
readln(f,st1);
writeln(st1);
end;

end.


Код ставим в теги...
 К началу страницы 
+ Ответить 
 
 Ответить  Открыть новую тему 
Ответов
сообщение
Сообщение #2


Гость






Ну тогда вот так (приведенная здесь функция isLetter проверяет, является ли символ латинской буквой; для работы с кириллицей нужно немного изменить функцию, поищите по форуму, она выкладывалась...):
Код
function isLetter(ch: char): boolean;
 begin
   isLetter := upcase(ch) in ['A' .. 'Z']
 end;

(* Теперь функция del_word удаляет только те последовательности,
справа и слева от которых стоят символы, не являющиеся буквами *)
function del_word(myword, str: string): string;
 var p: byte;
 begin
   p := pos(myword, str);
   if p <> 0 then
     if ( (p > 1) and (not isLetter(str[pred(p)])) ) and
        (
          (p + length(myword) < length(str)) and
          (not isLetter( str[ succ(p + length(myword)) ] ))
        )
        then delete(str, p, length(myword));
   del_word := str;
end;
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Гость






Цитата(volvo @ 1.03.05 20:57)
(приведенная здесь функция isLetter проверяет, является ли символ латинской буквой; для работы с кириллицей нужно немного изменить функцию, поищите по форуму, она выкладывалась...)

У Вас же наверняка работа с кириллицей !!! Внимательнее читайте ответы. Моя функция удаляет из строк отдельно стоящие слова (не являющиеся частью других слов)... Замените функцию Letter и она будет работать с кириллицей тоже.
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


Гость






я прочитал ваш ответ, что-то заменил,но не понимаю, как ее правильно заменить. Если вам не трудно, пожалуйста, напишите, как должна выглядеть моя функция, а то уже не понимаю :molitva: :molitva: :molitva: sad.gif unsure.gif lol.gif

Добавлено (2.03.05, 01:14 PM):
я с латинскими буквами работаю
 К началу страницы 
+ Ответить 

Сообщений в этой теме


 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 8.05.2024 5:49
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name