Главная

Контакты

Случайная статья

• Автоматизация
• Антропология
• Археология
• Архитектура
• Биология
• Ботаника
• Бухгалтерия
• Военная наука
• Генетика
• География
• Геология
• Демография
• Деревообработка
• Журналистика
• Зоология
• Изобретательство
• Информатика
• Искусство
• История
• Кинематография
• Компьютеризация
• Косметика
• Кулинария
• Культура
• Лексикология
• Лингвистика
• Литература
• Логика
• Маркетинг
• Математика
• Материаловедение
• Медицина
• Менеджмент
• Металлургия
• Метрология
• Механика
• Музыка
• Науковедение
• Образование
• Охрана Труда
• Педагогика
• Полиграфия
• Политология
• Право
• Предпринимательство
• Приборостроение
• Программирование
• Производство
• Промышленность
• Психология
• Радиосвязь
• Религия
• Риторика
• Социология
• Спорт
• Стандартизация
• Статистика
• Строительство
• Технологии
• Торговля
• Транспорт
• Фармакология
• Физика
• Физиология
• Философия
• Финансы
• Химия
• Хозяйство
• Черчение
• Экология
• Экономика
• Электроника
• Электротехника
• Энергетика

Задание 4. Program Task4;. Задание 5. Program Task5;

Задание 4

Program Task4;

uses crt;

Type

AOS = Array [1..80] of String;

var

St: String;

Words: AOS;

ch: char;

inf, outf: text;

i,dim:byte;

function GetWords(S: String; var Arr: AOS): integer;

var

i,Len,k:word;

begin

Len := Length(S);

k:=1;

i:=1;

Arr[k]:='';

while i<=Len do

if S[i] <> ' ' then

  begin

    Arr[k] := Arr[k] + S[i];

    inc(i);

  end

Else

  begin

    inc(k);

    Arr[k] := '';

    while (S[i] = ' ') and (i <= Len) do

          inc(i);

  end;

if Arr[k] = '' then

GetWords:=k-1

else

GetWords:=k;

end;

procedure CreatePrilTxt;

var f: text; s: string;

begin

assign(f,'FisEd.txt');

rewrite(f);

writeln('Вводите строки с физическими величинами.');

writeln('Окончание ввода данных обозначьте командой ^STOP');

s := '';

repeat

readln(s);

if S <> '^STOP' then

  writeln(f,S);

until S = '^STOP';

close(f);

end;

Begin

writeln('Укажите режим работы программы');

writeln('(1 - создание исходного файла; 2 - создание результирующего файла)');

repeat

   Ch := readkey;

until (Ch = '1') or (Ch = '2');

if Ch = '1' then

CreatePrilTxt

else

begin

   assign(Inf, 'FisEd.txt');

   reset(inf);

   assign(Outf,'Dlin.txt');

   rewrite(Outf);

   while not eof(Inf) do

     begin

        readln(inf,St);

       writeln('Считанастрока '+St);

        Dim := GetWords(St, Words);

        for i:=1 to dim do

             if Pos('metr',Words[i]) <> 0 then

              begin

               writeln(outf,Words[i]);

               writeln('Записанослово ' +Words[i]);

              end;

     end;

   close(inf);

   close(outf);

   readln;

end;

End.

Задание 5

Program Task5;

uses crt;

const

NMax = 20;

Type

FStadt = record

Staate: string;

Stadt: string;

   Platz: real;

End;

FStadtArray = array [1..NMax] of FStadt;

FOC = File Of FStadt;

Var

PCs : FStadtArray;

S: String;

Res: FStadt;

Ch: char;

F: FOC;

FName:String;

}

procedure InputFS(Var ST:FStadt);

begin

with ST do begin

  write('Страна-> ');

  readln(Staate);

  write('Столица-> ');

  readln(Stadt);

  write('Площадь: ');

  readln(Platz);

end;

end;

procedure PrintPC(ST:FStadt);

begin

with ST do begin

  write('Страна: ');

  readln(Staate);

  write('Столица: ');

  writeln(Stadt);

  write('Площадь: ');

  writeln(Platz:7:2);

end;

end;

procedure PrintFile(FileName:String);

var ST:FStadt; f:FOC; counter:word;

begin

if FileName = '' then begin

   write('‚ўҐ¤ЁвҐ Ёп ўе®¤­®Ј® д ©« -> ');

   readln(FileName);

end;

assign(f, FileName);

reset(f);

counter:=0;

while not eof(f) do

begin

     inc(counter);

     read(f,ST);

     write('Љ®ЇмовҐа ь ');

     writeln(counter);

     PrintPC(ST);

end;

end;

procedure createfile(var FileName:String);

var ST:FStadt; f: FOC; fi,dim:byte;

begin

if FileName = '' then begin

   write('‚ўҐ¤ЁвҐ Ёп ᮧ¤ ў Ґ®Ј® д ©« -> ');

   readln(FileName);

end;

assign(f,FileName);

rewrite(f);

write('‚ўҐ¤ЁвҐ Є®«ЁзҐбвў® § ЇЁбҐ© -> ');

readln(dim);

for fi:=1 to dim do

    begin

         InputFS(ST);

         write(f,ST);

    end;

close(f);

end;

{Џа®жҐ¤гал Ё дг­ЄжЁЁ, ўлЇ®«­пойЁҐ § ¤ зЁ Ё§ ’‡}

function AvgPlatz(FileName: String): real;

var dim: byte; Max: real;f:FOC;Stadters: FStadtArray;

begin

if FileName = '' then begin

   write('‚ўҐ¤ЁвҐ Ёп ўе®¤­®Ј® д ©« -> ');

      readln(FileName);

end;

assign(f, FileName);

reset(f);

dim:=0;

Max := 0;

while not eof(f) do begin

  read(f,Comp);

  begin

     if dim = 0 then

    AvgPlatz := 0

  else

  begin

 Max:=0;

    for fi := 1 to dim do

 Max := Stadters[1].Platz;

 For fi := 2 To dim Do

      If Max < Stadters[fi].Platz Then

         Max := Stadters[fi].Platz;

    AvgPlatz:= Max;

    close(f);

    end;

  end;

function SearchByStaate(SearchString,FileName:String; var Result:FStadtArray):boolean;

var f:FOC;Stadters:FStadtArray;

begin

function SearchByName(SearchString,FileName:String; var Result:TComp):boolean;

var f:FOC; Comp:TComp;

begin

if FileName = '' then begin

   write('‚ўҐ¤ЁвҐ Ёп ўе®¤­®Ј® д ©« -> ');

   readln(FileName);

end;

assign(f, FileName);

reset(f);

while not eof(f) do begin

      read(f,Comp);

      if Stadters.Staate = SearchString then begin

        Result:=Stadters;

         SearchByName:=true;

         exit;

      end;

end;

result.Staate :='';

result.Stadt :=0;

result.Platz:=0;

SearchByName:=false;

end;

Begin

CreateFile(Fname);

write('Самая большая площадь: ');

writeln( AvgPlatz(Fname):7:3 );

writeln('Нажмите любую клавишу...');

readkey;

SortDesc(fname);

writeln('Упорядоченный список:');

PrintFile(Fname);

writeln('Нажмите любую клавишу...');

readkey;

repeat

     write('Введите искомое наименование -> ');

     readln(S);

     if not SearchByName(S,Fname,Res) then

        writeln('Искомый объект не найден!');

     else

         PrintPC(Res);

     writeln;

        write('Повторить поиск с новыми условиями? (y/n) ');

     readln(Ch);

until (upcase(Ch) <> 'Y');

End.