Требуется написать программу, определяющую, можно ли выполнить данное задание

Var f,g:text;
    A,B:array[0..255] of byte;//здесь будет хранится кол-во вхождений каждой буквы
    s:string;
    c:boolean;
    i:byte;
Begin
    Assign(f,'b.in');Reset(f);
    Assign(g,'b.out');Rewrite(g);
    readln(f,s);
    For i:=1 to Length(s) do
     inc(A[ord(s[i])]);//заносим в массив A кол-во вхождений каждого символа 1-ой строки
    While not Eof(f) do
     Begin
      readln(f,s);//считываем очередную строку из файла
      c:=true;//препологаем что из строки S можно получить строку T
      For i:=0 to 255 do
       B[i]:=0;//обнуляем массив B
      For i:=1 to Length(s) do //от начала до конца строки проходимся
       inc(B[ord(s[i])]);//заносим в массив B кол-во вхождений каждого символа строки T
      For i:=1 to Length(s) do
       if not (A[ord(s[i])]>=B[ord(s[i])]) then 
       //если кол-во входящих в строку S символов меньше чем кол-во входящих 
       //в строку T то значит нельзя получить строку T из S                                                                                                               
        c:=false;
      if c then writeln(g,s+'Yes') //если наше преположение осталось истинным то записываем строку и Yes
       else writeln(g,s+'No'); //иначе строка+No
     End;
     writeln('Результаты записаны в b.out');
     Close(f);Close(g);
     readln;
End.

var
  s, t: string;
  i, j, k: integer;
  f, h: text;
 
begin
  assign(f, 'b.in');
  assign(h, 'b.out');
  reset(f);
  rewrite(h);  
  readln(f, s);
  for k := 1 to 8 do 
  begin
    readln(f, t);
    j := 1; i := 0;        
    repeat
      inc(i);
      if s[i] = t[j] then inc(j)
    until (j > length(t)) or (i = length(s));    
    if j > length(t) then writeln(h, 'yes') else writeln(h, 'no')
  end;
  close(f); close(h);  
end.