Program na analýzu textu

program An_textu;
uses crt;

const max_pocet=maxint;                                         //maximální počet slov

var file_in, file_out : text;                                   //proměnné pro vstupní a výstupní soubor
    slova_pole : array [0..max_pocet] of string [25];           //vektor načtených slov
    pocet : integer;
    M : string; //mezipamet                                     //mezipaměť pro sežazení slov

Procedure Nacteni_textu;                                        //Procedura pro načtení textu do programu
 var index : integer;
     znak : char;
     prvek : string;                                            

 begin
  assign(file_in,'C:\FreePascal\text.txt');                     //načítá soubor umístěný ve složce C:\FreePascal
  reset(file_in);                                               //otevírá soubor

  index := 0;

  repeat                                                        //cyklus pro načtení 
   if eoln(file_in)                                             //pokud natazím na konec řádku
    then readln(file_in,znak)                                   //tak načti řádek(slovo) i s enterem do proměnné znak
    else read(file_in,znak);                                    //jinak načti řádek(slovo) bez enteru do proměnné znak

   if (znak in [' ',',','.','"','-']) and (prvek <> '')         //pokud znak obsahuje něco z uvedených a prvek je různý od ničeho
    then                                                        //tak
     begin
      slova_pole[index]:= prvek;                                //
      prvek:='';
      index:=index+1;
     end;

   if not (znak in [' ',',','.','"','-'])
    then prvek:=prvek+znak;

  until eof(file_in);

  pocet:= index;
 end;

Procedure Zobrazeni;
 var i:integer;
 begin
  for i:=0 to Pocet do writeln (Slova_pole[i]);
 end;

Procedure Serazeni;
var w:integer; //citac
    i, nej :integer;
    max: string;
 begin
   w:=1;
  repeat
   nej:=  w;
   max:=slova_pole[w];
   for i:=w to max_pocet do
    begin
     if slova_pole[i]>max then
      begin
       max:=slova_pole[i];
       nej:=i;
      end;
    end; //urcen nejvetsi
   M:=slova_pole[w];
   slova_pole[w]:=slova_pole[nej];
   slova_pole[nej]:=M;
   w:=w+1;
 until w=max_pocet;

 end;

procedure vypis;
 var w,i:integer;
 begin
  assign(file_out,'c:\FreePascal\out.txt');
  Rewrite(file_out);
  w:=1;
  for i:=max_pocet downto 1 do
   begin
    if slova_pole[i]=slova_pole[i-1]
     then w:=w+1
     else
      begin
       write(file_out,w); write(file_out,'x ');
       writeln(file_out,slova_pole[i]);
       w:=1;
      end
   end;
  Close(file_out);

 end;


begin
 clrscr;
 Nacteni_textu;
// Zobrazeni;
 Close(file_in);
 Serazeni;
 vypis;
 readln;
end.