В предложении найти все пары слов, состоящих из одних и тех же букв (нужны комментарии)

Program up18;
Uses Crt,unit18;
Var i:integer;
    c,ch:char;
    f:text;
    s:string;
Begin
 repeat
  ClrScr;
  WriteLn('ЊҐ*о:');
  WriteLn('1. ‘®§¤**ЁҐ Ё §*Ї®«*Ґ*ЁҐ д*©«*');
  WriteLn('2. Џа®б¬®ва ᮤҐа¦Ё¬®Ј® Ёб室*®Ј® д*©«*');
  WriteLn('3. Џ*ал б«®ў Ё§ ®¤*®Ј® **Ў®а* ЎгЄў');
  WriteLn('4. Џа®б¬®ва д*©«* б १г«мв*в*¬Ё');
  WriteLn('5. “¤*«Ёвм Ёб室*л© д*©«');
  WriteLn('0. ‚л室');
  ch:=readkey;
  case ch of
   '1': begin
        ClrScr;
        CreateFile;
        ReadKey;
        end;
   '2': begin
        ClrScr;
        Assign(f,'file.txt');
        {$i-}
        Reset(f);
        {$i+}
        if ioresult<>0
         then WriteLn('”*©« *Ґ ᮧ¤**!')
         else PrintFile(f);
        ReadKey;
        end;
   '3': begin
        ClrScr;
        Assign(f,'file.txt');
        {$i-}
        Reset(f);
        {$i+}
        if ioresult<>0
         then WriteLn('”*©« *Ґ ᮧ¤**!')
         else
         begin
          Read(f,s);
          Close(f);
          ParaSlov(s);
         end;
        ReadKey;
        end;
   '4': begin
         ClrScr;
         Assign(f,'fileout.txt');
         {$i-}
         Reset(f);
         {$i+}
         if ioresult<>0
          then WriteLn('”*©« *Ґ ᮧ¤**!')
          else PrintFile(f);
         ReadKey;
        end;
   '5': begin
         Assign(f,'file.txt');
         {$i-}
         Reset(f);
         {$i+}
         if ioresult<>0
          then WriteLn('”*©« *Ґ ᮧ¤**!')
          else
          begin
           close(f);
           Erase(f);
          end;
        end;
   end;
 until ch='0';
End.

Interface
Uses Crt;
Type mas=array[1..20] of string;
Procedure CreateFile;
Procedure PrintFile(var f:text);
Procedure ParaSlov(var s:string);
 
Implementation
 
Procedure CreateFile;
 var f:text;
     s:string;
 begin
  Assign(f,'file.txt');
  ReWrite(f);
  WriteLn('‚ўҐ¤ЁвҐ ⥪бв: ');
  ReadLn(s);
  Write(f,s);
  Close(f);
 end;
Procedure PrintFile(var f:text);
 var ch:char;
 begin
  Reset(f);                 {открываем на чтение файл}
  while not eof(f) do      {пока не конец файла}
   begin
    Read(f,ch);
    Write(ch);
   end;
  Close(f);                {закрываем файл}
 end;
Procedure ParaSlov(var s:string);
var i,j,k,l:integer;
    a,b:mas;
    c:array[1..20] of integer;
    as,bs:string;
    ch:char;
    flag:boolean;
    fout:text;
begin
 Write(s);
 s:=#32+s+#32; k:=0;
 for i:=1 to 20 do
 begin; a[i]:=''; b[i]:=''; c[i]:=i; end;
 for i:=2 to length(s) do
  begin
   if (s[i]<>#32) and (s[i-1]=#32) then inc(k);  {если не пробел, а пред был пробел тогда наращиваем}
   if (s[i]<>#32) then a[k]:=concat(a[k],s[i]); {если не пробел тогда сцепляем}
  end;
 for i:=1 to k do
  begin
   as:=a[i];
   bs:=as[1];
   for j:=2 to length(as) do
    begin
     flag:=false;
     for l:=1 to length(bs) do
      if as[j]=bs[l]
       then begin flag:=false; break; end
       else flag:=true;
     if flag then bs:=bs+as[j];
    end;
   b[i]:=bs;
  end;
  for l:=1 to k do
   begin
    bs:=b[l];
    for i:=length(bs) downto 1 do
     for j:=1 to i-1 do
      if bs[j]>bs[j+1] then
       begin
        ch:=bs[j];
        bs[j]:=bs[j+1];
        bs[j+1]:=ch; end;
    b[l]:=bs; end;
   for i:=k downto 1 do
    for j:=1 to i-1 do
     if b[j]>b[j+1] then
      begin
       bs:=b[j];
       b[j]:=b[j+1];
       b[j+1]:=bs;
       l:=c[j];
       c[j]:=c[j+1];
       c[j+1]:=l;
      end;
  Assign(fout,'fileout.txt');       {создаём файл итога}
  Rewrite(fout);                    {записываем в файл}
   for i:=2 to k do
    if b[i-1]=b[i]
     then begin write(a[c[i-1]],#32); Write(fout,a[c[i-1]],#32); end
     else
      if b[i-2]=b[i-1]
       then begin writeln(a[c[i-1]],#32); Write(fout,a[c[i-1]],#32); end;
    if b[k]=b[k-1] then begin writeln(a[c[k]]); Write(fout,a[c[k]]); end;
  Close(fout);
end; End.