Переписать текст из исходного файла в новый файл, удалив слова, в которых нет идущих подряд согласных букв

const
 letters= ['й','ц','к','н','г','ш','щ','з','ф','в','х',
                     'п','р','л','д','ж','ч','с','м','т','б',
                     'Й','Ц','К','Н','Г','Ш','Щ','З','Х','Ф','В',
                     'П','Р','Л','Д','Ж','Ч','С','М','Т','Б',
                     
                     
                     'Q','W','R','T','P','S','D','F','G','H','J',
                     'K','L','Z','X','C','V','B','N','M',
                     'q','w','r','t','p','s','d','f','g','h','j',
                     'k','l','z','x','c','v','b','n','m'];
  punc = ['.', ',', ' ', '-', ';', ':', '?'];
var
  f1, f2: text;
  word, str: string;
 i, n: integer;
 
 
function check_word(word: string): boolean;
begin
  for var i := 1 to length(word) - 1 do
  begin
    if(word[i] = word[i + 1])and (word[i] in letters) then
    begin
      check_word := true;
      break;
    end
    else check_word := false;
  end;
end;
 
function find_word(s: string; i: integer): string;
var
  word: string;
begin
  while (i <= length(s)) and (not (s[i] in punc)) do
  begin
    word := word + s[i];
    i := i + 1;
  end;
  find_word := word + ' ';
end;
 
 Begin
   
    Assign(f1, 'input.dat');
    Rewrite(f1);
        writeln('Введите количество строк');
   Readln(n); 
   for i:=1 to n do
    begin
    readln(str); 
    writeln(f1,str); 
    end;
    close(f1); 
    Reset(f1); 
    Assign(f2,'output.dat'); 
    Rewrite(f2); 
    
     While not eof(f1) do
     Begin
     Readln(f1,str);
     while (i <= length(str)) do
  begin
    word := find_word(str, i);
    i := i + length(word) - 1;
    if (check_word(word) = false) then
    begin
      for var j := 1 to length(word) do
       delete(word,i-j,j+1);       
    end
    else
     Write(f2,word);
      i := i+1;;
      
     End
     end;
     
     close(f1); 
     close(f2);
     Writeln;
     Writeln('Второй файл содержит строки:');
     Reset(f2); 
     While not eof(f2) do 
     Begin
     Readln(f2,str);
     Writeln(str); 
     End;
    End.

function ContainTwoConsonant(self: string): boolean; extensionmethod;
begin
  var consonants := 'цкнгшщзхъфвпрлджчсмтьб'.ToCharArray;
  //var vowels:='ёуеыаоэяию'.ToCharArray;
  for var i := 1 to self.Length - 2 do
    if consonants.Contains(self[i]) and consonants.Contains(self[i+1 ]) then
    begin
      result := true;
      exit;
    end;
end;
 
begin
  ReadAllLines('FileName').Select(line->line.ToWords.Where(s -> s.ContainTwoConsonant).JoinToString(' ')).WriteLines('FileName');
end.

  ReadAllLines('input.dat').Select(line->line.ToWords.Where(s -> s.ContainTwoConsonant).JoinToString(' ')).WriteLines('output.dat');

const
  letters = ['й', 'ц', 'к', 'н', 'г', 'ш', 'щ', 'з', 'ф', 'в', 'х',
  'п', 'р', 'л', 'д', 'ж', 'ч', 'с', 'м', 'т', 'б',
  'Й', 'Ц', 'К', 'Н', 'Г', 'Ш', 'Щ', 'З', 'Х', 'Ф', 'В',
  'П', 'Р', 'Л', 'Д', 'Ж', 'Ч', 'С', 'М', 'Т', 'Б',
  
  
  'Q', 'W', 'R', 'T', 'P', 'S', 'D', 'F', 'G', 'H', 'J',
  'K', 'L', 'Z', 'X', 'C', 'V', 'B', 'N', 'M',
  'q', 'w', 'r', 't', 'p', 's', 'd', 'f', 'g', 'h', 'j',
  'k', 'l', 'z', 'x', 'c', 'v', 'b', 'n', 'm'];
  punc = ['.', ',', ' ', '-', ';', ':', '?'];
 
 
function check_word_has_duplicates(OneWord: string): boolean;
begin
  check_word_has_duplicates := false;
  for var i := 1 to length(OneWord) - 1 do
  begin
    if (OneWord[i] in letters) and (OneWord[i + 1] in letters) then
    begin
      check_word_has_duplicates := true;
      break
    end
  end;
end;
 
function find_word(s: string; i: integer): string;
var
  OneWord: string;
begin
  OneWord := '';
  while (i <= length(s)) and (not (s[i] in punc)) do
  begin
    OneWord := OneWord + s[i];
    i := i + 1;
  end;
  find_word := OneWord + ' ';
end;
 
var
  f1, f2: text;
  OneWord, CurStr: string;
  i, n: integer;
 
begin
  Assign(f1, 'input.dat');
  Reset(f1); 
  Assign(f2, 'output.dat'); 
  Rewrite(f2); 
  
  while not eof(f1) do
  begin
    Readln(f1, CurStr);
    i := 1;
    while (i <= length(CurStr)) do
    begin
      OneWord := find_word(CurStr, i);
      writeLn('word = ', OneWord);
      i := i + length(OneWord);
      if check_word_has_duplicates(OneWord) then Write(f2, OneWord);
    end
  end;
  
  close(f1); 
  close(f2);
  Writeln;
  Writeln('Второй файл содержит строки:');
  Reset(f2); 
  while not eof(f2) do 
  begin
    Readln(f2, CurStr);
    Writeln(CurStr); 
  end;
end.