Задание из методички на динамические массивы.

Type
 IntArray = Array Of Integer;
 
Function GetDigits(n: Integer): IntArray;
Var
 x: IntArray;
Begin
 While (n <> 0) Do
  Begin
   SetLength(x, Length(x)+1);
   x[Length(x)-1] := n Mod 10;
   n := n Div 10;
  End;
 GetDigits := x;
End;
 
Function Kras(x: Integer): Boolean;
Var
j: Array[1..1000000] Of Integer;
jk, mm, summ, ii, jj: Integer;
 y: IntArray;
Begin
 summ := 0;
 jk := 1;
   y := GetDigits(x);
  For ii := Length(y)-1 DownTo 0 Do
   Begin
    j[jk] :=  y[ii];
    Inc(jk);
   End;
  For jj := 1 To jk-1 Do
   Begin
    For mm := jj+1 To jk Do
     Begin
      If (j[jj] = j[mm]) Then
      Begin
       Inc(summ);
      End;
     End;
    End;
 If summ = 0 Then
  Begin
   Kras := TRUE;
  End
 Else
  Begin
   Kras := FALSE;
  End;
End;
 
 
 
Var
 i: Array[1..100000] Of Integer;
 k, k1, l, gg: Integer;
Begin
 Read(k);
 For gg := 1 To 10000 Do
  i[gg] := gg;
 k1 := 0;
 l := 1;
 While (k1 <> k) Do
  Begin
   If Kras(i[l]) Then
    Begin
     Inc(k1);
    End;
   Inc(l);
  End;
 WriteLn(i[l]);
End.

Function Kras(x: Integer): Boolean;
Var
j: Array[1..100000] Of Integer;
jk, mm, summ, ii, jj: Integer;
 y: IntArray;
Begin
 summ := 0;
 jk := 1;
   y := GetDigits(x);
  For ii := Length(y)-1 DownTo 0 Do
   Begin
    j[jk] :=  y[ii];
    Inc(jk);
   End;
  For jj := 1 To jk-1 Do
    For mm := jj+1 To jk Do
      If (j[jj] = j[mm]) Then  Inc(summ);
 If summ = 0 Then Kras := TRUE
 Else  Kras := FALSE;
End;