В текстовом файле input.txt записан русский текст. Найти в тексте слова, содержащие не менее трех букв из последнего слова текста — Pascal(Паскаль)

Program PascalGuru;
 
var s:string;
    f,t:text;
{-----------------------------------------------}
function preobr(s:string):string;
label 1,2,3;
var i,j,l,p,n,kol:integer;
    gl,zp,slovo,poslednee,cifra:string;
    m:array [1..80] of string;
begin
zp:='!?*,.'; {все знаки препинания}
gl:='аоуыэяеёюи';
cifra:='0123456789';
 {начало разбиения предложения на слова}
 p:=pos(' ',s);
 i:=0;
        repeat
        inc(i);
        slovo:=copy(s,1,p-1);
        m[i]:=slovo;
        delete(s,1,p);
        p:=pos(' ',s);
        until p=0;
        n:=i+1;
        m[n]:=s;  {массив со словами}
 {--конец разбиения предложения на слова}
 
for i:=1 to n-1 do {проход по массиву слов строки}
    begin
      s:=m[i];
      poslednee:=m[n]; {последнее слово, с которым будем сравнивать }
 
      for j:=1 to length(poslednee) do {удаляем в последнем слове знаки препинания}
      if  pos(poslednee[length(poslednee)],zp)<>0 then delete(poslednee,length(poslednee),1);
 
      1:   {удаляем в последнем слове цифры }
      for j:=1 to length(poslednee) do
      if  (pos(poslednee[length(poslednee)],cifra)<>0) then
          begin delete(poslednee,j,1); goto 1; end;
 
          2:   {удаляем в последнем слове повторяющиеся буквы  }
           for j:=1 to length(poslednee) do
            for l:=1 to length(poslednee) do
            if (j<>l) and (poslednee[j]=poslednee[l]) then
               begin delete(poslednee,j,1); goto 2; end;
 
    {"p" - будет переменной содержащей ДЛИНУ слова}
         if pos(s[length(s)],zp)<>0 then p:=length(s)-1 else p:=length(s); {если есть знак препинания - не учитываем его}
 
         kol:=0;
         for j:=1 to length(poslednee) do
         if pos(poslednee[j],s)<>0 then inc(kol);
 
 
 
         if kol>2 then
         begin
          s:=s+'(';
          kol:=0;
          for j:=1 to length(poslednee) do
           if pos(poslednee[j],s)<>0 then
            begin
            s:=s+poslednee[j];
            s[pos(poslednee[j],s)]:=UpCase(s[pos(poslednee[j],s)]); {в заглавные}
            inc(kol);
            if kol=3 then goto 3;
            end;
         3:
         m[i]:=s+')';
         end;
 
 
    end;
    {--- конец преобразования строки}
 
    s:=''; {запишем всю строку(обновлённую) сначала}
    for i:=1 to n do s:=s+m[i]+' ';
 
preobr:=s;
end;
{-----------------------------------------------}
 
begin
assign(f,'input.txt'); reset(f);
assign(t,'output.txt'); rewrite(t);
 
while not eof(f) do
      begin
      readln(f,s);
      writeln(t, preobr(s) );
      end;
 
 
writeln('Файл успешно записан...');
 
close(f);
close(t);
readln;
end.