Разработать программу, которая находит все разбиения заданного числа

uses crt;
type Razb=array [byte] of byte;
var N,i,L:byte;
    X:Razb;
procedure Next(var X:Razb;var L:byte);
var i,j:byte;
    s:word;
begin
i:=L-1;
s:=X[L];
{поиск i}
while (i>1)and(X[i-1]<=X[i]) do
 begin
  s:=s+X[i];
  dec(i)
 end;
inc(X[i]);
L:=i+s-1;
for j:=i+1 to L do X[j]:=1
end;
begin
write('N=');readln(N);
L:=N;
for i:=1 to L do
X[i]:=1;
for i:=1 to L do
write(X[i]);
writeln;
repeat
Next(X,L);
for i:=1 to L do write(X[i]);
writeln
until L=1
end.

uses crt;
var  n,i: byte;
     c: array[1..100] of byte;
     print: boolean;
     diapazon: set of byte;
 
procedure find(num,k,len: byte);
var i: byte;
begin
  if num=0 then
   begin
    print := true;
    for i := 1 to pred(len) do
      if not (c[i] in diapazon) then print := false
      else
       begin
        for i := 2 to pred(len) do
          if c[i - 1] = c[i] then print := false;
       end;
    if print then
     begin
      for i:=1 to len-1 do write(c[i],' ');
      writeln
     end;
  end
  else
   begin
    for i:=1 to k do
      if num-i>=0 then
       begin
        c[len]:=i;
        find(num-i,i,len+1);
      end;
  end;
end;
 
begin
  write('n=');
  read(n);
  for i := 1 to pred(n) do
    diapazon := diapazon + [i];
  find(n,n,1);
end.