program test;
 var a:array[1..100] of string[10];
     str:string;
     count:longint;
     ch:char;
     errors:longint;
     wordstr:string;
 function like(stra,strb:string):boolean;
  var i:integer;
      h:integer;
   begin
     like:=false;
     if length(stra)=length(strb) then begin
       i:=1; h:=0;
       while (i<=length(stra))and(h<=1) do begin
         if stra[i]<>strb[i] then inc(h);
         inc(i);
       end;
       if h=1 then like:=true;
     end;
   end;

 function check(var str:string):boolean;
  var i:integer;
   begin
    check:=false;
    for i:=1 to count do
      if like(str,a[i]) then begin str:=a[i]; check:=true; break;
end;
     end;


    begin
   count:=0;
   readln(str);
   while str<>'#' do begin
     inc(count);
     a[count]:=str;
     readln(str);
   end;
   wordstr:='';
   errors:=0;
   while not eof do begin
     read(ch);
     if ch in ['a'..'z'] then wordstr:=wordstr+ch
     else begin
              if check(wordstr) then inc(errors);
             write(wordstr);
             wordstr:='';
             write(ch);
         end;
   end;
   writeln(errors);
    end.

Please don't post your solution here.

This code is NOT AC anyway;)
It requires two lines to get it.