Cod sursa(job #210586)

Utilizator FllorynMitu Florin Danut Flloryn Data 28 septembrie 2008 00:42:45
Problema Abc2 Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.77 kb
program pascal;
var f,g:text;
    s:array[1..10000000] of char;
    v:array[1..50000] of string[20];
    n,m,i,k,j,nr,t,q:longint;
    ok,bun:boolean;
    z:string;

begin
assign(f,'abc2.in'); reset(f);
assign(g,'abc2.out'); rewrite(g);

readln(f,s);
n:=1;
while (ord(s[n])<>0) do n:=n+1;
n:=n-1;

m:=0;
nr:=0;
while not eof(f) do
 begin
  m:=m+1;
  readln(f,v[m]);

  bun:=false;
  for t:=1 to m-1 do
   if v[t]=v[m] then
          begin
              bun:=true;
              break;
          end;

 if not bun then
 begin
  z:='';
  for i:=1 to length(v[m]) do  z:=z+s[i];

    for q:=i+1 to n+1 do
     begin
      if z=v[m] then nr:=nr+1;
      delete(z,1,1);
      z:=z+s[q];
     end;
  end;
end;

write(g,nr);
close(f);
close(g);
end.