Ребус (Дома*5=Улицы)

const d=10;
var b,l,o,k,s,t,e,n,a,p1,p2,p3,p4,p5,pr,blok:integer;
stena:longint;
begin
for k:=1 to 9 do
if (k<>5)and(k<>0)
then
begin
pr:=k*7 div d;
a:=k*7 mod d;
for o:=0 to 9 do
if (o<>a)and(o<>k) then
begin
p1:=o*7+pr;
p2:=p1 div d;
n:=p1 mod d;
if (n<>o)and(n<>a)and(n<>k) then
for l:=0 to 9 do
if (l<>n)and(l<>o)and(l<>k)and(l<>a) then
begin
p3:=l*7+p2;
p4:=p3 div d;
e:=p3 mod d;
if (e<>l)and(e<>o)and(e<>n)and(e<>k)and(e<>a) then
for b:=1 to 9 do
if (b<>e)and(b<>l)and(b<>o)and(b<>n)and(b<>k)and(b<>a) then
begin
p5:=b*7+p4;
s:=p5 div d;
t:=p5 mod d;
if (t<>b)and(t<>l)and(t<>e)and(t<>o)and(t<>k)and(t<>a)and(t<>n)and(s<>t)and(s<>e)and(s<>n)and(s<>a)and(s<>b)and(s<>l)and(s<>o)and(s<>k)and(s<7) then
begin
blok:=b*1000+l*100+o*d+k;
stena:=s*10000+t*1000+e*100+n*d+a;
writeln(blok,'*7=',stena);
end;
end;
end;
end;
end;
readln;
end.

var d, o, m, a, i, j: byte;
    ul, max, t, x, s: integer;
    p: set of byte;
    arr: array [1..60] of integer;
begin
  max := 0;
  i := 0;
  j := 1;
  for d := 2 to 9 do
    for o := 0 to 9 do
      begin
        if d = o then continue;
        for m := 0 to 9 do
          begin
            if (d = m) or (o = m) then continue;
            for a := 0 to 9 do
              begin
                if (d = a) or (o = a) or (m = a) then continue;
                x := 1000 * d + 100 * o + 10 * m + a;
                ul := 5 * x;
                s := 0;
                p := [];
                while ul > 0 do
                  begin
                    t := ul mod 10;
                    if (t in p) or (d = t) or (o = t) or (m = t) or (a = t) then break;
                    s := s + t;
                    p := p + [t];
                    ul := ul div 10
                  end;
                if ul > 0 then continue;
                write(x, '*5=', 5 * x, ' ');
                inc(i);
                if i > 5
                  then begin
                    i := 0;
                    writeln
                  end;
                if s = max
                  then begin
                    inc(j);
                    arr[j] := x;
                  end
                  else if s > max
                    then begin
                      j := 1;
                      arr[1] := x;
                      max := s
                    end
              end
          end
      end;
  writeln;
  writeln('The maximum sum of digits of result = ', max, ' in the following sets:');
  for i := 1 to j do writeln(arr[i], '*5=', arr[i] * 5);
  readln
end.