program perestan;
uses Crt,WinDos;
var
b:array [1..10] of integer;
s,q6,q7,q8,q9,w,d2,d:longint;
z,i,ic:longint;
h,m,c,cc:word;
h1,m1,c1,cc1:word;
begin
clrscr;
s:=0;
GetTime(h,m,c,cc);
for i:=677788889 to 998888777 do
begin
ic:=i;
z:=1;
q6:=0; q7:=0; q8:=0; q9:=0;
for d:=1 to 9 do
begin
d2:=round(exp((9-d)*ln(10)));
b[d]:=ic div d2;
ic:=ic mod d2;
if b[d]<6 then
begin
for w:=d to 9 do
begin
z:=1;
if(q6<1) and (z<>0) then begin b[w]:=6; q6:=q6+1; z:=0; end;
if(q7<3) and (z<>0) then begin b[w]:=7; q7:=q7+1; z:=0; end;
if(q8<4) and (z<>0) then begin b[w]:=8; q8:=q8+1; z:=0; end;
if(q9<2) and (z<>0) then begin b[w]:=9; q9:=q9+1; z:=0; end;
d2:=round(exp((9-w)*ln(10)));
i:=i+b[w]*d2;
end;
if q6<1 then b[10]:=6;
if q7<3 then b[10]:=7;
if q8<4 then b[10]:=8;
if q9<2 then b[10]:=9;
d:=9;
end;
if b[d]=6 then q6:=q6+1;
if b[d]=7 then q7:=q7+1;
if b[d]=8 then q8:=q8+1;
if b[d]=9 then q9:=q9+1;
end;
if q6<1 then b[10]:=6;
if q7<3 then b[10]:=7;
if q8<4 then b[10]:=8;
if q9<2 then b[10]:=9;
q6:=0; q7:=0; q8:=0; q9:=0;
z:=1;
for w:=1 to 10 do
begin
if b[w]=6 then if q6<1 then q6:=q6+1 else begin w:=10; z:=0; end;
if b[w]=7 then if q7<3 then q7:=q7+1 else begin w:=10; z:=0; end;
if b[w]=8 then if q8<4 then q8:=q8+1 else begin w:=10; z:=0; end;
if b[w]=9 then if q9<2 then q9:=q9+1 else begin w:=10; z:=0; end;
end;
if z<>0 then
{ if (q6=1) and (q7=3) and (q8=4) and (q9=2) then}
begin
s:=s+1;
write(s,' - ');
for w:=1 to 10 do
write(b[w]);
writeln;
end;
end;
writeln;
writeln('End');
writeln;
GetTime(h1,m1,c1,cc1);
writeln('Время запуска программы: ',h,':',m,':',c,'.');
writeln('Время окончания программы: ',h1,':',m1,':',c1,'.');
readkey;
end. |
Не успел прогу запустить, а она уже закончилась... Конечно если вывод в файл перенаправиьть, а то на экран оно так быстро не успевает выводить... 
