Дана строка, слова в которой разбиты пробелами. Поменяйте местами самое длинноватое

var a:char;
mins,maxs:string;
f1,f2:text;
mas: array [1..255] of string;
maspr: array [1..255] of integer;
i,q,min,max,k,k2:integer;
begin
assign(f1,input.txt);
reset(f1);
assign(f2,output.txt);
rewrite(f2);
min:=255;
i:=1;
q:=1;
while not(eoln(f1)) do
begin
read(f1,a);
//Если а является буковкой
if not(a = ) then
begin
inc(k);
mas[i]:=mas[i] + a;
if k2 gt; 0 then inc(q);
k2:=0;
end;
//Если а не является буквой
if (a = ) or (eoln(f1) = true) then
begin
k2:=1;
inc(maspr[q]);
if (k gt; 0) and (k gt; max) then
begin
max:=k;
maxs:=mas[i];
end;
if (k gt; 0) and (k lt; min) then
begin
min:=k;
mins:=mas[i];
end;
if k gt; 0 then inc(i);
k:=0;
end;
end;
i:=i - 1;
k2:=0;
maspr[q]:=0;
//Подмена слов местами
for i:=1 to i do
begin
if (k2 = 0) and (mas[i] = maxs) then
begin
mas[i]:=mins;
k2:=i;
end;
if not(k2 = i) and (k = 0) and (mas[i] = mins) then
begin
mas[i]:=maxs;
k:=1;
end;
end;
k:=0;
q:=1;
//Расстановка пробелов меж словами
while k = 0 do
begin
for i:=1 to i do
begin
write(f2,mas[i]);
if maspr[q] = 0 then k:= 1
else
begin
for max:=1 to maspr[q] do
begin
write(f2, );
end;
inc(q);
end;
end;
end;
close(f1);
close(f2);
end.