...又是TLE，对于单组数据肯定TLE不了，问题是多组的时候就呵呵了...

按height分组去搞，然后判一下是否不属于同一个串...

const maxn=100419;var x,y,rank,sa,c,col,h,rec:array[0..maxn] of longint; pd:array[0..maxn] of boolean; s:ansistring; n,k,maxlen,cnta:longint;function max(x,y:longint):longint; begin if x>y then exit(x) else exit(y); end;function min(x,y:longint):longint; begin if x
     
      x[sa[i-1]]) or (x[sa[i]+p]<>x[sa[i-1]+p]) then inc(tot);     rank[sa[i]]:=tot;    end;   p:=p<<1;  end; for i:= 1 to n do sa[rank[i]]:=i;end;procedure makeh;var i,p,j:longint;begin p:=0; h[1]:=0; for i:= 1 to n do  begin   p:=max(p-1,0);   if rank[i]=1 then continue;   j:=sa[rank[i]-1];   while (j+p<=n) and (i+p<=n) and (s[i+p]=s[j+p]) do inc(p);   h[rank[i]]:=p;  end;end;procedure init;var i,j,tot:longint; s1:ansistring;begin k:=n>>1; readln(s); tot:=1; maxlen:=length(s); for i:= 1 to maxlen do col[i]:=1; for i:= 2 to n do  begin   readln(s1);   s:=s+'#';   maxlen:=max(length(s1),maxlen);   inc(tot);   for j:= length(s)+1 to length(s)+length(s1) do col[j]:=tot;   s:=s+s1;  end; n:=length(s); fillchar(c,sizeof(c),0); for i:= 1 to n do x[i]:=ord(s[i]); for i:= 1 to n do inc(c[x[i]]); for i:= 1 to 128 do inc(c[i],c[i-1]); for i:= 1 to n do  begin   sa[c[x[i]]]:=i;   dec(c[x[i]]);  end; tot:=1; rank[sa[1]]:=1; for i:= 2 to n do  begin   if x[sa[i]]<>x[sa[i-1]] then inc(tot);   rank[sa[i]]:=tot;  end; make; makeh;end;function check(x:longint):boolean;var i,j,tot,cnt:longint;begin fillchar(pd,sizeof(pd),false); pd[0]:=true; tot:=0; cnt:=0; if not pd[sa[1]] then inc(tot); pd[sa[1]]:=true; for i:= 2 to n do  begin   if h[i]
      
       k then      begin       inc(cnt);       rec[cnt]:=i-1;      end;     tot:=0;     fillchar(pd,sizeof(pd),false);     pd[0]:=true;    end;   if not pd[col[sa[i]]] then inc(tot);   pd[col[sa[i]]]:=true;  end; if tot>k then  begin   inc(cnt);   rec[cnt]:=i-1;  end; if cnt>0 then  begin   cnta:=cnt;   exit(true);  end; exit(false);end;procedure qsort(l,r:longint);var i,j,mid,tmp:longint;begin if l>r then exit; i:=l; j:=r; mid:=rec[l+random(r-l+1)]; repeat  while rec[i]
       
        mid do dec(j);  if i<=j then   begin    swap(i,j);    inc(i); dec(j);   end; until i>j; qsort(i,r); qsort(l,j);end;procedure solve;var l,r,mid,tot,ans,i,j:longint;begin l:=1; r:=maxlen;  ans:=0; while l<=r do  begin   mid:=(l+r)>>1;   if check(mid) then    begin     ans:=mid;     l:=mid+1;    end   else r:=mid-1;  end; fillchar(pd,sizeof(pd),false); if ans=0 then  begin   writeln('?');   exit;  end; qsort(1,cnta); for i:= 1 to cnta do writeln(copy(s,sa[rec[i]],ans));end;Begin readln(n); while n<>0 do  begin   init;   solve;   writeln;   readln(n);  end;End.