Множества, ребус

uses crt;
type mn=set of 0..9;
var digit, p,h,e,l,k,a:0..9;
i,n1,n2:integer;
s1,s2:mn;
f:boolean;
 
procedure print(x,y:integer);
begin
writeln (x,'*',7,'=',y);
end;
 
begin
s1:=[];
p:=1;
for i:=1 to 4 do
if not(h in s1) then
begin
s1:=s1+[h];
for e:=1 to 4 do
if not (e in s1) then
begin
s1:=s1+[e];
for l:=0 to 9 do
if not(l in s1) then
begin
s1:=s1+[l];
for k:=0 to 9 do
if not(k in s1) then
begin
s1:=s1+[k];
for a:=0 to 9 do
if not(a in s1) then
begin
s1:=s1+[a];
n1:=100000*p+10000*h+1000*e+100*l+10*k+a;
n1:=7*n1;
f:=true;
s2:=[];
for i:=1 to 7 do
begin
digit:=n2 mod 10;
n2:=n2 div 10;
f:=f and not(digit in s2);
s2:=[digit]+s2;
end;
if (s1*s2=[]) and f then print(n1,7*n1);
s1:=s1-[a];
end;
s1:=s1-[k];
end;
s1:=s1-[l];
end;
s1:=s1-[e];
end;
s1:=s1-[h];
end;
s1:=s1-[p];
end.

{
  PHELKA*7=JJJJJJ
}
uses crt;
 
var
  p, h, e, l, k, a, j: 0 .. 9;
 
  dig : set of 0..9;
  sum, jjjjjj: longint;
 
begin
  clrscr;
  for p:=1 to 9 do begin
    include(dig,p);
    for h:=0 to 9 do if not (h in dig) then begin
      include(dig,h);
      for e:=0 to 9 do if not (e in dig) then begin
        include(dig,e);
        for l:=0 to 9 do if not (l in dig) then begin
          include(dig,l);
          for k:=0 to 9 do if not (k in dig) then begin
            include(dig,k);
            for a:=0 to 9 do if not (a in dig) then begin
              include(dig,a);
              for j:=0 to 9 do if not (j in dig) then begin
                include(dig,j);
 
    sum := p*100000 + h*10000 + e*1000 + l*100 + k*10 + a;
    jjjjjj := 100000*j + 10000*j + 1000*j + 100*j + 10*j + j;
 
    if 7*sum = jjjjjj then
      writeln(p,h,e,l,k,a,'*7=', j,j,j,j,j,j);
 
                exclude(dig,j);
              end;
              exclude(dig,a);
            end;
            exclude(dig,k);
          end;
          exclude(dig,l);
        end;
        exclude(dig,e);
      end;
      exclude(dig,h);
    end;
    exclude(dig,p);
  end;
end.

var
  j, sum, count : integer;
  s : set of 0 .. 9;
begin
  for j := 0 to 9 do
  begin
    if 111111*j mod 7 > 0 then continue;
 
    s := [];
    sum := (111111 * j) div 7;
    count := 0;
    while sum > 0 do
    begin
      if not ((sum mod 10) in s) then Inc(count);
      s := s + [sum mod 10];
      sum := sum div 10;
    end;
    if count = 6 then writeln(111111*j div 7, '*7=', 111111*j);
  end;
 
end.

var q:int64;j,i:integer;z:Boolean;
aa:array[0..9] of integer;ss:array[1..6] of integer;
begin
for j:=1 to 9 do begin
  for i:=0 to 9 do aa[i]:=0;
  q:=round((j*100000+j*10000+j*1000+j*100+j*10+j)/7);
  ss[1]:=q div 100000;
  ss[2]:=q div 10000-10*ss[1];
  ss[3]:=q div 1000-100*ss[1]-10*ss[2];
  ss[4]:=q div 100-1000*ss[1]-100*ss[2]-10*ss[3];
  ss[5]:=q div 10-10000*ss[1]-1000*ss[2]-100*ss[3]-10*ss[4];
  ss[6]:=q mod 10;
  for i:=1 to 6 do aa[ss[i]]:=aa[ss[i]]+1;
  z:=True;
  for i:=0 to 9 do if aa[i]>1 then z:=False;
  if ((z) and (ss[1]>0)) then if aa[j]=0 then write(j,j,j,j,j,j);
end;
end.