program kursov;
uses crt;
type
student=record
  name:string[23];                        {имя и инициалы}
  number:integer;                         {номер группы}
  ball:array[1..5] of integer;            {успеваемость}
  srball:real;			          {средняя оценка}
end;

var
  f1,f2:file of student;                 {файловая переменная массива}
  zap:student;
  repeatkey:char;
  num:integer;                           {общее количество записей в массиве}
  i,j:integer;
  gg,gg2,gg3,sor:longint;
  sel:integer;                           {выбор пункта меню}
  sum:longint;                           {сумма значений полей}
  m1,m2:student;                         {для сортировки записей}
  s:boolean;                             {ключ сортировки}
  filename:string;                       {имя файла с записями}
  z:string;                              {фильтрация пробелов}
  pball:string[9];                       {Оценки для ввода и вывода}
   
{описание вспомогательных процедур}
{!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!}
procedure shapka;                         {заголовок таблицы}
	begin
		writeln ('                      ТАБЛИЦА ЗАПИСЕЙ');
		writeln;
		writeln ('г=========================T============T==============T==========¬');
		writeln ('¦      ФАМИЛИЯ И.О.       ¦  № Группы  ¦ Успеваемость ¦ Ср. Балл ¦');
		writeln ('¦=========================+============+==============+==========¦');
	end;
{!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!}
procedure undertable;                         {низ таблицы}
	begin
		writeln ('L=========================¦============¦==============¦==========-');
	end;
{!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!}
procedure nofile;                         {отсутствие файла}
	begin
		clrscr;
		writeln;
		writeln ('                          Ошибка!');
		writeln ('        Файл ',filename,' отсутсвует! Нажмите Enter.');
		readkey;
	end;
{!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!}
procedure opening;                         {процедура открытия файла с f1}
	begin
		writeln;
		write ('                      Введите имя файла ');
		readln (filename);
		assign (f1,filename);
	end;
{!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!}
procedure printing;                         {процедура вывода текущей строки}
	begin
		with zap do
			begin
				write ('¦ ',name:23,' ¦ ');
				write (number:10,' ¦ ');
				pball:='';
{формирование строки оценок и вывод на экран}
				for i:=1 to 5 do pball:=pball+chr(ord(ball[i]+48))+' ';
				write(pball:12,' ¦ ');
				write (srball:8:2,' ¦');
				writeln;
			end;
	end;
{!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!}
procedure obmen;
	begin
		sor:=sor-2;
		seek(f1,sor);
		write(f1,m2);
		write(f1,m1);
		sor:=sor+2;
		sor:=sor-1;
		seek(f1,sor);
	end;
{!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!}
procedure editforedit;					{Процедура выбора пункта изменения и изменения}
	begin
		repeat
		clrscr;
		Writeln('                       Вы хотите изменить:');
		Writeln('                        -----------------------');
		Writeln('                            1. Фамилию И.О.');
		Writeln('                            2. Номер группы');
		Writeln('                            3. Успеваемость');
		Writeln('                        -----------------------');
		Write('                       >>');
		Readln(sel);
		clrscr;
		writeln;
		writeln ('                        ЗАПИСЬ ',gg);
		writeln;
		writeln ('                      Введите новые данные: ');
		writeln;
		case sel of
		1:begin
			write ('                      Фамилия И.О. ');
			readln (zap.name);
			writeln;
			writeln('                     Фамилия в записи ',gg,' изменена');
		end;
		2:begin
			write ('                      № Группы ');
			readln (zap.number);
			writeln;
			writeln('                     № Группы в записи ',gg,' изменен');
		end;
		3:begin
			Writeln ('                    Успеваемость');
			writeln ('                    Введите оценку ');
			for j:= 1 to 5 do
			begin
				write ('                       №',j,' ');
				readln (zap.ball[j]);
			end;
{Подсчет Среднего Балла}
			sum:=0;
			for j:=1 to 5 do
			sum:=sum+zap.ball[j];
			zap.srball:=sum/5;
			writeln;
			writeln('                     Успеваемость в записи ',gg,' изменена');
		end;
		end;
		clrscr;
		Writeln;
		Write('   Вы хотите изменить что нибудь ещё? [Y/N] либо [Д/Н] ');
		Readln(repeatkey);
		until (UpCase(repeatkey) in ['N','Н']);
		seek(f1,gg-1);
		write(f1,zap);
	end;

{Основные подпрограммы 1-7}
{!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!}
procedure create;                             {процедура создания нового файла}{(1 подпрограмма)}
	begin
		clrscr;
		Writeln('          Введите имя файла');
		Write('        ');
		Readln(filename);
		Assign(f1,filename);
		Rewrite(f1);
		Writeln('          Файл с именем ',filename,' создан. Нажмите ENTER.');
		readkey;
		close(f1);
	end;                             {процедура создания нового файла}{(конец 1 подпрограммы)}
{!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!}
procedure enter; 			{процедура добавления записи в файл}{(2 подпрограмма)}
	begin
		clrscr;					{ассоциация с файлом и переход в конец}
		writeln ('                      ДОБАВЛЕНИЕ ЗАПИСЕЙ В ФАЙЛ');
		opening;
		{$I-}
		reset (f1);
		{$I+}
		if IOResult=0 then
		begin
			if not eof(f1) then
			begin
				gg:=filesize(f1);
				seek(f1,gg);
			end;
		clrscr;
		writeln ('                      ВВОД ЗАПИСЕЙ');
		writeln;
		write ('                      Введите количество записей ');
		readln (num);
		for i:=1 to num do
		begin
			clrscr;
			writeln;
			writeln ('                      ЗАПИСЬ ',i);
			with zap do
			begin
				write ('                      Фамилия И.О. ');
				readln (name);
				write ('                      № Группы ');
				readln (number);
				Writeln ('                    Успеваемость');
				writeln ('                    Введите оценку ');
				for j:= 1 to 5 do
					begin
						write ('                       №',j,' ');
						readln (ball[j]);
					end;

{Подсчет Среднего Балла}
				sum:=0;
				for j:=1 to 5 do
				sum:=sum+ball[j];
				srball:=sum/5;

			end;

			write(f1,zap);

		end;
		close(f1);
		end
		else nofile;
	end; 			{процедура добавления записи в файл}{(конец 2 подпрограммы)}
{!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!}
procedure udalen;                             {процедура удаления записи}{(3 подпрограмма)}
	begin
		clrscr;
		writeln ('                      УДАЛЕНИЕ ЗАПИСИ ИЗ ФАЙЛА');
		opening;
		{$I-}
		reset (f1);
		{$I+}
		if IOResult=0 then
			begin
				assign (f2,'buf');
				rewrite (f2);
				clrscr;
				writeln ('                      УДАЛЕНИЕ ЗАПИСИ');
				writeln;
				write ('                      Введите номер записи ');
				readln (num);
				for i:=1 to num-1 do
				begin
					read(f1,zap);
					write(f2,zap);
				end;
				read(f1,zap);
				while (not(eof(f1))) do
				begin
					read(f1,zap);
					write(f2,zap);
				end;
				close(f1);
				close(f2);
				erase(f1);
				rename(f2,filename);
				clrscr;
				Writeln('          Запись ',num,' удалена. Нажмите ENTER.');
				readkey;
			end
		else nofile;
	end;                             {процедура удаления записи}{(конец 3 подпрограммы)}
{!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!}
procedure edit;                             {процедура корректировки записи}{(4 подпрограмма)}
	begin
		clrscr;
		repeatkey:=' ';
		writeln ('                      КОРРЕКТИРОВКА ЗАПИСИ В ФАЙЛЕ');
		opening;
		{$I-}
		reset (f1);
		{$I+}
		if IOResult=0 then
			begin
				repeat
				clrscr;
				writeln ('                      КОРРЕКТИРОВКА ЗАПИСИ');
				writeln;
				write ('                      Введите номер записи ');
				readln (gg);
				seek(f1,gg-1);
				read(f1,zap);
				editforedit;
				clrscr;
				Writeln;
				Write('   Вы хотите изменить другую запись? [Y/N] либо [Д/Н] ');
				Readln(repeatkey);
				until (UpCase(repeatkey) in ['N','Н']);
				close(f1);
			end
		else nofile;
	end;                             {процедура корректировки записи}{(конец 4 подпрограммы)}
{!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!}
procedure view;                         {вывод массива на экран}{процедура просмотра файла}{(5 подпрограмма)}
	begin
		clrscr;
		writeln ('                      ПРОСМОТР ФАЙЛА');
		opening;
		{$I-}
		reset (f1);
		{$I+}
		if IOResult=0 then
		begin
			clrscr;
			shapka;
			while (not Eof(f1)) do
				begin
					read(f1,zap);
					with zap do
					printing;
				end;
			undertable;
			readkey;
		end
		else nofile;
	end;                         {вывод массива на экран}{процедура просмотра файла}{(конец 5 подпрограммы)}
{!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!}
procedure sort;                             {процедура сортировки по номеру группы}{(6 подпрограмма)}
	begin
		sor:=0;
		clrscr;
		writeln ('                      СОРТИРОВКА ФАЙЛА');
		opening;
		{$I-}
		reset (f1);
		{$I+}
		if IOResult=0 then
		begin
			clrscr;
			gg2:=1;
			gg:=filesize(f1);
{начало  сортировки}
			while gg>gg2 do
			begin
				for gg3:=gg2 to gg-1 do
				begin
					read(f1,m1);
					read(f1,m2);
					sor:=sor+2;
					if m1.number>m2.number then obmen else begin sor:=sor-1; seek(f1,sor); end;
				end;
				gg2:=gg2+1;
				sor:=0;
				seek(f1,0);
			end;
			Writeln('           Сортировка файла завершена. Нажмите ENTER.');
			readkey;
		end
		else nofile;
	end;                             {процедура сортировки по номеру группы}{(конец 6 подпрограммы)}
{!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!}
procedure disp;                             {процедура вывода на дисплей при условии}{(7 подпрограмма)}
	begin
		clrscr;
		writeln;
		opening;
		{$I-}
		reset (f1);
		{$I+}
		if IOResult=0 then
		begin
			clrscr;
			shapka;
			s:=false;

			while (not Eof(f1)) do
			begin
				read(f1,zap);
				with zap do
				if srball>4 then
				begin
					printing;
					s:=true;
				end;
			end;
			if s=false then writeln ('¦ Поиск неудачен          ¦            ¦              ¦          ¦');
			undertable;
			readkey;
		end
		else nofile;
	end;                             {процедура вывода на дисплей при условии}{(конец 7 подпрограммы)}
{!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!}
BEGIN
	repeat
	clrscr;
	writeln;
	writeln ('                      КУРСОВАЯ РАБОТА');
	writeln;
	writeln;
	writeln ('                  База данных ======== СТУДЕНТЫ');
	writeln;
	writeln ('                  ------------------------------------');
	writeln ('                     1. Создание файла');
	writeln ('                     2. Добавление записи в файл');
	writeln ('                     3. Удаление указанной записи');
	writeln ('                     4. Корректировка указанной записи');
	writeln ('                     5. Просмотр файла');
	writeln ('                     6. Сортировка по возрастанию номера группы');
	writeln ('                     7. Вывод на дисплей при условии ср. балл >4.0');
	writeln ('                     8. Выход');
	writeln ('                  ------------------------------------');
	writeln;
	write   ('                  > ');
	readln (sel);
	case sel of
		1:create;
		2:enter;
		3:udalen;
		4:edit;
		5:view;
		6:sort;
		7:disp;
		8:break;
	end;
	until false;
END.