type pnod=^nod;
     nod=record
       lit:char;
       nrap:longint;                    // word
       t,f,fr:pnod;
     end;

var trie,p1,p2,nou:pnod;
    operatie,i:byte;
    k:longint;
    cuv:string;
    spatiu:char;


procedure test(p:pnod);
  begin
    if p<>nil then begin
      writeln(p^.lit,' ',p^.nrap);
      if p^.f<>nil then test(p^.f);
      if p^.fr<>nil then test(p^.fr);
    end;
  end;

procedure adauga;
  var ok,ok2,cont:boolean;
  begin
    p1:=trie;
    for i:=1 to length(cuv) do begin
      ok:=false;
      ok2:=false;
      p2:=p1;
      if p1^.f<>nil then begin
        ok2:=true;
        p1:=p1^.f;
        cont:=false;
        repeat
          if p1^.lit=cuv[i] then begin ok:=true; break; end;
          if p1^.fr=nil then cont:=true else p1:=p1^.fr;
        until cont;
      end;
      if ok=false then begin
        new(nou);
        nou^.lit:=cuv[i];
        nou^.t:=p2;
        nou^.f:=nil;
        nou^.nrap:=0;
        nou^.fr:=nil;
        if ok2 then
          p1^.fr:=nou
          else p2^.f:=nou;
        p1:=nou;
      end;
      if i=length(cuv) then p1^.nrap:=p1^.nrap+1;
    end;
  end;

procedure sterge;
  begin
    p1:=trie^.f;
    for i:=1 to length(cuv) do begin
     while p1^.lit<>cuv[i] do p1:=p1^.fr;
      if i<length(cuv) then p1:=p1^.f;
    end;
    if (p1^.nrap>1) or (p1^.f<>nil) then begin
      dec(p1^.nrap);
      exit;
    end;
    while (p1^.t^.f=p1) and (p1^.fr=nil) and (p1^.nrap=0) do begin
      p2:=p1;
      p1:=p1^.t;
      p1^.f:=nil;
      dispose(p2);
    end;
    if p1^.nrap=0 then
    if p1<>trie then begin
      if p1^.t^.f=p1 then begin
        p1^.t^.f:=p1^.fr;
        dispose(p1);
      end else begin
        p2:=p1^.t^.f;
        while p2^.fr<>p1 do p2:=p2^.fr;
        if p1^.fr=nil then begin
            dispose(p1);
            p2^.fr:=nil;
          end else begin
            p2^.fr:=p1^.fr;
            dispose(p1);
          end;
      end;
    end;
  end;

procedure prefixcomun;
  var k:byte;
  begin
    k:=0;
    p1:=trie^.f;
    while (p1<>nil) and (k<length(cuv)) do begin
      while p1<>nil do begin
        if p1^.lit=cuv[k+1] then break;
        p1:=p1^.fr;
      end;
      if p1<>nil then begin
        p1:=p1^.f;
        k:=k+1;
      end;
    end;
    writeln(k);
  end;

procedure nraparitii;
  var k:byte;
  begin
    k:=0;
    p1:=trie^.f;
    while p1<>nil do begin
      while p1<>nil do begin
        if p1^.lit=cuv[k+1] then break;
        p1:=p1^.fr;
      end;
      if p1<>nil then begin
        if k=length(cuv)-1 then break;
        p1:=p1^.f;
        k:=k+1;
      end;
    end;
    if p1<>nil then writeln(p1^.nrap) else writeln(0);
  end;

begin
  assign(input,'trie.in');
  reset(input);
  assign(output,'trie.out');
  rewrite(output);

  new(trie);
  trie^.f:=nil;
  trie^.fr:=nil;
  while not eof do begin
    readln(operatie,spatiu,cuv);
    case operatie of
      0:adauga;
      1:sterge;
      2:nraparitii;
      3:prefixcomun;
    end;
  end;

  close(input);
  close(output);
end.