Uses crt;
Const
 CC:Set of Char=['!',',','.','?',':',';'];

Type
 matr = array[1..30] of integer;
 tFile = file of integer;

Procedure Inp_file(var g1:Text;var g2:Text);
var C:Char;
begin
 Assign(g1,'preinput.txt');
 Reset(g1);
 Assign(g2,'input.txt');
 Rewrite(g2);
 Repeat
  repeat
   Read(g1,C);
  until C<>' ';
  if (Ord(C)<>10) and (Ord(C)<>13) then Write(g2,C);
  repeat
   Read(g1,C);
   if (C<>' ') and (Ord(C)<>10) and (Ord(C)<>13) then Write(g2,C);
  until (C=' ') or (EoLn(g1));
  Writeln(g2);
 Until EoF(g1);
 Close(g1);
 Close(g2);
end;
//Вывожу на экран, что есть в файле
procedure show(var f:text);
var s:string;
begin
 Assign(f, 'input.txt');
 reset(f);
 while not eof(f) do
  begin
   readln(f,s);
   writeln(s);
  end;
 Close(f);
end;

//Перевожу символы в ascii-коды
//(здесь пользователь вводит слово, которое надо удалить)
procedure input(var a:matr; var delword:string; var L:integer);
var i:integer;
begin
 writeln('Enter delword:');
 readln(delword);
 L:=Length(delword);
 for i:=1 to length(delword) do a[i]:=ord(delword[i]);
end;

//Перевожу все символы в ascii-коды
//(здесь слова, которые были в файле)
procedure transfer(var f:text; var f3:tFile);
var s:string; i,k:integer;
begin
 reset(f);
 assign(f3, 'ascii');
 rewrite(f3);
 while not eof(f) do
  begin
   readln(f,s);
   for i:=1 to length(s) do
    begin
     k:=ord(s[i]);
     write(f3,k);
    end;
   k:=10;
   write(f3,k);
  end;
 close(f);
 close(f3);
end;

//Удачная попытка удалить
procedure process (var f3:tFile; var f2:text; a:matr; L:integer);
var
 k,i,p,p1,time,count:integer;
 flag,flag1,flag2:boolean;
 b:matr;
begin
 writeln('Enter time:');
 readln(time);
 count :=0;
 reset(f3);
 Assign(f2, 'output.txt');
 rewrite(f2);
 while not eof(f3) do
  begin
   p:=0;
   repeat
    inc(p);
    read(f3, k);
    b[p]:=k;
   until (k=10) or EoF(f3);
   repeat
    if (b[p]=10) or (b[p]=13) then dec(p);
   until (b[p]<>10) and (b[p]<>13);
   if Chr(b[p]) in CC then p1:=p-1 else p1:=p;
   if p1=L then
    begin
     i:=0;
     flag2:=true;
     repeat
      inc(i);
      flag1:=b[i]=a[i];
     until (flag1=false) or (i=L);
     if flag1 then
      begin
       inc(count);
       if count mod time = 0 then flag2:=false;
      end;
     flag:=flag2;
    end else flag:=true;
   if (flag=false) and (Chr(b[p]) in CC) then
    begin
     Writeln(f2,Chr(b[p]));
     Writeln(Chr(b[p]));
    end;
   if flag then
    begin
     for i:=1 to p do
      if (b[i]<>10) and (b[i]<>13) then write(f2,chr(b[i]));
     writeln(f2);
     for i:=1 to p do
      if (b[i]<>10) and (b[i]<>13) then write(chr(b[i]));
     writeln;
    end;
  end;
 Readln;
 close(f2);
 close(f3);
end;


var
  f0,f,f2: text;
  f3:tFile;
  delword: string;
  a:matr;
  time,L:integer;
begin
 clrscr;
 Inp_file(f0,f);
 show(f);
 input(a, delword,L);
 transfer(f, f3);
 process(f3, f2, a, L);
end.