Program N;

Uses Crt;

Var h: text;

s,k:string;

i,j,n,r,min,l:integer;

f,t:boolean;

a:array[33..175] of integer;

Procedure Poisk(q:integer);

begin

Assign (h,'text.txt');

Reset (h);

n:=0;

t:=false;

While Eof (h) = false do

begin

Readln(h,s);

k:='';

f:=false;

for i:=1 to length(s) do begin

if (s[i]=' ') or (i=length(s)) then f:=true

else f:=false;

if f=false or (i=length(s)) then k:=k+s[i];

if f then begin

for j:=1 to length(k) do

if k[j]=chr(q) then t:=true;

k:='';

if t then n:=n+1;

t:=false;

end;

end;

end;

Close(h);

a[q]:=n;

end;



begin

Clrscr;

for r:=33 to 175 do begin

poisk®;

if a[r]>0 then begin

min:=a[r];

l:=r;

end;

writeln(chr®,' ',a[r]);

end;

for r:=33 to 175 do begin

if (min>a[r]) and (a[r]>0) then begin

min:=a[r];

l:=r;

end;

end;

writeln('Следующие символы входит в наименьшее количество слов:');

for r:=33 to 175 do if a[r]=min then writeln(chr®);

write('Нажмите Enter');

readln

end.

program tp;

const razd=[' ','.',',','?','!',':',')','('];

var f:text;

s,slo,slovo,name:string;

k,i:integer;

begin write('Введите имя файла:');

readln(Name);

assign(f,name);

reset(f);

slovo:='';k:=0;

while not(EOF(F)) do

begin

readln(f,s);slo:='';

for i:=1 to length(s) do

begin

if s[i] in razd

then

begin

if (i>1)and not(s[i-1]in razd)

then begin

if (length(slo)=length(slovo))and

(slo=slovo)

then k:=k+1;

if length(slo)>length(slovo)

then

begin

slovo:=slo;

k:=1

end;

end;

slo:=''

end

else

begin

slo:=slo+s[i]

end;

end;

if (length(slo)=length(slovo))and

(slo=slovo)

then k:=k+1;

if length(slo)>length(slovo)

then slovo:=slo;

end;

writeln('слово ',slovo,' встречается ',k,' раз');

close(f);

readln

end.

{$N+}

Program Pascal;

Uses Crt;

Var h: text;

s,k:string;

i:integer;

f:boolean;

d,sr:double;

Code,l:integer;

begin

Clrscr;

writeln('Числа, считанные из файла text.txt');

Assign (h,'text.txt');

Reset (h);

While Eof (h) = false do

begin

Readln(h,s);

k:='';

f:=false;

l:=0;

for i:=1 to length(s) do begin

if (s[i]=' ') or (i=length(s)) then f:=true

else f:=false;

if f=false or (i=length(s)) then k:=k+s[i];

if f then begin

l:=l+1;

Val(k, d, Code);

sr:=sr+d;

writeln(d);

k:='';

f:=false;

end;

end;

end;

Close(h);

sr:=sr/l;

writeln('Среднее значение чисел: ',sr:4:2);

write('Нажмите Enter');

readln

end.

{

Задан файл F, компонентами которого являются целые числа.

Переписать в файл G вначале все отрицательные, затем все

нулевые, а затем все положительные числа, упорядочив их

по возрастанию модуля величины. Файл G - текстовый.

}

Program Pascal;

Const fname='num.txt';

fname2='num2.txt';

Var f,g:text;

stroka:string;

k,code,i,j,tmp:integer;

a:array[1..20] of integer;

begin

Assign(F, fName);

ReSet(F);

k:=0;

While Not Eof(F) Do

Begin

ReadLn(F, Stroka);

k:=k+1;

val(Stroka,tmp,code);

a[k]:=tmp;

writeln(a[k]);

End;

close(f);

writeln;

writeln(k);

writeln;

for i:=2 to k do

for j:= k downto 2 do

if a[j-1] > a[j] then begin

tmp := a[j-1];

a[j-1] := a[j];

a[j] := tmp;

end;

for i:=1 to k do write(a[i],' ');

Assign(g, fName2);

rewrite(g);

for i:=1 to k do begin

writeln(g,a[i]);

end;

close(g);

writeln;

readln;

end.