Упорядочить слова предложения в алфавитном порядке

uses crt;
const razd:set of char=[' ','.',',',':',';','!'];
var st,buf:string;
begin
 clrscr;
 write('Строка -> ');
 readln(st);
 
 repeat
  if (st[1] in razd) or (length(st)=0) then while st[1] in razd do delete(st,1,1)
  else
  begin
   while (not (st[1] in razd)) and (length(st)>0) do
   begin
    buf:=buf+st[1];
    delete(st,1,1);
   end;
 
  buf[1]:=buf[length(buf)];
  write(buf,' ');
 end;
 until (length(st)=0) and (length(buf)=0);
 readln;
end.

uses crt;
const c=['a'..'z','A'..'Z',' '];
var s,x,y:string;
    s1,s2:array[1..100] of string;
    i,j,m,k:integer;
begin
clrscr;
repeat
k:=0;
Write('s: ');readln(s);
for i:=1 to length(s) do
if not(s[i] in c) then{если недопустимые символы}
 begin
  k:=1;
  write('Error');
  break;
 end;
until k=0;
s:=s+' ';{добавим пробел в конец}
while pos('  ',s)>0 do   {удалим лишние пробелы(в кавычках по 2 пробела)}
delete(s,pos('  ',s),1);
m:=0;
while pos(' ',s)>0 do{пока есть пробел}
 begin
  m:=m+1;
  s1[m]:=copy(s,1,pos(' ',s)-1);{первое слово пишем в массив}
  delete(s,1,pos(' ',s)); {удаляем его}
 end;
{создадим такой же массив, переведем всe символы в верхний регистр}
for i:=1 to m do
 begin
  s2[i]:='';
  for j:=1 to length(s1[i]) do
  s2[i]:=s2[i]+Upcase(s1[i][j]);
 end;
for i:=1 to m-1 do      {сортируем по возрастанию = по алфавиту}
for k:=1 to m-1 do
if (s2[k]>s2[k+1]) then
   begin
    x:=s1[k];s1[k]:=s1[k+1];s1[k+1]:=x;
    y:=s2[k];s2[k]:=s2[k+1];s2[k+1]:=y;
   end;
{выводим по алфавиту}
for i:=1 to m do
write(s1[i],' ');
readln;
end.