function answer: boolean;
var
   s: string;
   correct: boolean;
begin
   correct := false;
   repeat
      readln(s);
      if (s = 'Да') or (s = 'Нет') then
         correct := true
      else
         write('Введите пожалуйста "Да" или "Нет": ');
   until correct;
   if s = 'Да' then
      answer := true
   else
      answer := false;
end;

function InFile(name: string): string;
var
   correct: boolean;
begin
   correct := false;
   repeat
      writeln('Введите имя файла ,в котором хранятся исходные файлы:');
      readln(name);
      if FileExists(name) then
         correct := true
      else
      begin
         writeln('Неправильное имя файла. Повторите, пожалуйста ввод.');
         writeln;
      end;
   until correct;
   writeln;
   result := name;
end;

procedure OutFile(var OutName: string; name: string);
var
   correct: boolean;
   Writefile: TextFile;
begin
   correct := false;
   repeat
      writeln('Введите имя файла, в котором необходимо разместить результат работы программы.');
      readln(OutName);
      if FileExists(OutName) and (name <> OutName) then
      begin
         assign(WriteFile, OutName);
         reset(WriteFile);
         if seekeof(WriteFile) then
            correct := true
         else
         if correct = false then
         begin
            writeln('Этот файл содержит данные. Вы хотите очистить его и записать туда результат работы программы?');
            if answer then
               correct := true;
         end;
         close(WriteFile);
      end
      else
      if (copy(OutName, length(OutName) - 3, 4) = '.txt') and (name <> OutName) then
      begin
         writeln('Файл с таким именем не существует. Вы хотите его создать ?');
         if answer then
            correct := true;
      end
      else
         writeln('Некорректное имя файла, повторите пожалуйста вход.');
      writeln;
   until correct;
end;

function Solution (name: string; Str_Array:array of string) : string;

var
   Input_File: text;
   line, space, buffer: string;
   //Str_Array: array of string;
   i, j, space_position: integer;
begin
   assign(Input_File, name);
   reset(Input_File);
   while not eof(Input_File) do
   begin
      readln(Input_File, line);
      begin
         line := line + ' ';
         space := '';
         j := 1;
         for i := 1 to length(line) do
            if line[i] <> ' ' then
               space := space + line[i]
            else
            begin
               setlength(Str_Array, j);
               Str_Array[j - 1] := space;
               space := '';
               inc(j);
            end;
         space_position := j;
         j := 0;
         while j < space_position - 2 do
         begin
            buffer := Str_Array[j];
            Str_Array[j] := Str_Array[j + 1];
            Str_Array[j + 1] := buffer;
            j := j + 2;
         end;
         for j := 0 to space_position - 2 do
            write(Str_Array[j], ' ');
      end;
   end;
   close(Input_File);
end;

procedure OutResult(OutName: string);
var
   WriteFile: TextFile;
begin
   assign(WriteFile, OutName);
   rewrite(WriteFile);
   writeln(WriteFile);
   writeln;
   close(WriteFile);
   readln;
end;

procedure user_interface;
begin
   writeln('             ---------------------------------------------------');
   writeln('             ¦                 УСЛОВИЕ ЗАДАЧИ:                 ¦');
   writeln('             ¦ В заданном предложении поменять местами  слова, ¦');
   writeln('             ¦ стоящие на четных местах со словами,            ¦');
   writeln('             ¦ стоящими на нечетных местах.                    ¦');
   writeln('             ---------------------------------------------------');
   writeln;
end;

var
   name: string;
   OutName: string;
   Str_Array:array of string;

begin
   user_interface;
   name := InFile(Name);
   OutFile(outName, Name);
   writeln('Резаультат работы программы: ' );
   solution(name,Str_Array);
   outresult(OutName);
end.