Cod sursa(job #138348)

Utilizator free2infiltrateNezbeda Harald free2infiltrate Data 18 februarie 2008 13:09:23
Problema Abc2 Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.83 kb
program abc;
var txt : array [1..100000] of string[1];
    S : string[20];
    A : array [1..50000] of string[20];
    f : text;
    i,j,n,m,Su,l : longint;
    ok,ok2 : boolean;
begin
assign(f,'abc2.in');
reset(f);
n := 0;
Su := 0;
while not eoln(f) do begin
inc(n);
read(f,txt[n]);
end;

readln(f);
l := 0;
while not eof(f) do begin
readln(f,S);
inc(l);
A[l] := S;

ok2 := true;
for i := 1 to l-1 do
if A[i]=S then begin
               ok2 := false;
               break;
               end;

if ok2 then
for i := 0 to n-length(S) do begin
ok := true;
for j := 1 to length(S) do
if txt[i+j]<>S[j] then begin
                       ok := false;
                       break;
                       end;
if ok then inc(Su);

end;
end;
close(f);
assign(f,'abc2.out');
rewrite(f);
write(f,Su);
close(f);
end.