Cod sursa(job #98632)

Utilizator claudiu_syclaudiu claudiu_sy Data 10 noiembrie 2007 15:19:15
Problema Abc2 Scor 0
Compilator fpc Status done
Runda Happy Coding 2007 Marime 0.73 kb
var s:array[1..10000] of char;
    k:array[1..10000] of integer;
    s1:string;
    i,j,n,x,sum:longint;
    f,g:text;
procedure test(a:string;l:integer);
var ok:boolean;
begin
k[x]:=0;
for i:=1 to n-l do
    begin
    OK:=true;
    for j:=i to i+l-1 do
        if s[j]<>s1[j-i+1] then
           ok:=false;
    if ok=true then
       k[x]:=k[x]+1;
    end;
end;
begin
assign(f,'abc.in');
assign(g,'abc.out');
reset(f);
rewrite(g);
n:=1;
repeat
      read(f,s[n]);
     n:=n+1;
until (eoln(f));
x:=1;
readln(f);
while not(eof(f)) do
      begin
      readln(f,s1);
      test(s1,length(s1));
      x:=x+1;
      end;
sum:=0;
for i:=1 to x do
    sum:=sum+k[i];
writeln(g,sum);
close(f);
close(g);
end.