Строка содержит одно слово максимальной и одно минимальной длины. Поменять их местами.

uses crt;
var s,sl,smax,smin,sn: string;
    k,i,imax,imin,dmax,dmin: integer;
begin
writeln('Введите строку ');
readln(s);
s:=s+' '; sl:='';dmax:=0; dmin:=length(s);
k:=1;
for i:=1 to length(s) do
    if s[i]<>' ' then
      sl:=sl+s[i]
       else
       begin
       if length(sl)>dmax then
          begin
          dmax:=length(sl);
          smax:=sl;
          imax:=pos(sl,s);
          end;
       if (length(sl)<>0) and (length(sl)<dmin) then
          begin
          dmin:=length(sl);
          smin:=sl;
          imin:=k;
          end;
       k:=k+length(sl)+1;
       sl:='';
       end;
 writeln(smax,imax);
 writeln(smin,imin);
if imax>imin then
     sn:=copy(s,1,imin-1)+smax+copy(s,imin+dmin,imax-imin-dmin)+smin+copy(s,imax+dmax,length(s))
else sn:=copy(s,1,imax-1)+smin+copy(s,imax+dmax,imin-imax-dmax)+smax+copy(s,imin+dmin,length(s));
write(sn);
readkey
end.