Дан файл F. Переписать его в новый файл, исключая из строк заданное слово — Pascal(Паскаль)

uses crt;
const rz=[' ','.',',','-','?','!'];{разделители в строках, можно добавить}
procedure Convert(var s:string);//преобразование русских символов из файла
{ANSI -> ASCII}                  //если файл написан латиницей не нужно
var i:integer;
begin
for i:=1 to length(s) do
if ord(s[i]) in [192..239] then s[i]:=chr(ord(s[i])-64)
else if ord(s[i]) in [240..255] then s[i]:=chr(ord(s[i])-16)
else if ord(s[i])=168 then s[i]:=chr(ord(240))
else if ord(s[i])=184 then s[i]:=chr(ord(241));
end;
procedure Convert1(var a:string);{ASCII->ANSI}//наоборот при записи в файл
var i:integer;                                //если файл написан латиницей не нужно
begin
for i:=1 to length(a) do
if ord(a[i]) in [128..175] then a[i]:=chr(ord(a[i])+64)
else if ord(a[i]) in [224..239] then a[i]:=chr(ord(a[i])+16)
else if ord(a[i])=240 then a[i]:=chr(ord(168))
else if ord(a[i])=241 then a[i]:=chr(ord(184));
end;
var f,g:text;
    i,k:byte;
    nf,ng,slv,s,s1,s2:string;
begin
clrscr;
write('Имя файла для чтения: ');
readln(nf);
nf:=nf+'.txt';
assign(f,nf);
{$I-} reset(f);  {$I+}
if IOResult <> 0 then
 begin
  writeLn('Файл ',nf,' не найден!');
  writeLn('Работа программы завершена. Нажмите ENTER');
  readln;
  exit;
 end;
write('Имя файла для записи: ');
readln(ng);
ng:=ng+'.txt';
assign(g,ng);
rewrite(g);
write('Введите слово для поиска: ');
readln(slv);
while not eof(f) do
 begin
  readln(f,s);
  convert(s);//если латиница - убрать
  s2:='';
  i:=1;
  while i<=length(s) do
  if not(s[i] in rz)and ((i=1)or(s[i-1] in rz)) then{если буква, а перед ней разделитель, или она первая}
   begin
    k:=i;s1:='';
    while not(s[k] in rz)and(k<=length(s))do {пока не разделитель и не конец строки}
     begin
      s1:=s1+s[k];
      k:=k+1;{идем вперед}
     end;
    if s1<>slv then s2:=s2+s1; {пишем в новую строку}
    i:=i+length(s1);{перепрыгиваем}
   end
  else
   begin
    s2:=s2+s[i];{если не слово, пишем и идем вперед}
    i:=i+1;
   end;
  convert1(s2);//если латиница - убрать
  write(g,s2);
 end;
close(f);
close(g);
write('Текст переписан в файл ',ng);
readln
end.

Leave a Comment

20 − = 18