Дан текстовый файл. Найти слово, встречающееся в каждом предложении, или сообщить, что такого слова нет

program L7N1;
uses crt;
Var  Words:array [1..100,1..100] of string;
     S,word :string;
     F:text;
     i,n,m,l,j:integer;
begin
Clrscr;                                
ASSIGN(F,'F:\primer.TXT');
Rewrite(F);
Write('Введите текст');
Readln(S);
Writeln(F,S);
Close(F);
Reset(F);
  begin
   readln(F,S);
   l:=LENGTH(S);
 
i:=0;
m:=1;
   while i<l do
      begin
      i:=i+1;
         while S[i]<> '.' do
            if S[i]<>' ' then
              begin
              word:=S[i];
              i:=i+1;
                while ((S[i]<>' ') and (S[i]<>'.')) do
                 begin
                 word:=word+S[i];
                 i:=i+1;
                 end;
              n:=n+1;
              Words[n,m]:=word+' ';
              end
            else i:=i+1;
             if S[i]='.' then m:=m+1;    
      end;
  end;
 for j:= 1 to m do
  begin
   writeln;
   for i:= 1 to n do
    write(Words[i,j]);
  end;
end.

program L7N1;
uses crt;
var Words: array[1..100, 1..100] of string;
  S, oneline, sword: string;
  F: text;
  i, n, m, k, l, j, cnt: integer;
  word_is_found, found_in_sentence: boolean;
begin
  Clrscr;
  Assign(F, 'F:\primer.TXT');
 
  {Rewrite(F);
  Write('Введите текст');
  Readln(S);
  Writeln(F,S);
  Close(F);
  }
 
  Reset(F);
  S := '';
  while not EOF(F) do begin
    readln(F, oneline);
    S := S + UPPERCASE(oneline);
  end;
  Close(F);
 
 
  l := Length(S);
 
  sword := '';
  m := 1;
  i := 0;
  k := 0;
  n := 0;
 
  while i < l do
  begin
    i := i + 1;
    while S[i] <> '.' do
      if S[i] <> ' ' then
      begin
        sword := S[i];
        i := i + 1;
        while ((S[i] <> ' ') and (S[i] <> '.')) do
        begin
          sword := sword + S[i];
          i := i + 1;
        end;
        k := k + 1;
        Words[m, k] := sword;
        if k > n then n := k;
        if k > n then n := k;
      end
      else i := i + 1;
    if S[i] = '.' then begin m := m + 1; k := 0; end;
  end;
 
      // если последнее предложение пустое,скоректируем m
  while (m > 0) and (Length(Words[m, 1]) = 0) do Dec(m);
 
 // вывод всех предложений на экран построчно
  for i := 1 to m do
  begin
    for j := 1 to n do
      if Length(Words[i, j]) > 0 then write(Words[i, j], ' ');
    writeln;
  end;
 
 // поиск слов, которые есть в каждом предложении
  cnt := 0;
  for j := 1 to n do
    if Length(Words[1, j]) > 0 then begin
      sword := Words[1, j]; // берём слово из первого предложения и ищем его в всех остальных
      word_is_found := true;
      for i := 2 to m do begin
        found_in_sentence := false;
        for k := 1 to n do
          if Words[i, k] = sword then begin
            found_in_sentence := true;
            break
          end;
        if not found_in_sentence then begin
          word_is_found := false;
          break
        end;
      end;
      if word_is_found then begin Inc(cnt); WriteLn('слово ', sword, ' есть во всех предложениях') end;
    end;
  if cnt = 0 then WriteLn('Нет слов, которые есть в каждом предложении.');
 
  ReadLn
end.