Cod sursa(job #102718)

Utilizator borsosborsos adrian borsos Data 14 noiembrie 2007 17:43:32
Problema Abc2 Scor 0
Compilator fpc Status done
Runda Happy Coding 2007 Marime 1.33 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:='';
          if a[i+1] = cuvant[2] then begin
          for j := i to i+length(cuvant)-1 do cuvant2:=cuvant2+a[j];
          if cuvant = cuvant2 then begin
                                   inc(nrpoz);
                                   i:=i+ length(cuvant);
                                   end else
                                   inc(i);
                                       end else inc(i);

                                          end;
                    end;
                 end;
writeln(g,nrpoz);
close(f);
close(g);
end.