what is wrong?
var
    a:array[1..200] of string[8];
    b:string;
    ch:char;
    n,n1,n2,k,i,j,g,p,gg:integer;
begin
     n:=0; gg:=0;
     readln(b);
     p:=1;
     while b<>'#' do
     begin
          n:=n+1;
          a[n]:=b;
          readln(b);
     end;
     {$IFNDEF ONLINE_JUDGE}
     assign(input, 'input.txt');
     reset(input);
     assign(output, 'output.txt');
     rewrite(output);
     {$ENDIF}
     b:='';
     while not eof(input) do
     begin
          read(input,ch);
          if ch in ['a'..'z'] then b:=b+ch else
          begin
               k:=0;
               for i:=1 to n do
               begin
                    n1:=length(a[i]); n2:=length(b);
                    if n1=n2 then
                    begin
                         g:=0;
                         for j:=1 to n1 do if a[i][j]=b[j] then
                             begin
                                  g:=g+1;
                             end;
                         if g=n1-1 then
                                   begin
                                        b:=a[i];
                                        write(output,b);
                                        if p<>1 then write(output,ch);
                                        k:=1; gg:=gg+1;
                                   end;
                    end;
               end;
               if k=0 then write(output,b,ch);
               b:='';
               p:=2;
          end;
     end;
     writeln(output);
     write(output,gg);
     {$IFNDEF ONLINE_JUDGE}
     close(input);
     close(output);
     {$ENDIF}
end.