Дан тестовый файл, содержащий тест на русском языке. Составить в алфавитном порядке список всех слов, встречающихся в этом тексте — Pascal(Паскаль)

{Дан тестовый файл, содержащий тест на русском языке. Составить в алфавитном
порядке список всех слов, встречающихся в этом тексте}

program p;
var f:text;
    g:file of string;
    i,j,k,max:integer;
    s,sl,s1,s2,smax:string;
function Srav(s1,s2:string):boolean;
const sr='АаБбВвГгДдЕеЖжЗзИиЙйКкЛлМмНнОоПпРрСсТтУуФфХхЦцЧчШшЩщЪъЫыЬьЭэЮюЯя';
var p:boolean;i,k:integer;
begin p:=false;k:=length(s1);I:=1;
      if length(s2)<k then k:=length(s2);
      if Pos(s1[1],sr)<Pos(s2[1],sr)
                 then p:=true;
      while (s1[i]=s2[i]) and(i<=k)and not(p) do
        begin if Pos(s1[i],sr)<Pos(s2[i],sr)
                 then p:=true;
              i:=i+1
        end;
      Srav:=p;
end;
begin assign(f,'f0.Txt');assign(g,'g0.txt');
      reset(f);k:=1;
      rewrite(g);sl:='';
      writeln;
      while not(eof(f)) do
       begin readln(f,s);
             for i:=1 to length(s) do
                begin if s[i]=' ' then begin if sl<>' '
                                                then begin write(g,sl);
                                                           k:=k+1;
                                                     end;
                                              sl:='';
                                        end
                                  else sl:=sl+s[i];
                end;
             if sl<>' ' then begin write(g,sl);
                                   k:=k+1;
                             end;
             sl:='';
       end;
    close(f);close(g);
    reset(g);
    while not(eof(g)) do
      begin read(g,s);
            write(s,' ')
      end;writeln;
    reset(g);
    for i:=0 to k-2 do
      begin reset(g);
            seek(g,i);
            read(g,s1);
            max:=i;smax:=s1;
            for j:=i+1 to k-2 do
              begin seek(g,j);
                    read(g,s2);
                    if srav(s2,sMAX)
                       then begin max:=j;
                                  smax:=s2
                            end;
              end;;
             seek(g,i);
             write(g,smax);
             seek(g,max);
             write(g,s1);
      end;
    reset(g);
    while not(eof(g)) do
      begin read(g,s);
            write(s,' ')
      end;
end.