Из слова получить все подслова, которые можно составить из букв данного слова

##
var words := ReadLines('нормальные.txt').ToHashSet;
var s := ReadString;
(1..s.Length).SelectMany(len->s.Permutations(len))
.Where(w->w in words)
.PrintLines;

const 
  n = 9; //количество букв в слове "свидетель"
  slovo = 'свидетель'; //исходное слово
 
Type SetInt = Set of byte; //тип данных для множества байтов
Var 
    p:array[1..n] of integer; //массив для хранения индексов букв в слове
    i,q,count:integer; //переменные для циклов и подсчета количества нормальных слов
    f:text; //переменная для работы с файлом
    normWords:array[1..20] of string; //массив для хранения нормальных слов
    buf:string; //строка для считывания слов из файла
 
procedure Perebor(k,q:integer;m:SetInt); //процедура перебора всех возможных комбинаций 
Var 
  i,j,w,el:integer; //переменные для циклов и работы с буквами
  nw:string; //строка для формирования слова из текущей комбинации 
begin
  if k > q then begin //если достигнута нужная длина комбинации 
    for i:=1 to q do 
      write(p[i]);writeln; //выводим индексы букв на экран
      Exit //и выходим из процедуры
  end;
 
  nw:='';
  for j:= 1 to Length(p) do //формируем слово из текущей комбинации индексов
  begin
    el:= p[j];
    nw[j]:= slovo[el];
  end;
 
  for w:= 1 to count do //проверяем, является ли полученное слово нормальным
  begin
    if nw = normWords[w] then //если да
    begin
      writeln(nw); //выводим его на экран
      Exit; //и выходим из процедуры
    end;
  end;
 
  for i:= 1 to n do //перебираем все еще не использованные буквы
    if i in m then begin
      p[k]:= i; //записываем индекс буквы в массив
      Perebor(k+1,q,m-[i]); //вызываем рекурсивно процедуру для следующего индекса в массиве
    end;
end;
 
 
begin
  //Считываем слова из файла в массив нормальных слов
  assign(f, 'Words.txt'); //открываем файл для чтения
  reset(f); //открываем файл
  while not eof(f) do //пока не достигнут конец файла
  begin
    readln(f, buf); //считываем строку из файла в переменную buf
 
    if buf <> '' then //если строка не пустая
    begin
      count := count + 1; //увеличиваем счетчик нормальных слов на 1
      normWords[count]:= buf; //сохраняем считанное нормальное слово в массив
    end;  
  end;
  close(f); //закрываем файл
 
  //Вывод нормальных слов
  //for i:=1 to count do
  //  writeln(normWords[i]);
 
  //Перебор букв
  for q:=1 to n do //перебираем все возможные длины комбинаций букв от 1 до 9
    Perebor(1,q,[1..n]); //вызываем процедуру Perebor для текущей длины комбинации 
end.

var
  w, n, m: string;
  i, p: integer;
  found: boolean;
  t: Text;
begin
  write('Введите слово: ');
  readln(w);
  found := false;
  assign(t, 'normal.txt');
  reset(t);
  writeln('Слова, которые можно составить из слова "', w, '":');
  while not EoF(t) do
    begin
      readln(t, n);
      m := n;
      for i := 1 to length(w) do
        begin
          p := pos(w[i], m);
          if p > 0 then delete(m, p, 1)
        end;
      if length(m) = 0 then
        begin
          writeln(n);
          found := true
        end
    end;
  close(t);
  if not found then writeln('<не найдены>');
  readln
end.

const
  n = 13;
  slovo = 'свидетельство';
 
type
  SetChar = Set of char;
  SetString = Set of string;
 
var
  p: array[1..n] of char;
  i, q, countNormWord: integer;
  f: text;
  normWords: array[1..93400] of string;
  buf: string;
  usedWords: SetString;
 
procedure Perebor(k, q: integer; m: SetChar);
var
  i, j, w: integer;
  nw: string;
begin
  if k > q then 
  begin
    nw := '';
    for i := 1 to q do 
      nw := nw + p[i];
    if nw in usedWords then
      Exit;
    for w := 1 to countNormWord do
    begin
      if nw = normWords[w] then
      begin
        writeln(nw);
        usedWords := usedWords + [nw];
        Exit;
      end;
    end;
    Exit
  end;
  
  for i := 1 to Length(slovo) do 
    if slovo[i] in m then 
    begin
      p[k] := slovo[i];
      Perebor(k + 1, q, m - [slovo[i]]);
    end;
end;
 
begin
  // Считываем слова из файла в массив нормальных слов
  assign(f, 'Slova.txt');
  reset(f);
  while not eof(f) do
  begin
    readln(f, buf);
    if buf <> '' then 
    begin
      countNormWord := countNormWord + 1;
      normWords[countNormWord] := buf;
    end;  
  end;
  close(f);
  
  // Перебор букв
  for q := 1 to n do
  begin
    // Создаем множество символов из строки slovo
    var m: SetChar;
    m := [];
    for i := 1 to Length(slovo) do
      m := m + [slovo[i]];
    usedWords := [];
    Perebor(1, q, m);
  end;
end.