Программа по массивам.

uses
  crt;
const
  a: array [1..4] of byte=(3,2,1,0);
var
  i,n,c: integer;
begin
  clrscr;
  for i:= 1 to 4 do
    write(a[i]);
  write(',');
  while a[1]<9 do
  begin
    inc(a[1]);
    for i:= 1 to 4 do
      write(a[i]);
    write(',');
  end;
  while a[2]<8 do
  begin
    inc(a[2]);
    for i:= 1 to 4 do
      write(a[i]);
    write(',');
  end;
  while a[3]<7 do
  begin
    inc(a[3]);
    for i:= 1 to 4 do
      write(a[i]);
    write(',');
  end;
  while a[4]<6 do
  begin
    inc(a[4]);
    for i:= 1 to 4 do
      write(a[i]);
    write(',');
  end;
  readkey;
end.

program xa;
uses
  crt;
var
  i,m,n,code:integer;
  s:string;
begin
  clrscr;
  for i:=3210 to 9876 do
  begin
    str(i,s);
    if (s[1]>s[2]) and (s[2]>s[3]) and (s[3]>s[4]) then
      Write(s, ' ');
  end;
  readln
end.

k:=0;
for i:=1 to length(s) do
if not s[i] in m then
  begin
   include(m,s[i]);
   k:=k+1;
 end;

program xa;
uses crt;
function Ubyv(n:word):boolean;
var s:string;
begin
str(n,s);
if (s[1]>s[2]) and (s[2]>s[3]) and (s[3]>s[4]) then
Ubyv:=true
else Ubyv:=false;
end;
var i:word;
begin
clrscr;
for i:=3210 to 9876 do
if Ubyv(i) then
Write(i, ' ');
readln
end.

function Ubyv(n:word):boolean;
var p,k:byte;
begin
p:=n mod 10;
n:=n div 10;
while n>0 do
 begin
  k:=n mod 10;
  if k<=p then
   begin
    Ubyv:=false;
    break;
   end
  else
   begin
    p:=k;
    n:=n div 10;
   end;
  end;
end;

function Ubyv(n:word):boolean;
var p,a,b,c,d:byte;
begin
a:=n div 1000;
b:= n div 100 mod 10;
c:=n div 10 mod 10;
d:=n mod 10;
p:=ord(b < a)+ord(c < b)+ord(d < c);
if p=3 then Ubyv:=true else Ubyv:=false;
end;