Поменять местами самое длинное и самое короткое слово в строке

uses crt;
var s,s1,s2:string;{строка, ее копия, вспомогательная строка}
    sk,sd:string;{короткое и длинное слова}
    len,k,d,i,ik,id:byte;
begin
clrscr;
writeln('Введите строку из слов, отделенных пробелами:');
readln(s);
s1:=s+' ';{копируем строку и пробел в конец, над этой строкой будем изгаляться}
while pos('  ',s1)>0 do
delete(s1,pos('  ',s1),1);{удалим лишние пробелы(в кавычках по 2 пробела!!!!)}
if s1[1]=' 'then delete(s1,1,1);{если в начале пробел, удалим}
sd:='';sk:='';d:=0;k:=255;ik:=1;id:=1;{исходные значения длинного и короткого слов, 
максимальной и минимальной длины, позиций первых вхождений этих слов}
while pos(' ',s1)>0 do{пока в строке есть пробелы}
 begin
  len:=pos(' ',s1)-1;{определяем длину первого слова}
  s2:=copy(s1,1,len);{запоминаем слово}
  if len<k then{если длина меньше минимального}
   begin
    sk:=s2;{это искомое слово}
    k:=len;{его длина}
    ik:=pos(sk,s);{индекс его первого символа}
   end;
  if len>d then{то же макс}
   begin
    sd:=s2;
    d:=len;
    id:=pos(sd,s);
   end;
  delete(s1,1,pos(' ',s1));{удаляем просмотренное слово}
 end;
writeln('Самое короткое слово ',sk);{выводим для проверки, можно убрать}
writeln('Самое длинное слово ',sd);
if ik<id then{если короткое раньше длинного}
 begin
  insert(sk,s,id);{вставляем перед длинным короткое}
  delete(s,id+k,d);{удаляем длинное}
  insert(sd,s,ik);{перед коротким вставляем длинное}
  delete(s,ik+d,k);{удаляем короткое}
 end
else{если длинное раньше, тоже, немного наоборот}
 begin
  insert(sd,s,ik);
  delete(s,ik+d,k);
  insert(sk,s,id);
  delete(s,id+k,d);
 end;
write(s);
readln
end.