Убрать в строке все лишние пробелы и поменять четные и нечетные слова местами

var
  s:string;
 i:integer;
begin
  writeln('Введите строку...');
  readln(s);
for i:=1 to Length(s) do  
while pos('  ',s)>0 do begin
    delete(s,pos('  ',s),1);
 
end;
 
if s[1]=' ' then delete(s,1,1);
if s[Length(s)]=' ' then delete(s,Length(s),1);
writeln(s)
end.

var
  s,s1,snew:string;
 i,n,a1,a2:integer;
begin
  writeln('Введите строку...');
  readln(s);
for i:=1 to Length(s) do  
while pos('  ',s)>0 do 
    delete(s,pos('  ',s),1);
s:=trim(s);  // эта функция заменяет две строки: 
          //if s[1]=' ' then delete(s,1,1);
          //if s[Length(s)]=' ' then delete(s,Length(s),1);
a1:=1; // позиция начала нечетного слова
n:=1;  //счетчик слов
For i:=1 to Length(s) do
  begin
    if  n mod 2=1 then s1:=s1+s[i];
    if s[i]=' ' then 
      begin
        if  n mod 2=0 then 
          begin
            snew:=snew+copy(s,a2,i-a2)+' '+s1;
            s1:='';
          end
          else a2:=i+1; //позиция начала четного слова
        n:=n+1; 
      end;
  end;
snew:=snew+copy(s,a2,i-a2+1)+' '+s1;  
writeln(snew)
end.