AC自动机模板

P

var
        tt,n,i,tot:longint;
        next:array[0..300000,'a'..'z']of longint;
        en,fai:array[0..300000]of longint;
        o,zd:ansistring;
procedure insert(x:ansistring);
var
        len,i,now:longint;
begin
        len:=length(x);
        now:=1;
        for i:=1 to len do
        begin
                if next[now,x[i]]=0 then
                begin
                        inc(tot);
                        next[now,x[i]]:=tot;
                end;
                now:=next[now,x[i]];
        end;
        inc(en[now]);
end;
procedure build;
var
        i,h,t,temp,q,now:longint;
        w:array[0..300000]of longint;
        ch:char;
begin
        t:=1;
        h:=0;
        w[1]:=1; 
        while h<=t do
        begin
                inc(h);
                now:=w[h];
                for ch:='a' to 'z' do
                begin
                        if next[now,ch]<>0 then
                        begin
                                temp:=next[now,ch];
                                if now=1 then
                                        fai[temp]:=1
                                else
                                begin
                                        q:=fai[now];
                                        while q>0 do
                                        begin
                                                if next[q,ch]<>0 then
                                                begin
                                                        fai[temp]:=next[q,ch];
                                                        break;
                                                end;
                                                q:=fai[q];
                                        end;
                                        if q=0 then
                                                fai[temp]:=1;
                                end;
                                inc(t);
                                w[t]:=temp;
                        end;
                end;
        end;
end;
function find(s:ansistring):longint;
var
        i,x,temp,ans:longint;
        q:char;
begin
        x:=1;
        ans:=0;
        for i:=1 to length(s) do
        begin
                q:=s[i];
                while (next[x,q]=0)and(x<>1) do
                        x:=fai[x];
                x:=next[x,q];
                if x=0 then
                        x:=1;
                temp:=x;
                while temp<>1 do
                begin
                        ans:=ans+en[temp];
                        temp:=fai[temp];
                end;
        end;
        exit(ans);
end;
begin
        readln(tt);
        tot:=1;
        readln(n);
        for i:=1 to n do
        begin
                readln(o);
                insert(o);
        end;
        build;
        readln(zd);
        writeln(find(zd));
end.