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

var s:array[1..100] of string;
    a:string;
    l,n,j,e,i:integer;
    k: longint;
 
procedure generate (l,r:integer; var e:integer);
var i:integer;
v:string;
begin
if (l=r) then
  begin
    for i:=1 to e do write(s[i],' ');
    writeln;
    k:=k+1;
  end
else
  begin
    for i := l to r do
      begin
        v:=s[l]; s[l]:=s[i]; s[i]:=v;
        generate(l+1,r,k);
        v:=s[l]; s[l]:=s[i]; s[i]:=v;
      end;
  end;
end;
 
begin
readln(a);
e:=1;
for i:=1 to length(a) do begin
if a[i]<>' ' then s[e]:=s[e]+a[i];
if (a[i]=' ')and(a[i-1]<>' ')and(a[i+1]<>' ') then e:=e+1;
end;
generate(l,n,k);
end.

uses crt;
var s:array[1..100] of string;
    a:string;
    n,j,i:integer;
    k: longint;
procedure generate (l,r:integer; var k:integer);
var i:integer;
    v:string;
begin
if (l=r) then
  begin
    for i:=1 to n do write(s[i],' ');
    writeln;
    k:=k+1;
  end
else
  begin
    for i := l to r do
      begin
        v:=s[l]; s[l]:=s[i]; s[i]:=v;
        generate(l+1,r,k);
        v:=s[l]; s[l]:=s[i]; s[i]:=v;
      end;
  end;
end;
 
begin
readln(a);
writeln('Перестановки:');
n:=1;
for i:=1 to length(a) do begin
if a[i]<>' ' then s[n]:=s[n]+a[i]
else n:=n+1;
end;
generate(1,n,k);
write('Количество перестановок=',k);
end.