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

function Sovp(s1,s2:string):boolean;
var m1,m2:set of char;
    i:byte;
begin
m1:=[];
m2:=[];
for i:=1 to length(s1) do
m1:=m1+[s1[i]];
for i:=1 to length(s2) do
m2:=m2+[s2[i]];
if m1-m2=[] then Sovp:=true
else Sovp:=false;
end;

for i:=1 to n-1 do
for j:=i+1 to n do
if Sovp(mas[i],mas[j]) then 
writeln(mas[i],'  ',mas[j]);

program lab7;
uses crt;
type
    vector=array [1..50] of char;
 
 
 
function Sovp(s1,s2:string):boolean;
var m1,m2:set of char;
    i:byte;
begin
  m1:=[];
  m2:=[];
   for i:=1 to length(s1) do
     m1:=m1+[s1[i]];
   for i:=1 to length(s2) do
     m2:=m2+[s2[i]];
   if m1-m2=[] then
     Sovp:=true
   else
     Sovp:=false;
end;
 
var
   s,s1:string;
   i,j,n:integer;
   mas:vector;
 
begin
 clrscr;
 writeln('введите строку');
 readln(s);
 
 for i:=1 to length(s) do
 mas[i]:=s[i];
 
  for i:=1 to n-1 do
  for j:=i+1 to n do
    if Sovp(mas[i],mas[j])=true then
      writeln(mas[i],'  ',mas[j])
    else
      write('*нет таких пар');
end.

uses crt;
var count,i,j:integer;
    st,buf:string;
    slova:array[1..100]of string;
 
function shifr(str:string):string;
var ind:boolean;
    buf:char;
    i:integer;
begin
 repeat
 ind:=true;
 for i:=1 to length(str)-1 do
  if str[i]>str[i+1] then
  begin
   buf:=str[i];
   str[i]:=str[i+1];
   str[i+1]:=buf;
   ind:=false;
  end;
 until ind;
 shifr:=str;
end;
 
begin
 clrscr;
 write('Cтрока -> ');
 readln(st);
 count:=1;
 repeat
  if (st[1]=' ') or (length(st)=0) then while st[1]=' ' do delete(st,1,1)
  else
  begin
   while (st[1]<>' ') and (length(st)>0) do
   begin
    buf:=buf+st[1];
    delete(st,1,1);
   end;
  slova[count]:=buf;
  buf:='';
  inc(count);
  end;
 until (length(st)=0) and (length(buf)=0);
 
 for i:=1 to count-1 do
 for j:=i+1 to count-1 do if shifr(slova[i])=shifr(slova[j]) then writeln(slova[i],' <==> ',slova[j]);
 readln;
end.

{$CODEPAGE CP866}
function SortChars(const S:string):string;
var
  res : string;
  i,j : integer;
  ch : char;
begin
  res := S;
  for i:=1 to Length(res)-1 do
    for j:=i+1 to Length(res) do
      if res[i]>res[j] then begin
        ch := res[i]; res[i] := res[j]; res[j] := ch
      end;
  SortChars := res    
end;
 
var
  s : string; 
  i,j,iPrev,n: integer;
  arrWords : array[1..250] of string;
begin
  s := 'мама  взяла волос и лозу пропела папе слово про перо золу и улоз'; {тестовый набор}
  {  readln(s); }
  
  s := s + ' '; 
  iPrev := 1;
  n := 0;
  for i := 2 to length(s) do
    if s[i] = ' ' then begin
         if s[i-1]<>' ' then begin
            inc(n);
            arrWords[n] := Copy(s,iPrev, i-iPrev);
         end; 
         iPrev := i+1; 
      end;
 
  for i:=1 to n-1 do
    for j:=i+1 to n do
      if (Length(arrWords[i])=Length(arrWords[j])) and 
           (SortChars(arrWords[i]) = SortChars(arrWords[j])) 
        then WriteLn('Пара слов: ',arrWords[i],':',arrWords[j]);
 
end.