Переставить местами слово с минимальной длиной и последнее слово

Const
n=15;
Var
K:array [1..n] of integer;
prod: integer;
i:integer;
begin
for i:=1 to n do begin
readln (K[i]);
if (K[i] mod 3<>0) and (K[i] mod 5=0) then
prod:=prod*k[i];
end;
writeln (prod);
readln;
end.

uses wincrt;
var
       n : array[1..100] of byte;
       s : string[100];
    i, m : byte;
      s1 : array [1..20] of string[20];
 
   s_min,
   s_max : string[20];
                                                   {  перемещает наименьшее и найболшее слова местами }
   k_min,
   k_max,
     min,
  max, j : byte;
 
 
 begin
 
  writeln('Введите строку : ');  readln(s);
 
    s:= s + ' ';
    m:= ord( s[0] );
  min:= 100;
    j:= 1;
                                               {                                     }
   for i:= 1 to m do                           {                                     }
    begin                                      {                                     }
         s1[j] := s1[j] + s[i];                {   pазбиваем строку на массив слов   }
          n[j] := i;                           {                                     }
                                               {                                     }
         if s[i] = ' '                         {                                     }
            then                               {                                     }
                j:= j + 1;
    end;
 
    for i:= 1 to j-1 do
      begin
 
           if length( s1[i] ) > max
              then
                  begin
                      s_max := s1[i];                          {   максимальное длинной слово    }
                        max := length( s1[i] );                 {     длинна макс. дл. слова      }
                      k_max := n[i] - max + 1;                   {       позиция макс. дл. слова   }
                  end;
 
            if length( s1[i] ) < min
              then
                  begin
                      s_min := s1[i];                            {    минимальное длинной слово  }
                        min := length( s1[i] );                   {          длинна               }
                      k_min := n[i] - min + 1;                     {         позиция               }
                  end;
 
       end;
 
 
  delete(s, k_max, max);
     insert(s_min, s, K_max);
 
  if k_min < k_max
 
     then
         begin
             delete(s, k_min, min);
               insert(s_max, s, K_min);
         end
 
     else
         begin
             delete(s, k_min - (max - min), min);
               insert(s_max, s, k_min - (max - min));
          end;
 
  writeln(s);
 
 
end.

program Project1;
 
//Меняет местами первое из самых коротких слов с последним словом.
function ProcStr(const aStr : String) : String;
const
  //Множество разделителей слов.
  D = [' ', '.', ',', ':', ';', '!', '?', '-', #9, #10, #13];
var
  S, W1, W2 : String;
  i, Pos1, Pos2, PosW, Len, LenW, LenWMin : Integer;
begin
  S := aStr;
  //Поиск координат первого из самых коротких слов
  //и координат последнего слова.
  Len := Length(S);
  LenWMin := Len;
  PosW := 0;
  Pos1 := 0;
  Pos2 := 0;
  for i := 1 to Len do begin
    //Пропускаем разделители.
    if S[i] in D then Continue;
    //Отслеживаем начало слова.
    if (i = 1) or (S[i - 1] in D) then Pos1 := i;
    //Отслеживаем конец слова.
    if (i = Len) or (S[i + 1] in D) then begin
      Pos2 := i;
      //Вычисляем длину очередного найденного слова.
      LenW := Pos2 - Pos1 + 1;
      //Если это слово короче всех ранее найденных слов, то
      //запоминаем его координаты и его длину.
      if LenW < LenWMin then begin
        LenWMin := LenW;
        PosW := Pos1;
      end;
    end;
  end;
 
  //После выхода из предыдущего цикла имеем:
  //Pos1, Pos2 - координаты последнего слова в тексте.
 
  //Меняем местами слова.
  if Pos1 <> PosW then begin
    W1 := Copy(S, PosW, LenWMin);
    LenW := Pos2 - Pos1 + 1;
    W2 := Copy(S, Pos1, LenW);
    Delete(S, Pos1, LenW);
    Insert(W1, S, Pos1);
    Delete(S, PosW, LenWMin);
    Insert(W2, S, PosW);
  end;
 
  ProcStr := S;
end;
 
var
  S : String;
begin
  repeat
    //Исходный текст.
    Writeln('Задайте текст:');
    Readln(S);
 
    //Решение задачи.
    S := ProcStr(S);
 
    //Показываем результат.
    Writeln('Текст после обработки:');
    Writeln(S);
 
    Writeln('Повторить - Enter. Выход - любой символ + Enter.');
    Readln(S);
  until S <> '';
end.