Program virus;
        uses crt;
        type
            sp=^spisak;
            spisak=record
                         inf:array[1..200] of string;
                         link:sp;
                         br:integer;
            end;
        var a:sp;
            f:text;
            buf:array[1..200] of string;
            d:integer;
procedure createsp(var a:text;var b:sp);
          var q,r:sp;
              i,x:integer;
          begin
               reset(a);
               read(a,x);
               writeln(x);
               readln(a);
               new(b);
               i:=0;
               while not eoln(a) do
                     begin
                          inc(i);
                          read(a,b^.inf[i]);
                     end;
               readln(a);
               b^.br:=i;
               b^.link:=nil;
               r:=b;
               while not eof(a) do
                     begin
                          i:=0;
                          new(q);
                          while not eoln(a) do
                                begin
                                     inc(i);
                                     read(a,q^.inf[i]);
                                end;
                          q^.link:=r^.link;
                          r^.link:=q;
                          r:=q;
                          q^.br:=i;
                          readln(a);
                     end;
               close(a);
          end;
procedure try(var s1,s2:string);
          var i,j:integer;
              bl:boolean;
          begin
               i:=0;
               inc(d);
               while (i<>length(s1)) do
                     begin
                          inc(i);
                          for j:=1 to length(s2) do
                              begin
                                   if copy(s2,j,1)=copy(s1,i,1) then
                                      if copy(s2,j+1,1)=copy(s1,i+1,1) then
                                      begin
                                            buf[d]:=buf[d]+copy(s2,j,1);
                                            inc(i);
                                      end
                                      else if buf[d]<>'' then
                                              begin
                                                   buf[d]:=buf[d]+copy(s2,j,1);
                                                   inc(i);
                                               end;
                                   if buf[d]<>'' then bl:=true
                                   else bl:=false;
                              end;
                          if bl=true then inc(d);
                          if i>length(s1) then exit;
                   end;
          end;
procedure printsp(var a:sp);
          var q,m:sp;
              i,j:integer;
          begin
               q:=a;
               while q<>nil do
                     begin
                          for i:=1 to q^.br do
                          writeln(q^.inf[i]);
                          q:=q^.link;
                     end;
               q:=a;
               while q<>nil do
                     begin
                          m:=q^.link;
                          while m<>nil do
                                begin
                                     for i:=1 to q^.br do
                                     for j:=1 to m^.br do try(q^.inf[i],m^.inf[j]);
                                     m:=m^.link;
                                end;
                          q:=q^.link;
                     end;
          end;
function finally:string;
          var i,j,max,m:integer;
              br:array[1..200] of integer;
          begin
               for i:=1 to d do br[i]:=0;
               for i:=1 to d do
                   for j:=i+1 to d do
                       begin
                            if (buf[i]=buf[j])and(buf[i]<>'') then
                               begin
                                    inc(br[i]);
                                    buf[j]:='';
                               end;
                       end;
               max:=br[1];
               for i:=2 to d do
                        begin
                             if br[i]>max then
                                begin
                                max:=br[i];
                                m:=i;
                                end;
                        end;
               finally:=buf[m];
          end;
procedure disposesp(var a:sp);
          var temp:sp;
          begin
               while a<>nil do
                     begin
                          temp:=a;
                          a:=a^.link;
                          dispose(temp);
                     end;
          end;
begin
     clrscr;
     d:=1;
     writeln('IN');
     writeln;
     assign(f,'c:\a_37\virus.inp');
     createsp(f,a);
     printsp(a);
     writeln;
     writeln('OUT');
     writeln;
     writeln(finally);
     disposesp(a);
     readln;
end.
