Сортировка слов в строке Опции

[сНежная]

Помогите решить задачку
Вводится произвольное кол-во слов в строку, программа выводит кол-во слов в строке и переставляет местами слова (1 со 2, 3 с 4 и т.д), если перед первым словом пробел, или между словами более одного пробела, то выдается сообщение о ошибке и предлагается начать сначала.

//в строке переставить местами рядом стоящие слова(1 со 2, 3 с 4, и т.д.) Дана
//дана строка, нач. не пробелом, между словами по 1 пробелу,
//и строка закан. буквой

program ctroca;
{$APPTYPE CONSOLE}
uses
SysUtils;
var s,s1,temp:string;
s2:array[1..25]of string;
p,k,n,i,t:integer;
begin
writeln('Vvedite text');
readln(s);
writeln;
k:=1;
n:=1;
p:=0;
s1:='';

for i:=1 to length(s) do
begin
if (s[i]<>' ')and(s[i+1]=' ')
then inc(k);
end;

for i:=1 to length(s) do
begin
if (s[i]<>' ')
then begin
insert(s[i],s1,n);
inc(n);
end;
if (s[i]=' ') or (i=length(s))
then begin
n:=1;
inc(p);
s2[p]:=s1;
s1:='';
end;
end;

if

for i:=1 to length(s) do
if (s[i]=' ') and (s[i+1]=' ')
then begin
writeln('Error!!!!');
s:='';
writeln('Mnogo probelov ');
writeln('Vvedite text :');
readln(s);
for i:=1 to Length(s) do
begin
if (s[i]<>' ')and(s[i+1]=' ')
then inc(k);
end;
end;
end;

if s[1]=' '
then begin
writeln('Error!!!!');
writeln('Nachalo probel ');
writeln('Vvedite text :');
readln(s);
for i:=1 to Length(s) do
begin
if (s[i]<>' ')and(s[i+1]=' ')
then inc(k);
end;
end;
writeln('Kol-vo slov: ',k);

readln;
end.

[arhimag]

Код

program Project2;


var s : string;
var arr : array [1..256] of string;
var c : integer;
var slov : integer;
function make_words(s:string):boolean;
var i: integer;
begin
  slov:=1;
  c:=1;
  make_words:=false;
  i:=1;
  while (i<=length(s)) and (s[i]=' ') do
    inc(i);
  while i<=length(s)do begin
    if (s[i]=' ') and (i<length(s)) and (s[i+1]=' ') then exit;
    if (s[i] in ['A'..'z']) then arr[c]:=arr[c]+s[i];
    if (s[i]=' ') then begin inc(c); inc(slov); end;
    inc(i);
  end;
  if s[length(s)]=' ' then begin dec(c); dec(slov); end;
  make_words:=true;
end;
var flag : boolean;
i : integer;
tmp : string;
begin
  readln(s);
  flag:=make_words(s);
  if (flag) and (c>1) then begin
    for i:= 1 to ((c)div 2) do begin
      tmp:=arr[i*2-1];
      arr[i*2-1]:=arr[i*2];
      arr[i*2]:=tmp;
    end;
    for i:=1 to c do write(arr[i],' '); writeln; writeln('slov:',slov);
  end else
    if (c=1) and (flag) then begin
      writeln(s); writeln(1);
    end else
      writeln('Strashnij error!!!');
  readln;
end.

вот теперь все ок