Поменять местами в предложении самое длинное и самое короткое слово — Pascal(Паскаль)

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);
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.

var 
s,s1,b:string;
    a:array[1..100]of string;
i,k,nmin,nmax:integer;
begin
write('введите строку : ');
readln(s);
s:=' '+s;
for i:=1 to length(s) do
if s[i]=' ' then
inc(k)
else
a[k]:=a[k]+s[i];
nmin:=1;
nmax:=1;
for i:=1 to k do
begin
if length(a[i])>length(a[nmax]) then nmax:=i;
if length(a[i])<length(a[nmin]) then nmin:=i;
end;
   writeln('самое длинное слово: ',a[nmax]);
   writeln('самое короткое слово: ',a[nmin]);
b:=a[nmax];
a[nmax]:=a[nmin];
a[nmin]:=b;
 
for i:=1 to k do
s1:=s1+a[i]+' ';
writeln(s1);
readln;
end.