Удалить слово, Из текстового файла Опции

[Wait]

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

Код

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.

Код ставим в теги...

[volvo]

Wait
А зачем такие сложности? Все, по-моему, гораздо проще. Пишем функцию:

Код

function del_word(myword, str: string): string;
 begin
   p := pos(myword, str);
   if p <> 0 then
     delete(str, p, length(myword));
   del_word := str;
 end;

И теперь в основной программе читаем из исходного файла строку за строкой, но в результирующий файл пишем строку, на которой отработала вышеописанная функция:

Код

var f_in, f_out: text;
...
while not eof(f_in) do
 begin
   readln(f_in, s);
   writeln(f_out, del_word(word_to_delete, s));
 end;

здесь word_to_delete - то слово, которое нужно удалить...

[W]

Большое спасибо, но програма удаляет не только слова, а, например, если надо удалить "ттт", то в строке "рррттт" она удаляет "ттт", хотя это не является словом. ПОМОГИТЕ!!!!!!!!! Нужно еще, наверно, провеить на наличие пробелов или знаков до и после слова. Как это сделать? Очень прошу, помогите. Заранее благодарен

[volvo]

Ну тогда вот так (приведенная здесь функция 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;

[Wait]

Очень извиняюсь, но теперь она не удаляет просто слова, не входящего ни в какие слова, а то, что я просил, она выполняет. Здесь что-то не так, наверно, проверьте, пожалуйста еще раз, если не трудно.Вообще, моя задача звучит так: написать программу, которая содержит процедуру, которая удаляет слово в файле. Возможно, что-то в проге не так, но я все проверил.

Код

undefinedprogram ex1;
uses crt;
procedure del(infile,outfile,w:string);
var f_in,f_out,f_:text;word,s,wt:string;chars:set of char; i:byte;
function letter(ch:char):boolean;
begin
letter:=ch in ['a'..'z']
end;
function del_word(str,myword:string):string;
var p:byte;
begin
p:=pos(myword,str);
if p<>0 then
if ((p>1)and(not letter(str[pred(p)])))
and((p+length(myword)<length(str))and(not letter(str[succ(p+length(myword))])))
then
delete(str,p,length(myword));
del_word:=str;
end;
begin
chars:=['a'..'z'];
assign(f_in,'b.dat');
reset(f_in);
assign(f_out,'res.dat');
rewrite(f_out);
assign(f_,'res1.dat');
rewrite(f_);
while not eof(f_in) do begin
readln(f_in,s);
i:=1;
repeat
while not(s[i] in chars) and (i<=length(s)) do inc(i);
wt:='';
while (s[i] in chars) and (i<=length(s)) do
begin
wt:=wt+s[i];
inc(i);
end;
if length(wt)<>0 then writeln(f_out,wt);
until(i>length(s))
end;
close(f_in);
close(f_out);
reset(f_out);
while not eof(f_out) do begin
readln(f_out,s);
writeln(f_,del_word(s,w));
end;
close(f_);
close(f_out);
end;
var f:text; word1,s1:string;
begin
writeln('vvedite slovo');
readln(word1);
assign(f,'b.dat');
rewrite(f);
writeln('input text');
repeat
readln(s1);
if s1<>'' then writeln(f,s1);
until s1='';
close(f);
writeln('---------------');
del('res.dat','res1.dat',word1);
assign(f,'res1.dat');
reset(f);
while not eof(f) do
begin
readln(f,s1);
writeln(s1);
end;
readkey
end.

[volvo]

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

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

[Guest]

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

Добавлено (2.03.05, 01:14 PM):
я с латинскими буквами работаю

[volvo]

Да, я понял в чем проблема... Раньше просто не обратил на это внимание... Вот эта процедура del_word должна сработать (вставьте ее в свою программу). Кстети, можете погонять всю мою программу, изменяя входную строку, может быть еще какие-то комбинации не отрабатывают :

Код

function isLetter(ch: char): boolean;
 begin
   isLetter := upcase(ch) in ['A' .. 'Z', '0' .. '9']
 end;

function del_word(myword, str: string): string;

 var p, last: byte;
     to_delete: boolean;
     first, start: integer;

 function FirstLetter: boolean;
   begin
     FirstLetter := (first > 0) and (isLetter(str[first]))
   end;
 function LastLetter: boolean;
   begin
     LastLetter := (last < length(str) + 1) and (isLetter(str[last]))
   end;

 begin
   start := 1;
   Repeat
     p := Pos(myWord, Copy(str, start, 255));
     Inc(p, Byte(p > 0) * Pred(start));

     Last := p + length(myword);
     First := Pred(p);

     If p > 0 Then
       Begin
         to_delete := true;
         if (
              (first = 0) and LastLetter
            )
            or
            (
              (last = length(str) + 1) and FirstLetter
            )
            or
            (
              FirstLetter or LastLetter
            )
           then to_delete := false;
         if to_delete then
           delete(str, p, length(myword))
         else start := last
       end;

   until p = 0;
   del_word := str;
end;



begin
 writeln( del_word('start',
   'starts11 jj stop, start begin start starts 22begin ') )
end.

[Wait]

Гигантское спасибо!!!!!!!!!!!!!!!!!!!!!!!!!!
Только объясните, пожалуйста, если я вам еще не надоел, что означает
byte(p>0)???
очень интересно...
да и надо мне знать, что ответить, если спросят на защите :flowers: :rose: :thanks: :thanks: :thanks: ...............
а вообще, моей благодарности нет пределов

[volvo]

Код

Inc(p, Byte(p > 0) * Pred(start));

можно заменить на вот это:

Код

If p > 0 Then
 Inc(p, Pred(start));

[Guest]

thanks
в подарок могу написать стих
Ничего из прошлого

Как трудно ничего из прошлого
Не вспоминать, не выносить,
Забыть все недостойное и ложное
Как только сложно все забыть!

Как трудно лгать тебе, что так мне хорошо,
Как падший ангел, верить и лететь,
Искать тот свет, что называется душой,
Средь боли, в темноте, в безмерной пустоте.

Ты меня сделал бессильной и слабой –
Я так не привыкла тебя не любить,
Может мне вспомнить все прошлое, дабы
Легче стало обо всем забыть…

Не чувствую, не вижу твоего лица,
(не любим мы, но нелюбовь свою таим)
Как жаль, я даже не могу начать с конца.
Как я бессильна перед холодом твоим!

Теперь я могу только дальше идти,
Так и не вспомнив ничего и не забыв,
Вперед время идет – назад нету пути,
Осталась только боль – души разрыв.

…Но я смогу взлететь, подняться ввысь.
И меня к жизни вернет сама жизнь…