Сортировка текстового файла по последнему слову строки

uses crt;
type zap=record//создаем тип запись с полями
         st:string;//строка
         ps:string;//ее последнее слово
         end;
var f,g:text;
    s,s1:string;
    m:array[1..100] of zap;//массив строк
    x:zap;
    name:string;
    n,i,j:integer;
begin
clrscr;
write('Имя файла для сортировки: ');
readln(name);
name:=name+'.txt';
assign(f,name);
reset(f);
write('Имя нового файла: ');
readln(name);
name:=name+'.txt';
assign(g,name);
rewrite(g);
n:=0;
while not eof(f) do
 begin
  n:=n+1;
  readln(f,s);
  m[n].st:=s;//читаем файл построчно в массив
 end;
close(f);
for i:=1 to n do
 begin
  s:='';
  while m[i].st[length(m[i].st)]=' 'do//удаляем пробелы в конце строки
  delete(m[i].st,length(m[i].st),1);
  j:=length(m[i].st);//встаем в конец строки
  while m[i].st[j]<>' ' do//пока не пробел
   begin
    s:=m[i].st[j]+s;//составляем последнее слово
    j:=j-1;
   end;
  m[i].ps:=s;//заносим в поле записи
 end;
for i:=1 to n-1 do
for j:=i+1 to n do
if m[i].ps>m[j].ps then//сортируем по возрастанию(алфавиту) последнего слова
 begin
  x:=m[i];
  m[i]:=m[j];
  m[j]:=x;
 end;
for i:=1 to n do
writeln(g,m[i].st);//пишем в новый файл(можно переделать старый, но проверить нельзя будет)
close(g);
write('Файл переписан!');
readln
end.