Cod sursa(job #102417)

Utilizator borsosborsos adrian borsos Data 14 noiembrie 2007 13:14:32
Problema Abc2 Scor 0
Compilator fpc Status done
Runda Happy Coding 2007 Marime 1.06 kb
var a:array[1..10000000] of char;
    kkt:array[1..50000] of string[20];
    cuvant,cuvant2:string[20];
    i,nrpoz,j,yy,aux:longint;
    f,g:text;
    ok:boolean;
begin
assign(f,'abc2.in'); reset(f);
assign(g,'abc2.out'); rewrite(g);
i:=0; nrpoz:=0;
while not eoln(f) do begin
                  inc(i);
                  read(f,a[i]);
                     end;
readln(f); yy:=i;aux:=0;
while not eof(f) do begin
          inc(aux);
          readln(f,kkt[aux]);

          ok:=true;
          for i := 1 to aux-1 do if kkt[aux] = kkt[i] then ok := false;
          cuvant:=kkt[aux];
      if not ok then aux:=aux-1 else
      if ok then begin
          i:=1;
       while i < (yy-length(cuvant)+1) do begin
          while a[i] <> cuvant[1] do inc(i);
          cuvant2:='';
          for j := i to i+length(cuvant)-1 do cuvant2:=cuvant2+a[j];
          if cuvant = cuvant2 then inc(nrpoz);
          inc(i);
                                          end;
                    end;
                 end;
writeln(g,nrpoz);
close(f);
close(g);
end.