Пример 1.5.

program Number_1_5;

uses Crt;

{Создать список студентов и найти среди них однофамильцев}

const {список альтернатив для работы меню}

alter:array[1..5] of string[30]=(

'1.Создать файл',

'2.Создать список',

'3.Сортировка ',

'4.Вывод однофамильцев',

'5.Выход из программы');

type

list_d = record { Структура- запись }

Title : string[20]; { Фамилия }

Nm,Pt : string[15]; { Имя,отчество }

Number : integer; { Номер по порядку }

end;

ff=file of list_d;{список для сохранения исходных данных в файле, чтобы проще было отлаживать и проверять решение}

pEl_list = ^list; { Указатель на структуру - список }

list = record { Структура - список }

li : list_d;

next : pEl_list; {Ссылка на следующий элемент списка}

end;

Var lp,pList,pStart : pEl_list;

f :ff;

li :list_d;

noswap: boolean;{Для проверки выполнения сортировки}

ch: char;{Для самого простого варианта чтения символов}

I,oi,kol: integer; {переменные для работы с меню}

procedure init;

begin

pStart:=nil;

end;

procedure DeleteList;

{Уничтожаем список для того, чтобы освободить память при сохранении списка, допустим, в файле}

begin

lp:=pStart;

while lp <> nil do begin

pList:=lp;

Dispose(pList); {Уничтожается очередной элемент списка}

lp:= lp^.Next; {Перемещаемся по списку}

end;

end; { DeleteList }

{-------------------------------}

procedure Insert_list(el: list_d);

begin { Элемент вставляется следующим в списке}

new(pList);

if pStart =nil then

begin

with pList^ do

begin

li.Title:=el.title;

li. Nm :=el.Nm;

li.Pt :=el.Pt;

li.Number:=el.Number;

next :=nil;

end;

pStart:=pList;{Запоминаем начало списка}

lp:=pList; {А это текущий элемент списка, при одном элементе в списке - это первый элемент списка}

end

else

begin

lp^.next:=pList;

with pList^ do

begin

li.Title:=el.title;

li. Nm :=el.Nm;

li.Pt :=el.Pt;

li.Number:=el.Number;

next :=nil;

end;

lp:=pList;{Движение по списку обеспечено}

end;

end; { InsertEl }

{-------------------------------}

procedure SaveBase_in_file;

{ Сохранение введенных данных в файле позволяет не вводить одну и туже информацию}

var

FileName : string[12];

k :char;

begin

FileName := 'Wnd.bas';

Assign(f, FileName);

Rewrite(f);

repeat

with li do

begin

write(' Вводите список: фамилия ');

Readln(title);

write( ' Имя ');

readln(Nm);

write(' Отчество ');

readln(Pt);

write(' Номер ');

readln(Number);

end;

write(f,li);

writeln('Есть еще сведения для списка?');

readln(k);

until k='n';

Close(f);

Writeln( 'Данные сохранены. Нажмите любую клавишу ...');

ReadKey;

end; { SaveBase_in_file}

procedure List_creat;

{Создание обычного списка при чтении данных из файла Файл по умолчанию устанавливается для решения задачи с любым произвольным именем }

begin

Init;

Assign(f,'Wnd.bas');

reset(f);{Проверку наличия файла опускаем, предполагая уже известными эти действия }

while not eof(f) do

begin

read(f,li);