program spiski;
{Информационная запись о книге, выданной на руки абоненту, представляет собой структуру следующего вида: 
номер читательского билета, фамилия абонента, дата выдачи, количество дней, автор, название, год издания, цена.
Поиск - по номеру читательского билета.}
 
{1.Указатель – это переменная, в которую можно записывать адрес другой переменной (или блока памяти).}
 
{2.Односвязный список – это структура данных, в которой каждый элемент (узел) хранит информацию, а также ссылку на следующий элемент. 
Последний элемент списка ссылается на NULL.}
 
{3.Связанный список - это структура данных, в которой каждый элемент содержит указатели на другие 
элементы списка (например, на предыдущий и на следующий элемент в списке).}
 
type{Тип Для Создания Структуры Данных Списка}
  Bilet = ^BiletChitatel;{Указател Bilet Указывает На Тип Данных ^BiletChitatel}
  BiletChitatel = record {Запись Указателя ^BiletChitatel По Поиску Фамилий Преподавателя Из Типа Данных Списка BiletChitatel}
    NamberBileta: string[10]; {Номер Читательского Билета} 
    Abonent: string[25]; {Фамилия Абонента}
    DataVidhi: String[20]; {Дата Выдачи}
    ColDey: string[5]; {Количество Дней}
    Avtor: string[20]; {Автор}
    Nazvania: string[20]; {Название} 
    God: string[15]; {Год Издания}
    Cena: string[20]; {Цена} 
    adr: Bilet;{Переход К Следующей Записи Списка Из Базы данных const} 
  end;
{Первая pc1 запись списка из базы данных}
const
  pc1: BiletChitatel = (NamberBileta: '1'; Abonent: 'Саша.Н.Ю'; DataVidhi: '01.06.2019'; ColDey: '26'; Avtor: 'Баратынский.Е.А'; Nazvania: 'Война и мир'; God: '2019'; Cena: '20$'; adr: nil);
{Вторая pc2 запись списка из базы данных}
const
  pc2: BiletChitatel = (NamberBileta: '2'; Abonent: 'Наташа.Ю.Д'; DataVidhi: '01.08.2019'; ColDey: '14'; Avtor: 'Блок.А.А'; Nazvania: 'Горошена'; God: '2018'; Cena: '15$'; adr: nil);
{Вторая pc3 запись списка из базы данных}
const
  pc3: BiletChitatel = (NamberBileta: '3'; Abonent: 'Настя.А.В'; DataVidhi: '02.01.2019'; ColDey: '19'; Avtor: 'Булгаков.М.А'; Nazvania: 'Миллиардер'; God: '2017'; Cena: '10$'; adr: nil);
 
procedure out1(ph: BiletChitatel);{Процедура для чтения записей списка из базы данных const}
begin
  Writeln('************************************************************');{Вывод звёздочек переход на следующую строку}
  writeln('Номер Читательского Билета:', ph.NamberBileta);{Ввыодит Номер Читательского Билета С Базы Данных const И Осушествляет Переход На Новую Строку}
  Writeln('************************************************************');{Вывод звёздочек переход на следующую строку}
  writeln('Фамилия Абонента:', ph.Abonent);{Ввыодит Фамилия Абонента С Базы Данных const И Осушествляет Переход На Новую Строку}
  Writeln('************************************************************');{Вывод звёздочек переход на следующую строку}
  writeln('Дата Выдачи:', ph.DataVidhi);{Ввыодит Дата Выдачи С Базы Данных const И Осушествляет Переход На Новую Строку}
  Writeln('************************************************************');{Вывод звёздочек переход на следующую строку}
  writeln('Количество Дней:', ph.ColDey);{Ввыодит Количество Дней С Базы Данных const И Осушествляет Переход На Новую Строку}
  Writeln('************************************************************');{Вывод звёздочек переход на следующую строку}
  writeln('Автор:', ph.Avtor);{Ввыодит Автор С Базы Данных const И Осушествляет Переход На Новую Строку} 
  Writeln('************************************************************');{Вывод звёздочек переход на следующую строку}
  writeln('Название:', ph.Nazvania);{Ввыодит Название С Базы Данных const И Осушествляет Переход На Новую Строку} 
  Writeln('************************************************************');{Вывод звёздочек переход на следующую строку}
  writeln('Год Издания:', ph.God);{Ввыодит Год Издания С Базы Данных const И Осушествляет Переход На Новую Строку} 
  Writeln('************************************************************');{Вывод звёздочек переход на следующую строку}
  writeln('Цена:', ph.Cena);{Ввыодит Цену С Базы Данных const И Осушествляет Переход На Новую Строку} 
  Writeln('************************************************************');{Вывод звёздочек переход на следующую строку}
end;
{Функция Для Проверки Списка Из Базы Данных const Если Список Пуст То Выводит Сообщения А если Список не Пуст То Вввыодить Из Базы Данных const Наши Данные Списка}
function PPS(s: Bilet): boolean;
begin{Начало Функций}
  if s = nil then begin{Сравнивания Списка Если s = nil То Выводит Сообщения Список Пуст!}
    writeln('Список пуст!');{Вывод Список пуст! переход на следующую строку}
    pps := true;{Если  pps := true; То Выводит Нашь Список Из Базы Данных const}
  end
  else pps := false;{Сравнивания Списка Если pps := false; То Выводит Сообщения Список Пуст!}
end;{Конец Функций}
{Процедура Для Чтения Списка Из Базы Данных const А Так Же Из lista Если Мы Добавили В Базу Данных Наши Данные}
procedure OUT(S: Bilet);
var
  cursor: Bilet;
begin{Начало Процедуры}
  Writeln('Чтение списка:');{Вывод Чтение списка и осуществляется переход на следующую строку}
  cursor := S;   
  if PPS(S) then exit; 
  while cursor <> nil do 
  begin
    out1(cursor^); 
    cursor := cursor^.adr
  end;
end;{Конец Процедуры}
 
{Процедура для Поиска По Фамилий Преподавателя Осуществляется С Помощью Записи Указателя ^BiletChitatel}
procedure find(ph: Bilet; key: string);
var
  cursor: Bilet;
begin{Начало Процедуры}
  writeln('Поиск по номеру читательского билета:', key);{Идёт Поиск по номеру читательского билета И Осуществляется Переход Всех Найденых Элементов Из Базы Данных На Новую Строку}
  if pps(ph) then exit;
  cursor := ph;
  while(cursor <> nil) and (cursor^.NamberBileta <> key) do
    cursor := cursor^.adr;
  if cursor = nil then writeln('Нет элемента!'){Если Ведёного номера читательского билета Нет То Выводит Сообщения Нет Элемента!  Осуществляется Переход На Новую Строку}
  else out1(cursor^)
end;{Конец Процедуры}
 
{Процедура Для Добовления Новой Записи В Базу Данных Списка List}
procedure dop(var ph: Bilet; dat: BiletChitatel);
var
  nw, cursor, BiletChitatel: Bilet;
  key: string;
begin{Начало Процедуры}
  cursor := ph;
  BiletChitatel := nil;{nil – Это Нулевой Указатель, Он Никуда Не Указывает}
  key := dat.NamberBileta;
  New(nw);{Выделяет Память Под Новый Объект, И Сохроняется В Переменной nw}
  Nw^ := dat;
  while(cursor <> nil) and (cursor^.NamberBileta <> key) do
  begin
    BiletChitatel := cursor;
    cursor := cursor^.adr;
  end;
  Nw^.adr := cursor;
  if BiletChitatel = nil then ph := nw
  else BiletChitatel^.adr := nw;
end;{Конец Процедуры}
 
{Процедура Для Удаления Из Базы Данных Списка const или List}
procedure ud(var ph: Bilet; key: string);
var
  cursor, BiletChitatel: Bilet;
begin{Начало Процедуры}
  writeln('Удаление ', key);{Идёт Удаление По Заданному Элементу И Осуществляется Переход Остольных Элементов Из Базы Данных На Новую Строку}
  if pps(ph) then exit;
  cursor := ph;
  BiletChitatel := nil;{nil – Это Нулевой Указатель, Он Никуда Не Указывает}
  while(cursor <> nil) and (cursor^.DataVidhi <> key) do 
  begin
    BiletChitatel := cursor;
    cursor := cursor^.adr;
  end;
  if cursor = nil then begin
    writeln('Нельзя удалить!');{Если Такого Элемента Нет То Выводит Сообщения Нельзя удалить! И Осуществляется На Новую Строку} 
    exit;
  end;
  if BiletChitatel = nil then
  begin
    ph := cursor^.adr;
  end
      else
  begin
    writeln('Удаление первого элемента:');
    BiletChitatel^.adr := cursor^.adr;
  end;
  dispose(cursor);
end;{Конец Процедуры}
 
{Процедура Для Удаления Из Базы Данных Списка По Указателю BiletChitatel}
procedure del(ph: Bilet);
var
  cursor, BiletChitatel: Bilet;
begin{Начало Процедуры}
  if pps(ph) then exit;
  cursor := ph;
  BiletChitatel := nil;{nil – Это Нулевой Указатель, Он Никуда Не Указывает}
  while cursor <> nil do 
  begin
    BiletChitatel := cursor;
    cursor := cursor^.adr;
    dispose(BiletChitatel);
  end;
  Ph := nil;{nil – Это Нулевой Указатель, Он Никуда Не Указывает}
end;{Конец Процедуры}
 
var
  key: string; 
  list: Bilet; 
  zapis: BiletChitatel;
  i, j: integer;
 
begin{Основная программа}
  list := nil;
  dop(list, pc1);
  dop(list, pc2);
  dop(list, pc3);
  while True do {Бесконечный Цикл Для  Выбора Пункта Из Меню}
  begin
    Writeln('##############################################');{Вывод решоток переход на следующую строку}
    Writeln('**********************************************');{Вывод звёздочек переход на следующую строку}
    writeln('Выберите нужное действие');{Выводит Нам Выберите нужное действие и переходит на следующую строку}
    Writeln('**********************************************');{Вывод звёздочек переход на следующую строку}
    writeln('1 - Поиск по номеру читательского билета.'); {Вывод  1 - Поиск по номеру читательского билета. Осуществляет Поиск По Фамилии Если Фамилия Есть В Базе Данных}
    Writeln('**********************************************');{Вывод звёздочек переход на следующую строку}
    writeln('2 - Удаление названия.');{Вывод 2 - Удаление названия. Удаляет Элементы Записи}
    Writeln('**********************************************');{Вывод звёздочек переход на следующую строку}
    writeln('3 - Добавить запись.');{Вывод 3 - Добавить запись. Добовляет Элементы Новой Записи}
    Writeln('**********************************************');{Вывод звёздочек переход на следующую строку}
    writeln('4 - Выберите запись которую нужно вывести.');{Вывод 4 - Выберите запись которую нужно вывести. Делает Ввывод Записи}
    Writeln('**********************************************');{Вывод звёздочек переход на следующую строку}
    writeln('5 - Чтение всей записи.');{Вывод 5 - Чтение всей записи. Делает Чтение Всех Записей Из Базы Данных}
    Writeln('**********************************************');{Вывод звёздочек переход на следующую строку}
    writeln('6 - Выход.');{Вывод 6 - Выход. Делает Выход Из Цикла Закрывает Программу}
    Writeln('**********************************************');{Вывод решоток переход на следующую строку}
    Writeln('##############################################');{Вывод решоток переход на следующую строку}
    write('Введите №:');{Вывод Введите №: и осуществляется переход на следующую строку}
    read(i);{Читает Ввод Данных Пользователем}
    readln();
    case i of {Вызов разных процедур в зависимости от выбора пункта меню}
      1: 
        begin
          Writeln('##############################################');{Вывод решоток переход на следующую строку}
          write('Введите номер читательского билета для поиска:');{Вывод Введите номер читательского билета для поиска и осуществляется переход на следующую строку}
          read(key);
          read();
          find(list, key);
          Writeln('##############################################');{Вывод решоток переход на следующую строку}
        end;
      2: 
        begin
          Writeln('##############################################');{Вывод решоток переход на следующую строку}
          write('Введите Номер Читательского Билета, которого надо удалить:');{Вывод Введите Номер Читательского Билета, которого надо удалить и осуществляется переход на следующую строку}
          read(key);
          read();
          ud(list, key);
          writeln('Запись с номером читательского билета ', key, ' был удален, остались записи:');{Вывод Запись с номером читательского билета ', key, ' был удален, остались записи и осуществляется переход на следующую строку}
          out(list);
          Writeln('##############################################');{Вывод решоток переход на следующую строку}
        end;
      3: 
        begin
          Writeln('************************************************************');{Вывод звёздочек переход на следующую строку}
          Write('Номер Читательского Билета:');{Ввыодит Номер Читательского Билета}
          Readln(Zapis.NamberBileta);{Требует Добавить Новую Запись Для Данного Элемента}
          Writeln('************************************************************');{Вывод звёздочек переход на следующую строку}
          Write('Фамилия Абонента:');{Ввыодит Фамилия Абонента}
          Readln(Zapis.Abonent);{Требует Добавить Новую Запись Для Данного Элемента}
          Writeln('************************************************************');{Вывод звёздочек переход на следующую строку}
          Write('Дата Выдачи:');{Ввыодит Дата Выдачи}
          Readln(Zapis.DataVidhi);{Требует Добавить Новую Запись Для Данного Элемента}
          Writeln('************************************************************');{Вывод звёздочек переход на следующую строку}
          Write('Количество Дней:');{Ввыодит Количество Дней}
          Readln(Zapis.ColDey);{Требует Добавить Новую Запись Для Данного Элемента}
          Writeln('************************************************************');{Вывод звёздочек переход на следующую строку}
          Write('Автор:');{Ввыодит Автор}
          Readln(Zapis.Avtor);{Требует Добавить Новую Запись Для Данного Элемента}
          Writeln('************************************************************');{Вывод звёздочек переход на следующую строку}
          Write('Название:');{Ввыодит Название}
          Readln(Zapis.Nazvania);{Требует Добавить Новую Запись Для Данного Элемента}
          Writeln('************************************************************');{Вывод звёздочек переход на следующую строку}
          Write('Год Издания:');{Ввыодит Год Издания}
          Readln(Zapis.God);{Требует Добавить Новую Запись Для Данного Элемента}
          Writeln('************************************************************');{Вывод звёздочек переход на следующую строку}
          Write('Цена:');{Ввыодит Цену}
          Readln(Zapis.Cena);{Требует Добавить Новую Запись Для Данного Элемента}
          dop(list, zapis);{Дополняет Новую Запись Элементов В Базу Данных const}
          Writeln('************************************************************');{Вывод звёздочек переход на следующую строку}
          out(list);{Добавляет Новую Запись Элементов В Базу Данных List}
        end;
      4:
        begin
          write('Выберите, какую запись вывести на экран:');{Ввыодит Выберите, какую запись вывести на экран:}
          read(j);
          read();
          case j of 
            1: out1(pc1);
            2: out1(pc2);
            3: out1(pc3);
          else
            Writeln('##############################################');{Вывод решоток переход на следующую строку}
            writeln('Такой записи нету в базе данных!');{Ввыодит Такой записи нету в базе данных! и осуществляется переход на следующую строку}
            Writeln('##############################################');{Вывод решоток переход на следующую строку}
          end;
        end;
      5: 
        begin
          Writeln('##############################################');{Вывод решоток переход на следующую строку}
          writeln('Вывод всех записей которые есть в базе данных:');{Выводит Вывод всех записей которые есть в базе данных: и осуществляется переход на следующую строку}
          out(list);
          Writeln('##############################################');{Вывод решеток переход на следующую строку}
        end;
      6: break;{Осуществляет Выход Из Цикла И Закрывает Нашу Программу}
    end;
  end;
end.{Конец Программы}

program Stek;

uses
  crt;{Для использования readkey и clrscr}

type
  Tinf = integer;{тип данных, который будет храниться в элементе стека}
  List = ^TList;{Указатель на элемент типа TList}
  TList = record {А это наименование нашего типа "запись" обычно динамические структуры описываются через запись}
    data: TInf;  {данные, хранимые в элементе}
    next: List; {указатель на следующий элемент}
  end;

{Процедура добавляющая элемент в стек}
procedure AddElem(var stek1: List; znach1: TInf);
var
  tmp: List;
begin
  GetMem(tmp, sizeof(TList)); {выделяем в памяти место для нового элемента}
  tmp^.next := stek1;  {указатель на следующий элемент "направляем" на вершину стека}
  tmp^.data := znach1; {добавляем к элементу данные}
  stek1 := tmp; {вершина стека изменилась, надо перенести и указатели на неё}
end;

{Процедура вывода стека}
procedure Print(stek1: List);
begin
  if stek1 = nil then {проверка на пустоту стека}
  begin
    writeln('Стек пуст.');
    exit;
  end;
  while stek1 <> nil do {пока указатель stek1 не станет указывать в пустоту}
  begin{а это произойдёт как только он перейдёт по ссылке последнего элемента}
    Write(stek1^.data, ' '); {выводить данне}
    stek1 := stek1^.next{и переносить указатель вглубь по стеку}
  end;
end;

procedure change(var yk: List);
var
  tmp, tmp1: List;
begin
  if yk = nil then
    exit;
  tmp := yk;
  while tmp^.next <> nil do
    tmp := tmp^.next;  {ставим tmp на последний элемент}
  tmp1 := yk;
  while tmp1^.next <> tmp do {tmp1 ставим на предпоследний элемент}
    tmp1 := tmp1^.next;
  if tmp1 = yk then {в стеке два элемента}
  begin
    yk^.next := nil;
    tmp^.next := yk;
    yk := tmp;
  end
  else
  begin
    tmp1^.next := yk;
    tmp^.next := yk^.next;
    yk^.next := nil;
    yk := tmp;
  end;
end;

{Процедура освобождения памяти занятой стеком}
procedure FreeStek(stek1: List);
var
  tmp: List;
begin
  while stek1 <> nil do {пока stek1 не станет указывать в "пустоту" делать}
  begin
    tmp := stek1; {указатель tmp направим на вершину стека}
    stek1 := stek1^.next; {вершину стека перенесём на следующий за данной вершиной элемент}
    FreeMem(tmp, sizeof(Tlist)); {освободим память занятую под старую вершину}
  end;
end;

var
  yk: List; {Указатель на "начало" стека}
  n: integer;
  znach: Tinf;

begin
  randomize;
  repeat
    clrscr;
    Writeln('Введите количество элементов в стеке ');
    Write('N= ');
    readln(n);
  until n > 0;
  while n > 0 do
  begin
    znach := random(1000);
    AddElem(yk, znach);
    dec(n);
  end;
  clrscr;
  Writeln('Стек до уменьшения ');
  Print(yk);
  change(yk);
  Writeln;
  Writeln('Стек после уменьшения ');
  Print(yk);
  readln;
  FreeStek(yk);
end.