Форум программистов [Powered by Invision Power Board]

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

Форум программистов > Object Pascal: кроссплатформенные технологии > Удаление вхождения слова в текстовом файле

Автор: Agentum 3.3.2009, 21:45

Помогите пожалуйста мыслями:надо удалить вхождение слова в текстовом файле.Как я понимаю чисто в текстовом файле нельзя так сделать.Я думаю что надо переписать его в типизированный файл строк и уже там удалять вхождение слова.Так получается?

Автор: Kbl4AH 3.3.2009, 22:55

Код


program Project1;

{$APPTYPE CONSOLE}

uses
  SysUtils;

var
  OldF, NewF: Text;
  OldS: string;
function Cut(const SubStr: string; var Str: string): string;
begin  
  while Pos(SubStr, Str) <> 0 do
    Delete(Str, Pos(SubStr, Str), Length(Substr));
  Result := Str;
end;
begin
  AssignFile(OldF, 'c:\olddata.txt');
  Rewrite(OldF);
  Writeln(OldF, 'Ехал Грека через реку, видит Грека в реке рак,');
  Writeln(OldF, 'Сунул Грека руку в реку, рак за руку Грека цап.');
  CloseFile(OldF);

  Reset(OldF);
  AssignFile(NewF, 'c:\newdata.txt');
  Rewrite(NewF);
  while not Eof(OldF) do
  begin
    Readln(OldF, OldS);
    Writeln(NewF, Cut('Грека', OldS));
  end;
  CloseFile(OldF);
  CloseFile(NewF);
end.

Добавлено @ 22:59
Если нужно удалить из исходного файла, то добавь в конце:

Код


  DeleteFile('c:\olddata.txt');
  RenameFile('c:\newdata.txt', 'c:\olddata.txt');

Автор: Agentum 4.3.2009, 06:58

Ой,а мне надо на паскале...

Автор: Agentum 4.3.2009, 07:29

В принципе я понял что надо сделать,просто не знаю получится или нет на паскале...спасибо за помощь!

Автор: Kbl4AH 4.3.2009, 08:24

Цитата(Agentum @ 4.3.2009, 07:29

)

просто не знаю получится или нет на паскале

Почему же не получится? Все получится... smile

Автор: Kbl4AH 4.3.2009, 08:41

И правда, не получится... щас...

Добавлено через 10 минут и 44 секунды

Код


program Project1;
var
  OldF, NewF: Text;
  OldS: string;
function Cut(const SubStr: string; var Str: string): string;
begin
  while Pos(SubStr, Str) <> 0 do
    Delete(Str, Pos(SubStr, Str), Length(Substr));
  Cut := Str;
end;
begin
  Assign(OldF, 'c:\olddata.txt');
  Rewrite(OldF);
  Writeln(OldF, 'Ehal Greka cherez reku, vidit Greka v reke rak,');
  Writeln(OldF, 'Sunul Greka ruku v reku, rak za ruku Greka cap.');
  Close(OldF);

  Reset(OldF);
  Assign(NewF, 'c:\newdata.txt');
  Rewrite(NewF);
  while not Eof(OldF) do
  begin
    Readln(OldF, OldS);
    Writeln(NewF, Cut('Greka', OldS));
  end;
  Close(OldF);
  Close(NewF);
  Erase(OldF);
  Rename(NewF, 'c:\olddata.txt');
end.

Автор: Agentum 4.3.2009, 17:32

Вот накорябал...главную задачу делает,но почему то зацикливает паскаль на выводе текстового файла.Проверьте пожалуйста:
program laba;
uses crt;
var
   OldF,NewF:Text;
   OldS,naim,slovo,st:string[30];
function Cut(const SubStr:string;var Str:string):string;
begin
   while Pos(SubStr, Str) <> 0 do
      Delete(Str, Pos(SubStr, Str), Length(Substr));
   Cut:=Str;
end;
begin
clrscr;
   Assign(OldF, 'oldf.txt');
   Reset(OldF);
   Writeln('vvod imeni novogo faila:');
   readln(naim);
   writeln('vvedite slovo dlya udaleniy:');
   read(slovo);
   Assign(NewF,naim);
   Rewrite(NewF);
   while not Eof(OldF) do
   begin
      Readln(OldF,OldS);
      Writeln(NewF,Cut(slovo, OldS));
   end;
   Close(OldF);
   Close(NewF);
   reset(NewF);
   While not eof(NewF) do
   begin
    read(NewF,st);
    write(st);
   end;
   close(NewF);
   readkey;
   end.

Автор: Kbl4AH 4.3.2009, 18:25

1)У меня ругаеццо на несовместимость типов, поэтому я сделал var OldS: string;
2)

Цитата(Agentum @ 4.3.2009, 17:32

)

но почему то зацикливает паскаль на выводе текстового файла

сделай

Код


   While not eof(NewF) do
   begin
    readln(NewF,st);
    writeln(st);
   end;

3) Защиту сделай для случая, когда исходный файл не создан.

Автор: Agentum 4.3.2009, 20:52

Все получилось...спасибо.хотя я не понимаю почему так плохо отреагировал на вывод содержимого файла...

Автор: Kbl4AH 4.3.2009, 21:00

Цитата(Agentum @ 4.3.2009, 20:52

)

я не понимаю почему так плохо отреагировал на вывод содержимого файла

он так отреагировал на read вместо readln...
ты использовал read и как-бы считывание не могло на следующую строку перейти (постоянно считывалась 1-я строка), поэтому конец файла не мог быть достигнут - зацикливание...

Автор: Agentum 4.3.2009, 22:01

Все понятно...я просто немного зациклился на типизированных файлах и поэтому реад пишу...

Автор: Agentum 11.3.2009, 17:00

Возник еще вопрос...например у меня исходный файл такой:asdasd asd asd g g j a s.я удаляю слово аsd...при этом удаляется слово asdasd.как избавиться от этого?

Автор: Kbl4AH 12.3.2009, 12:34

Для наглядности немного нарушил правила офрмления кода...
Видоизменил функцию...
В принципе - работает... Может стоит только пересмотреть список символов, которые могут быть до и после слова...

Код


function Cut(const SubStr: string; var Str: string): string;
const
  PredS : set of Char = [' ', '"', '(']; {simvoly do slova}
  SuccS : set of Char = [' ', '"', ')', ',', ':', ';', '.', '!', '?']; {simvoly posle slova}
var
  SubStrPos, SubStrLen, StrLen, I: Integer;
  SubStrTemp: string;
begin
  SubStrPos := Pos(SubStr, Str);
  SubStrLen := Length(Substr);
  StrLen := Length(Str);
  {inicializaciya podmeny ne udalyaemyh slov}
  SubStrTemp := '';
  for I := 1 to SubStrLen do
    SubStrTemp := SubStrTemp + '_';
  {udalenie slov i podmena ne udalyaemyh slov}
  while SubStrPos > 0 do
  begin
    if
      {ne udalyaemoe slovo - pervoe}
      (SubStrPos = 1) and (SubStrLen < StrLen) and not(Str[SubStrPos + SubStrLen] in SuccS)
      or
      {ne udalyaemoe slovo - poslednee (posle nego net znaka prepinaniya)}
      {prosto zashita ot duraka, tak kak tak po idee nel'zya v russkom jazyke}
      (SubStrPos + SubStrLen > StrLen) and not(Str[SubStrPos - 1] in PredS)
      or
      {ne udalyaemoe slovo - v seredine}
      not((SubStrPos = 1) or (SubStrPos + SubStrLen > StrLen)) and
      not((Str[SubStrPos - 1] in PredS) and (Str[SubStrPos + SubStrLen] in SuccS))
      then
    begin
      Delete(Str, SubStrPos, SubStrLen);
      Insert(SubStrTemp, Str, SubStrPos);
    end
    else
      Delete(Str, SubStrPos, SubStrLen);
    SubStrPos := Pos(SubStr, Str);
    StrLen := Length(Str);
  end;
  {obratnaya podmena ne udalyaemyh slov}
  SubStrPos := Pos(SubStrTemp, Str);
  while SubStrPos > 0 do
  begin
    Delete(Str, SubStrPos, SubStrLen);
    Insert(SubStr, Str, SubStrPos);
    SubStrPos := Pos(SubStrTemp, Str);
  end;
  Cut := Str;
end;

На оптимальность не претендую...