My program:

Program t1127;

Const P:array[1..24,1..6]of integer= {all combinations}
       ( (6,4,3,1,5,2),
         (3,5,4,1,6,2),
         (4,6,5,1,3,2),
         (5,3,6,1,4,2),
         (6,4,5,2,3,1),
         (3,5,6,2,4,1),
         (4,6,3,2,5,1),
         (5,3,4,2,6,1),
         (1,2,6,3,4,5),
         (6,4,2,3,1,5),
         (2,1,4,3,6,5),
         (4,6,1,3,2,5),
         (1,2,4,5,6,3),
         (6,4,1,5,2,3),
         (2,1,6,5,4,3),
         (4,6,2,5,1,3),
         (1,2,3,4,5,6),
         (3,5,2,4,1,6),
         (2,1,5,4,3,6),
         (5,3,1,4,2,6),
         (1,2,5,6,3,4),
         (3,5,1,6,2,4),
         (2,1,3,6,5,4),
         (5,3,2,6,1,4)  );
   MaxN=1000;

Var Cube      :array[1..MaxN,1..6]of char;
    Tmp       :array[1..6]of char;
    ACube     :array[1..MaxN,1..24]of string[4];
    yet       :array[1..MaxN,1..24]of boolean;
    N,i,j,k   :integer;
    max,ik,jk :integer;
    m         :integer;
    ch        :char;

begin
Read(n);
for i:=1 to N do
 for j:=1 to 6 do begin
  read(ch);
  while (ch=#10)or(ch=#13)or(ch=#32) do read(ch);
  Cube[i,j]:=ch;
 end;
for i:=1 to N do
 for j:=1 to 24 do begin
  for k:=1 to 6 do tmp[k]:=cube[i,p[j,k]];
  ACube[i,j]:='';
  ACube[i,j]:=tmp[1]+tmp[2]+tmp[3]+tmp[4];
 end;
m:=0;
for i:=1 to N do
 for j:=1 to 24 do
  yet[i,j]:=true;
for i:=1 to N do
 for j:=1 to 24 do if yet[i,j] then begin
  yet[i,j]:=false;
  max:=1;
  for ik:=1 to N do if ik<>i then
   for jk:=1 to 24 do
    if ((acube[i,j][1]=acube[ik,jk][1])and(acube[i,j][4]=acube[ik,jk]
[4]))or
       ((acube[i,j][1]=acube[ik,jk][4])and(acube[i,j][4]=acube[ik,jk]
[1])) then
    if ((acube[i,j][2]=acube[ik,jk][2])and(acube[i,j][3]=acube[ik,jk]
[3]))or
       ((acube[i,j][2]=acube[ik,jk][3])and(acube[i,j][3]=acube[ik,jk]
[2]))
       then begin
     yet[ik,jk]:=false;
     max:=max+1;
     break;
    end;
  if max>m then m:=max;
 end;
writeln(m);
end.