Cod sursa(job #291159)

Utilizator igiatAdnrei Ig. igiat Data 29 martie 2009 14:27:56
Problema Abc2 Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.03 kb
program antic;
type mult=string[200];
var f,g:text;
    cuv:array[1..10000] of integer;
    ok,qw:boolean;
    u,i,j,cuvv,l:integer;
    s,a:string;
    off:array[1..200] of mult;
begin
assign(f,'abc2.in');reset(f);
assign(g,'abc2.out');rewrite(g);
readln(f,s);
cuvv:=0;
repeat
readln(f,a);
ok:=false;
inc(u);
cuv[u]:=0;
qw:=true;
for i:=1 to u do
    if a=off[i] then qw:=false;
off[u]:=a;
if qw=true then for i:=1 to (length(s)-length(a)+1) do
                           if a[1]=s[i] then for j:=i to (i+length(a)-1) do
                              begin
                               if j=i then begin cuv[u]:=0; l:=0; end;
                               inc(l);
                               ok:=true;
                               if a[l]=s[j] then inc(cuv[u])
                                         else break;
                               if (j=i+length(a)-1)and(ok=true)and(cuv[u]=length(a)) then inc(cuvv);
                              end;
until eof(f);
writeln(g,cuvv);
close(f);
close(g);
end.