По ключевому слову отыскать абзац в тексте и напечатать его

VAR
f,f2,f3:Text;
S,Sx,Sy:String;
i:Integer;
b:boolean;
BEGIN
Assign(f,'file2.txt');
ReSet(f);
Assign(f2,'file1.txt');
ReWrite(f2);
WriteLn('Enter the word:');
ReadLn(Sx);
REPEAT
ReadLn(f,S);
 
b:=false;
for i:=1 to Length(S)-Length(Sx) do
if S[i]=Sx[1] then
begin
Sy:=Copy(S,i,Length(Sx));
if Sx=Sy then b:=true;
end;
If b then
WriteLn(f2,S);
 
UNTIL EoF(f);
 
 
Close(f);
 
Close(f2);
reset(f2);
while Not EOF(f2) DO
begin
READLN(f2,s);
WRITELN(s);
if s[1]<>' ' then 
delete(s,i,length(sx));
end;
close(f2);
END.

function poisk(var f:text; var n:integer):string;
var i:integer;
s,y:string;
 
begin
i:=0;
while not eof(f) do begin
inc(i);
readln(f,s);
if i=n then
poisk:=s;
 
end;
end;
procedure writeabz(var f:text; sx:string);
var s:string;
begin
while not eof(f) do
begin
readln(f,s);
if pos(sx,s)>0 then
if s[1]=' ' then
if s[2]=' ' then
writeln(s);
end;
end;
 
procedure showfile(var f:text);
var 
s:string;
i:integer;
begin
i:=0;
while not eof(f) do begin
inc(i);
readln(f,S);
writeln(i,'.',S);
end;
end;
var f,f1,f2:text;
y,abz,s:string;
n,i:integer;
 
begin
assign(f,'file3.txt');
assign(f1,'file1.txt');
assign(f2,'file2.txt');
reset(f2);
rewrite(f1);
reset(f);
showfile(f);
close(f);
reset(f);
readln(n);
y:=poisk(f,n);
writeln;
writeabz(f2,y);
end.