UNIX Free Pascal



. - 10


if nump>0 then

for x:=1 to nump do

if List[x].wrd=sm then

begin

T:=false;

inc(List[x].num);

end;

if T then

begin

inc(nump);

List[nump].wrd:=sm;

List[nump].num:=1;

end;

end;

function add(s:string):boolean;

var

m:byte;

tmp:string;

begin

if s<>'' then

begin

tmp:=s;

for m:=1 to ord(tmp[0]) do

if not (tmp[m] in ['A'..'Z','a'..'z','0'..'9']) then tmp[m]:=' ';

while (pos(' ',tmp)>0) do

begin

if (pos(' ',tmp)>1) then checkadd(copy(tmp,1,pos(' ',tmp)-1));

delete(tmp,1,pos(' ',tmp));

end;

if (pos(' ',tmp)=0)and(ord(tmp[0])>0) then checkadd(tmp);

end;

add:=true;

end;

begin

nump:=0;

writeln('-------------------');

if paramcount<1 then halt(1);

assign(F,paramstr(1));

reset(F);

while not(eof(F)) do

begin

readln(F,stroka);

add(stroka);

end;

close(F);

for j:=1 to nump-1 do

begin

max:=j;

for i:=j+1 to nump do

if List[i].num>List[max].num then max:=i;

Temp:=List[max];

List[max]:=List[j];

List[j]:=Temp;

end;

for i:=1 to nump do

write(List[i].wrd:11,' - ',List[i].num:4,' ');

writeln;

end.

13.20. , . uniq UNIX.

var

first,second:string;

begin

readln(first);

writeln(first);

while not eof(input) do

begin

readln(second);

if first<>second then

begin

writeln(second);

first:=second;

end;

end;

end.

13.21. banner.

Uses Crt;

Type

TArrNum=Array[1..8] of Byte;

Const

stroki:Array [1..42]of string[6]=

(('******'),(' *****'),('***** '),('* '),(' * '),

(' * '),(' * '),(' * '),(' *'),('* *'),