Var
   f:text;
   S:string;
   C:char;
   i:integer;
Begin
Assign(f,'TextFile.txt');
Reset(f);
i:=1;
Repeat
While Not EOLN(f) do
   Begin
   Read(f,C);
   S:=S+C;
   End;
Write(S);
if Pos('яблоко',LowerCase(S))<>0 then Write(' 1');
if Pos('фрукт',LowerCase(S))<>0 then Write(' 2');
S:='';
if Not EOF(f) then
   Begin
   Read(f,C);
   Write(C);
   End;
Until EOF(f);
Close(f);
End.



Примечание: для работы программы необходимо, чтобы данный файл находился в одной папке с программой: