Как разделить слова в строке, чтобы их потом сравнивать друг с другом и сортировать? (Паскаль)

ПРОСТОЕ и КОРОТКОЕ решение

VAR s, g: string;
words: array[1..100] of string;
p, t, m: integer;
BEGIN
s := 'Hello, this is my first program.';
while pos(' ', s) <> 0 do
begin
p:=p+1;
words[p]:=copy(s,1,pos(' ', s)-1);
delete(s,1,pos(' ', s));
end;
p:=p+1;
words[p]:=s;

//Sorting and Output

for t := 1 to p-1 do for m := t+1 to p do if words[ t ] > words[ m ] then begin
g := words[ t ];
words[ t ] := words[ m ];
words[ m ] := g;
end;

for t := 1 to p do writeln('Word #',t,': ', words[t]);

END.

Строка сама по себе - массив символов. А найти слово очень просто - перед его первой буквой пробел, после последней - знак препинания или пробел. Надо еще учитывать, что перед первым словом и после последнего строка может кончаться, специальную проверку этих случаев можно исключить, добавив предварительно в начале и конце строки по пробелу.

uses crt;
const t=20; {макс. кол-во слов в предлож. }
ch:set of char =['a'..'z','A'..'Z','а'..'я','А'..'Я']; {допуст. символы}
procedure InputWord(var stroka:string); {ввод предлож. }
begin
write('Введите предложение: ');
readln(stroka);
end;
procedure Find(stroka:string;var slova:array of string;var n:byte);{выделение слов из предложения}
var m,i,c:byte;
begin
n:=1;
i:=0; {номер символа, с кот. нач. копир. }
c:=0; {кол-во копир. символов}
for m:=1 to length(stroka) do {текущий символ предложения}
begin
if stroka[m] in ch then
if i=0 then {указ-ль на первую букву слова}
begin i:=m; c:=c+1; end
else c:=c+1 {увел. кол-во копир. символов}
else if i<>0 then
begin slova[n]:=copy(stroka,i,c); inc(n); i:=0; c:=0; end;{зап. мас. слов}
if m=length(stroka) then
begin slova[n]:=copy(stroka,i,c); inc(n); end; {принуд. заполн. мас. слов}
end;
end;
procedure Sort(var slova:array of string; n:byte); {сортировка}
var i,j,k:byte; min:string;
begin
for j:=1 to n-2 do {номер слова, с кот. начинается сравн. }
for i:=j+1 to n-1 do {текущий номер слова}
begin
k:=1; {номер тек. буквы}
while (slova[k]=slova[j][k]) and {сравн. буквы}
(k<=length(slova)) do inc(k); {тек. слова с}
if slova[k] < slova[j][k] then {буквой мин. слова}
begin {обмен слов}
min:=slova;
slova:=slova[j];
slova[j]:=min;
end;
end;
end;
procedure WriteText(slova:array of string; n:byte); {вывод слов}
var i:byte; {номер слова}
res:string; {строка-результат}
begin
res:='';
write ('Полученный результат: ');
for i:=1 to n do
if slova[0] <> #0 then res:=concat(res,slova)+' ';
writeln(res);
end;
var str:string; {введ. предложение}
word:array [1..t] of string; {слова предложения}
n:byte; {номер последнего слова}
begin
clrscr;
Randomize;
writeln (' Напечатать слова, входящие в предложение, в алфавитном порядке');
writeln;
InputWord(str);
Find(str,word,n);
Sort(word,n);
WriteText(word,n);
readkey;
end.

но это с массивами