Решить ребус: "USSR+USA=РЕАСЕ"

var
  m: set of byte;
  u,s,r,a,p,e,c: integer;
  begin
  m := [];
  for u := 1 to 6 do
    if not (u in m) then
    begin
      Include(m, u);
      for s := 0 to 6 do
        if not (s in m) then
        begin
          Include(m, s);
          for r := 1 to 6 do
            if not (r in m) then
            begin
              Include(m, r);
              for a := 0 to 6 do
                if not (a in m) then
                begin
                  Include(m, a);
                  for p := 0 to 6 do
                    if not (p in m) then
                    begin
                      Include(m, p);
                      for e := 0 to 6 do
                        if not (e in m) then
                        begin
                          Include(m, e);
                          for c := 1 to 6 do
                            if not (c in m) then
                            begin
                            Include(m, c);
                                          if u * 1000 + s * 100 + s * 10 + r +
                                             u * 100 + s * 10 + a = 
                                             p * 10000 + e * 1000 + a * 100 + c * 10 + e then
                                            WriteLn(u, s, s, r, ' + ', u, s, a, ' = ', p, e, a, c, e);
                                          Exclude(m, c)
                                        end;
                                      Exclude(m, e);
                                    end;
                                  Exclude(m, a);
                                end;
                              Exclude(m, u)
                            end;
                          Exclude(m, s)
                        end;
                      Exclude(m, r)
                    end;
                  Exclude(m, p)
                end;
              
  WriteLn('Программа завершена');
end.

var
  m: set of byte;
  u,s,r,a,p,e,c: integer;
  begin
  m := [];
  for u := 1 to 6 do
    if not (u in m) then
    begin
      Include(m, u);
      for s := 0 to 6 do
        if not (s in m) then
        begin
          Include(m, s);
          for r := 0 to 6 do
            if not (r in m) then
            begin
              Include(m, r);
              for a := 0 to 6 do
                if not (a in m) then
                begin
                  Include(m, a);
                  for p := 1 to 6 do
                    if not (p in m) then
                    begin
                      Include(m, p);
                      for e := 0 to 6 do
                        if not (e in m) then
                        begin
                          Include(m, e);
                          for c := 0 to 6 do
                            if not (c in m) then
                            begin
                            Include(m, c);
                                          if u * 1000 + s * 100 + s * 10 + r +
                                             u * 100 + s * 10 + a = 
                                             p * 10000 + e * 1000 + a * 100 + c * 10 + e then
                                            WriteLn(u, s, s, r, ' + ', u, s, a, ' = ', p, e, a, c, e);
                                          Exclude(m, c)
                                        end;
                                      Exclude(m, e);
                                    end;
                                  Exclude(m, p);
                                end;
                              Exclude(m, a)
                            end;
                          Exclude(m, r)
                        end;
                      Exclude(m, s)
                    end;
                  Exclude(m, u)
                  end;
              end.