Вывести строку, содержащую ее слова, но разделенные одним пробелом и в обратном порядке

program Project1;
 
const
  //Разделители слов.
  D = ['.', ',', ':', ';', '!', '?', '-', ' ', #9, #10, #13];
var
  S, SRes : String;
  i, Len, Pos1 : Integer;
begin
  repeat
    Writeln('Задайте строку:');
    Readln(S);
 
    Len := Length(S);
    SRes := '';
    Pos1 := 0;
    //Перебор символов строки в направлении справа-налево.
    for i := Len downto 1 do begin
      //Пропускаем разделители.
      if S[i] in D then Continue;
      //Отслеживаем конец слова.
      if (i = Len) or (S[i + 1] in D) then Pos1 := i;
      //Отслеживаем начало слова.
      if (i = 1) or (S[i - 1] in D) then begin
        //Добавление пробела.
        if SRes <> '' then SRes := Sres + ' ';
        //Добавляем слово к строке.
        SRes := SRes + Copy(S, i, Pos1 - i + 1);
      end;
    end;
 
    Writeln('Ответ:');
    Writeln(SRes);
 
    Writeln('Повторить - Enter. Выход - любой символ + Enter.');
    Readln(S);
  until S <> '';
end.

program Project1;
 
const
  //Разделители слов.
  D = ['.', ',', ':', ';', '!', '?', '-', ' ', #9, #10, #13];
  //Искомые буквы. - Русская и английская буква "А".
  Da = ['А', 'а', 'A', 'a'];
var
  S : String;
  i, Len, CntA, CntW : Integer;
begin
  repeat
    Writeln('Задайте строку:');
    Readln(S);
 
    Len := Length(S);
    CntA := 0;
    CntW := 0;
    for i := 1 to Len do begin
      //Пропускаем разделители.
      if S[i] in D then Continue;
      //Ведём подсчёт искомых букв внутри слова.
      if S[i] in Da then Inc(CntA);
      //Отслеживаем конец слова.
      if (i = Len) or (S[i + 1] in D) then begin
        //Подсчёт искомых слов.
        if CntA = 3 then Inc(CntW);
        //Сброс счётчика букв.
        CntA := 0;
      end;
    end;
 
    Writeln('Количество слов, которые содержат ровно по три буквы');
    Writeln('из множества [''А'', ''а'', ''A'', ''a''] равно:');
    Writeln(CntW);
 
    Writeln('Повторить - Enter. Выход - любой символ + Enter.');
    Readln(S);
  until S <> '';
end.

uses crt;
const ds=['А'..'п','р'..'ё',' '];{допустимые символы, русские буквы и пробел,
                                  это для Турбо, для АВС ['А'..'я','Ё','ё',' ']}
var c:char;
    s,s1,s2:string;
    i,j:byte;
begin
clrscr;
writeln('Введите строку из русских слов, разделенных пробелами, окончание ввода Enter:');
s:='';
repeat
c:=readkey;
if c in ds then
 begin
  s:=s+c;
  write(c);
 end;
if c=#13 then writeln;
until c=#13;
s2:='';{новая строка}
i:=length(s);{начнем с конца}
while i>=1 do
{если буква и она последняя или за ней пробел}
if(s[i]<>' ')and((i=length(s))or(s[i+1]=' '))then
 begin
  s1:='';{новое слово}
  j:=i;
  while(j>=1)and(s[j]<>' ') do{пока не пробел или не начало строки}
   begin
    s1:=s[j]+s1;{составляем слово, добавляя буквы в начало}
    j:=j-1;{идем назад}
   end;
  s2:=s2+s1+' ';{добавляем это слово и пробел}
  i:=i-length(s1);{перешагиваем через слово}
 end
else i:=i-1;{если пробел, пропускаем}
write(s2);
readln
end.

uses crt;
const ds=['А'..'п','р'..'ё',' '];
var c:char;
    s,s1:string;
    i,j,k,b:byte;
begin
clrscr;
writeln('Введите строку из русских слов, разделенных пробелами, окончание ввода Enter:');
s:='';
repeat
c:=readkey;
if c in ds then
 begin
  s:=s+c;
  write(c);
 end;
if c=#13 then writeln;
until c=#13;
k:=0;
i:=1;{здесь идем с начала}
while i<=length(s) do
if(s[i]<>' ')and((i=1)or(s[i-1]=' '))then
 begin
  s1:='';
  j:=i;
  while(j<=length(s))and(s[j]<>' ') do
   begin
    s1:=s1+s[j];{буквы добавляем в конец}
    j:=j+1;
   end;
  b:=0;
  for j:=1 to length(s1) do
  if s1[j] in ['А','а'] then b:=b+1;
  if b=3 then k:=k+1;
  i:=i+length(s1);
 end
else i:=i+1;
write('Количество слов с тремя буквами Аа=',k);
readln
end.