program stroki;
uses crt;
type
	TWords = array[1 .. 30] of string[5];
	TDelimiter = set of Char;
 function GetWords(s: string; var mas: TWords; delimiters: TDelimiter): Byte;
var i, p: Byte;
     begin
	for i := 1 to Length(s) do
	if s[i] in delimiters then s[i] := #32;  {zamena znakov , y . na probel}
	repeat
		p := Pos('  ', s);
		if p > 0 then Delete(s, p, 1);
	until p = 0;
                if s[1] = ' ' then
		Delete(s, 1, 1);
		If s[Length(s)] = ' ' then
		Delete(s, Length(s), 1);
        i := 0;
	repeat
		p := Pos(' ', s); Inc(i);  {zapolnenie massiva}
		if p > 0 then begin
			mas[i] := Copy(s, 1, Pred(p)); Delete(s, 1, p)
		              end
		else mas[i] := s;
	until p = 0;
        GetWords := i
end;
const   z='**********************************************';
        name1='A:\2semestr\sauronsring.out';
        name2='A:\2semestr\sauron1.out';
var
        i, j, n, count: Word;
	words: TWords;
        s:string[200];
        current,v:string[5];
        a:boolean;
        t,f:text;
begin
clrscr;

assign(t,name1);
reset(t);
assign(f,name2);
rewrite(f);
writeln(f,'      Laboratornaya rabota 2. Simvolniye massivi.');
writeln(f,z);
writeln(f,' Zadaniye:');
writeln(f,'Dana posliedovatelnost do 30 slov, mezhdu slovami - probel');
writeln(f,'ili zapiataya, v kontse posliedovatielnosti - tochka.');
writeln(f,'Napiechatat vse razlichniye slova, ukazav dlia kazhdogo iz');
writeln(f,'nij chislo yego vjozhdieniy v posliedovatielnost.');
writeln(f,z);
writeln(f,'           Naidienniye slova');
readln(t,s);
	count := GetWords(s, words, [',','.']);
	for i := 1 to count do begin
write(f,'  ',i,') ',words[i]);
if i mod 5 = 0 then writeln(f);
end;
writeln(f);
        repeat
        a:=true;
        for i:=1 to count-1 do
        if words[i]<words[i+1] then
        begin
        v:=words[i];
        words[i]:=words[i+1];
        words[i+1]:=v;
        a:=false;
        end;
        until a;
        writeln(f,z);
        writeln(f,'         Otsortirovanniy massiv slov');
        for i:=1 to count do begin
        write(f,' ',words[i]);
        if i mod 10 = 0 then writeln(f);
        end;
        writeln(f);
        writeln(f,z);
        i:=1;
        repeat
        current:=words[i];
        n:=1;
        while (words[i+1]=current) and (i<=count) do begin
        inc(i);
        inc(n);
        end;
        writeln(f,' slovo: <', current,'> soderzhitsa ',n,' raz');
        inc(i);
        until i>count;
        close(t);
        close(f);
end.