Переписать текст в файл, удалив из него все слова, начинающиеся с той же буквы ,что и последнее слово последней строки

uses crt;
const rz=[' ','.',',','-','?','!'];{символы, разделители слов, можно добавить}
var f,g:file of string;
    s,s1:string;
    n,i,k,d,mx:byte;
    cp,c:char;
begin
clrscr;
assign(f,'input.dat');
rewrite(f);{создадим исходный файл}
assign(g,'output.dat');
rewrite(g);{создадим выходной файл}
write('Сколько строк записать в файл n=');
readln(n);
for i:=1 to n do
 begin
  writeln('Строка ',i);
  readln(s);
  write(f,s)
 end;
clrscr;
writeln('Содержание исходного файла');
seek(f,0);
while not eof(f) do
 begin
  read(f,s);
  writeln(s);
 end;
seek(f,filesize(f)-1);{встаем на последнюю строку}
read(f,s);
i:=length(s);
while s[i] in rz do i:=i-1;{пропускаем разделители в конце если есть}
while not(s[i] in rz) do i:=i-1;
cp:=s[i+1];
writeln('Последнее слово последней строки начинается на букву ',cp);
seek(f,0);{встаем в начало}
while not eof(f) do
 begin
  read(f,s);
  i:=1;
  while i<=length(s) do
  if (s[i]=cp)and ((i=1)or(s[i-1] in rz)) then{если буква=cp
   и она первая или перед ней разделитель}
   begin
    while (i<=length(s)) and not(s[i] in rz) do {пока не разделитель и не конец строки}
    delete(s,i,1);{удаляем слово по букве}
   end
  else i:=i+1;
  write(g,s);{преобразованную строку в выходной файл}
 end;
close(f);
seek(g,0);
writeln('Содержание выходного файла');
while not eof(g) do
 begin
  read(g,s);
  writeln(s)
 end;
close(g);
readln
end.