Напечатать все последовательности чисел длины N из определенных цифр

program Sequences_P_Backtracking;
      type Sequences=array [byte] of byte;
      var M,N,i:byte;
      X:Sequences;
      Yes:boolean;
      procedure Next(var X:Sequences;var Yes:boolean);
    var i:byte;
      begin
    i:=N;
    {поиск i}
    while (i>0)and(X[i]=M) do begin X[i]:=1;dec(i) end;
    if i>0 then begin inc(X[i]);Yes:=true end
    else Yes:=false
      end;
    begin
      write('M,N(кол-во цифр в числе)=');readln(M,N);
      for i:=1 to N do X[i]:=1;
      repeat
    for i:=1 to N do write(X[i]);writeln;
    Next(X,Yes)
      until not Yes
    end.

program Sequences_P_Backtracking;
 
type
  TSequences = array [byte] of byte;
  Ts = set of 0..9;
 
 
procedure Next(ss: Ts; NN,MM: byte; var XX:TSequences; var YesYes:boolean);
var
  i: byte;
begin
  i:= NN;
   {поиск i}
  while (i > 0)  and (XX[i] = MM) do
    begin
       repeat
          inc(XX[i]);
       until (XX[i] in ss);
      dec(i);
    end;
   if i > 0 then
     begin
       repeat
          inc(XX[i]);
       until (XX[i] in ss);
       YesYes:= true;
     end
    else
      YesYes:= false;
     end;
 
Function MaxValueSet(St: Ts): Byte;
{ Функция находит максимальный элемент во множестве и возвращает его }
var
  max: Byte;
  i: Byte;
Begin
max:= 0;
 for i:= 0 to 9 do
   if i in St then
     if i > max then
       max:= i ;
   MaxValueSet:= max;
End;
 
 
var
  M,N,i,a:byte;
  code: integer;
  X: TSequences;
  Yes:boolean;
  s: Ts;
  str: string;
  err: boolean;
begin
 
repeat
  err:= true;
  writeln('Введите цифры (от 0 до 9), которые вы хотите увидеть в перечислении ');
  writeln('Чтобы прекратить ввод введите слово "stop"');
  Readln(str);
  val(str,a,code);
    if (code <> 0) or (a > 9) then
      begin
        err:= false;
        if str = 'stop' then
          break;
        writeln('Некорректный ввод числа.');
      end;
 
  if err then
    Include(s,a);
  until false;
 
  M:= MaxValueSet(S);
  write('Количество разрядов в выводимых числах = ');
  readln(N);
  for i:= 1 to N do
       while not (X[i] in s) do
         begin
          inc(X[i]);
         end;
  repeat
    for i:= 1 to N do
      write(X[i]);
    writeln;
    Next(s,N,M,X,Yes);
  until not Yes;
Readln;
end.