Определение количества абитуриентов, проживающих в городе Минске

link = ^kom;
   kom  = record
             fio : string[30];
           adres : string[50];
             mat : integer;
             fiz : integer;
             rus : integer;
            next : link;
          end;

Type
 Tspisok=^vs;
 vs=record
    data:integer;
    next:Tspisok { в данном случае можно было написать:
    next:^vs; всё должно было бы быть в порядке}
  end;

var
  spisok,nach:Tspisok; {переменная spisok - будет рабочей переменной, 
  именно она будет "перемещаться" в памяти, 
  а nach -будет указывать на первый элемент списка, 
  что-бы нам не потерять данные из списка}

begin
  for i:=1 to 10 do {Не забудьте объявить i в разделе var}
  begin
    { вот теперь возможны два варианта выделения памяти
      либо Getmem(tmp,sizeof(vs));
      либо new(tmp^.next);
      Следует запомнить что использовать надо какую-нибудь одну из них}
    if i=1 then
    begin
      New(spisok);
      nash:=spisok {надо "придумать" как запомнить первый элемент списка}
    end
    else
    begin
      New(spisok^.next); {для списков, стеков, деревьев и т.д. использую её, 
      т.к. у нас переменная next сразу связывается с адресом в памяти,
      где выделилась очередная переменная}
      {Но хочется заметить, что сам указатель "spisok" никуда не сместился,
       так что надо его "передвинуть" на новый элемент}
      spisok:=spisok^.next;
    end;
    spisok^.next:=nil; {Вот это очень важное действие! 
    Никогда не забывайте обнулить указатель на "следующий элемент"
    (здесь имеется ввиду предназначение данного указателя,а не сам элемент),
    не то может кончиться это всё плачевно}
    spisok^.data:=i; {собственно заносим сами данные}
    { рассмотрим строку "spisok^.data": 
     ^ этот знак указывает, что мы работаем с адресами памяти
      . указывает, что мы работает с записями(record)
      ну а дальше у нас переменные идут, тут всё ясно}
  end;

  spisok:=nach; {"Ставим" наш указатель на первый элемент списка}
  {Я надеюсь Вы помните, что сейчас указатель 
  spisok^.next указывает на второй элемент списка}
  while spisok<>nil do {Пока список не будет указывать в "никуда",}
  begin                              {т.е. Nil="никуда","пустота"}
    write(spisok^.data, ' ');
    spisok:=spisok^.next {произошёл переход на следующий элемент}
  end;
  Writeln;
  {тепер следует освободить память, которую мы заняли под наш список}
  while nach<>Nil do
  begin
    spisok:=nach;
    nach:=nach^.next;
    dispose(spisok) {именно dispose, т.к. при выделении я использовал New.
    Если бы при выделении я использовал GetMem, то при освобождении
    следовало бы использовать FreeMem}
  end;
  readln
end.

unit base;
   INTERFACE
  Uses crt;
        type spisok=record
            nom:string;
            marka:string;
            famil:string;
            cvet:string;
              end;
FT= file of spisok;
    const parol='vova';
    Var a:ft;
        i,q,z:integer;
        s:real;
        d:string;
   Procedure Sozdanie (var a:ft);  {процедура создания списка}
   Procedure vyvod (var a:ft);     {процедура вывода списка}
   procedure delete (var a:ft);     {процедура удаленя}
   Procedure poisk (var a:ft);     {процедура поиска по номеру}
 
 
    IMPLEMENTATION
 
 {---------процедура создания списка--------}
 
Procedure Sozdanie (var a:ft);
Var i,j:integer;
    zk:spisok;
    ch:char;
begin
rewrite (a);
j:=1;
 while j<>10 do
          begin
          write ('Введите номер автомобиля ');
          readln (zk.nom);
          write ('Введите марку ');
          readln (zk.marka);
          write ('Введите фамилию');
          Readln (zk.famil);
          write ('Введите цвет автомобиля');
          readln (zk.cvet);
          write (a,zk);
          writeln ('Если конец записи нажмите 10');
      writeln ('Для продолжения нажмите любую цифру');
          readln (j);
          end;
close (a);
end;
 
{-------процедура вывода списка--------}
 
Procedure vyvod (var a:ft);
Var i:integer;
    zk:spisok;
begin
reset (a);
 writeln ('==================================================');
 writeln ('| №    |   Марка*     |   Фамилия     |   Цвет  |');
 writeln ('==================================================');
  while not eof(a) do
   begin
    read (a,zk);
    write ('|',zk.nom:6,'|');
    write ('|',zk.marka:9,'|');
    write ('|',zk.famil:6,'|');
    write ('|',zk.cvet:9,'|');
    writeln;
    writeln ('--------------------------------------------------');
   end;
 close (a);
end;
 
{----процедура удаления-------{у меня она правда Не корректно работает}}
 
procedure delete (var a:ft);
Var n,m:longint;
      i:byte;
      mas:array [1..20] of spisok;
begin
 i:=1;
 reset(a);
 writeln ('Введите номер записи для удаления');
 readln(n);
 m:=filesize(a)-n;
 seek (a,n);
 while not eof(a) do
           begin
            read (a,mas[i]);
            i:=i+1;
           end;
   close (a);
   reset (a);
   seek (a,n-1);
   truncate (a);
   close (a);
   reset (a);
   seek (a,n-1);
   for i:=1 to m do
    write (a,mas[i]);
end;
 
{----------процедура поиска по номеру--------}
 
Procedure poisk (var a:ft);
var i:integer;
    zk:spisok;
    name:string;
begin
reset (a);
 writeln ('Введите номер поиска* ');
 readln (name);
 writeln ('Список с заданным номером');
 writeln ('=================================');
 writeln ('| #| Марка*| Фамилия | Цвет|');
 writeln ('=================================');
 while not eof(a) do
 begin
  read (a,zk);
  if zk.nom=name then
  begin
    write ('|',zk.nom:6,'|');
    write ('|',zk.marka:9,'|');
    write ('|',zk.famil:6,'|');
    write ('|',zk.cvet:9,'|');
    writeln;
    writeln ('-------------------------------');
  end;
 end;
close(a);
end;
    END.

uses crt,base;
var ch:char;
 
begin
clrscr;
{--------ВВОд пароля-------}
 {       for q:=1 to 3 do
   begin
   textcolor(red);
        write('Введите пароль');
 
        readln(d);
      if d=parol then break
         else if q<>3 then
         begin
    writeln; writeln('Не верный пароль');
    continue;
    end;
    writeln;
    writeln('Вы исчерпали лимит ввода, программа заблокирована');
    writeln('Нажмите ENTER');
    readln;
    halt end;
     GotoXY(35,10);
    writeln('Правильно');
    readln;}
{----------создание меню---------} 
repeat;
 clrscr;
 assign(a,'fff');
 window(1,1,80,5);
     clrscr;
     TextColor(lightgreen);
        gotoxy(37,1);
     
writeln ('     МЕНЮ     ');
     gotoxy (1,2);
writeln ('F1:Создание');
        gotoxy(13,2);
writeln ('F2:Вывод списка*');
        gotoxy(30,2);
writeln ('F3:Удаление из списка*  ');
        gotoxy(52,2);
writeln ('F4:Поиск по номеру');
        gotoxy(72,2);
writeln ('ESC:Выход');
 
  ch:=readkey;
  case ch of
  #59:sozdanie (a);   {клавиша F1}
  #60:vyvod (a);      {клавиша F2}
  #61:delete(a);      {клавиша F3}
  #62:poisk (a);      {клавиша F4}
  #27:exit;           {клавиша ESC}
  end;
  until ch=#27;
  clrscr;
end.

link = ^kom;
   kom  = record
             fio : string[30];
           adres : string[50];
             mat : integer;
             fiz : integer;
             rus : integer;
            next : link;
          end;

type link = ^kom;
       kom  = record
             fio : string[30]; adres : string[50];
             mat : integer;   fiz : integer; rus : integer;    
             next : link;
          end;
var spisok,nach:link; z: kom;  i, n: integer;
....
begin...
 - можно ввести кол-во элементов списка и заводить их потом в цикле 
 write('ВВедите кол-во элементов списка: '); readln(n);
 nach := nil; spisok:= nil;
 for i:=1  to n do
 begin writeln('Ввод ', i, ' элемента списка: ');
         writeln(' FIO ', z.fio);  writeln(' Adres ', z.adres);  
         write(' Оценки (мат, физика, русс-й) через пробел: '); readln(z.mat, z.fiz, z.rus);
         z.next := nil;  
         - все, это z добавляйте в список, выше уже писали
         if nach = nil then 
         begin new(nach); nach^ := z; spisok := nach; 
         end
         else new(spisok^.next); spisok:=spisok^.next; 
               spisok^ := z;
         end;
 end;
.................

spisok:=nach;
i:=0;
if spisok=nil then writeln('Список пуст!')
else
begin
  writeln('В листе содержится');
  while spisok<>nil do
  begin
      i:=i+1;
      writeln(i,') ',spisok^.fio,' ',spisok^.adres,' ',spisok^.mat,' ',spisok^.fiz,' ',spisok^.rus);
      spisok:=spisok^.next;
  end;
end;

procedure show;
var cur:Tlink;
          begin
          cur:=first;
          writeln(str:60);
          while cur<>nil do
                begin
                writeln(cur^.a.fio:30, cur^.a.x:3, cur^.a.y:3, cur^.a.z:3);
                cur:=cur^.u;
                end;
          writeln;
          end;

procedure print(nach : link);
var
  spisok:link;
  i:integer;
begin
spisok:=nach;
 i:=0;
 if spisok=nil then writeln('Список пуст!')
 else
 begin
   writeln('|------------------------------------------------------------------------------|');
   writeln('|Пор.|   Фамилия Имя Отчество  | Адрес постоянного места| Оценки по предметам: |');
   writeln('| №  |      абитуриента        |        жительства      |Матем.|Физика|Рус. яз.|');
   writeln('|--------------------------------------------------------------------=---------|');
   while spisok<>nil do
   begin
     i:=i+1;
     write('| ',i,')');
     gotoXY(6,whereY);write('| ',spisok^.fio);
     gotoXY(32,whereY);write('| ',spisok^.adres);
     gotoXY(57,whereY);write('|  ',spisok^.mat);
     gotoXY(64,whereY);write('|  ',spisok^.fiz);
     gotoXY(71,whereY);writeln('|   ',spisok^.rus,'    |');
     spisok:=spisok^.next;
   end;
 end;
end; { print }

uses crt;
type link = ^kom;
       kom  = record
               fio : string[30];
             adres : string[50];
               mat : integer;
               fiz : integer;
               rus : integer;
              next : link;
          end;
 var
  spisok, nach : link;
  z : kom;
  i, n, menu : integer;
  
{Ввод списка с клавиатуры}
procedure create(var spisok, nach:link; var z : kom);
begin
   write('Введите кол-во элементов списка: ');
   readln(n);
   if n=0 then writeln('В списке не может быть 0 студентов!')
   else
   for i:=1  to n do
  begin
     writeln('Ввод ', i, ' элемента списка: ');
     write('Фамилия Имя Отчество: ');
     readln(z.fio);
     write('Адрес проживания: ');
     readln(z.adres);
     write('Оценки (мат, физика, русс-й) через пробел: ');
     readln(z.mat, z.fiz, z.rus);
     z.next := nil;
   if nach = nil then
   begin
     new(nach);
     nach^ := z;
     spisok := nach;
   end
   else
   begin
     new(spisok^.next);
     spisok:=spisok^.next;
     spisok^ := z;
   end;
  end;
end;{ create }
 
{вывод списка на экран }
procedure print(nach : link);
var
  spisok : link;
  i : integer;
begin
 clrscr;
 spisok:=nach;
 i:=0;
 if spisok=nil then writeln('Список пуст!')
 else
 begin
   write('|------------------------------------------------------------------------------|');
   write('|Пор.|   Фамилия Имя Отчество  | Адрес постоянного места| Оценки по предметам: |');
   write('| №  |      абитуриента        |        жительства      |Матем.|Физика|Рус. яз.|');
   write('|--------------------------------------------------------------------=---------|');
   while spisok<>nil do
   begin
     i:=i+1;
     write('| ',i,')');
     gotoXY(6,whereY);write('| ',spisok^.fio);
     gotoXY(32,whereY);write('| ',spisok^.adres);
     gotoXY(57,whereY);write('|  ',spisok^.mat);
     gotoXY(64,whereY);write('|  ',spisok^.fiz);
     gotoXY(71,whereY);writeln('|   ',spisok^.rus,'    |');
     spisok:=spisok^.next;
   end;
 end;
end; { print }
 
begin
  clrscr;
  nach := nil;
  spisok:= nil;
  menu:=1;
  while menu<>0 do
  begin
    writeln;
    writeln('1 - Формирование списка.');
    writeln('2 - Вывод списка на экран.');
    writeln('0 - Выход');
    writeln('Введите пунк меню');
    readln(menu);
    case menu of
      1 : begin
            clrscr;
            create(spisok,nach,z);
          end;
      2 : begin
            print(spisok);
          end;
      end; {case}
  end; {while}
end.

  writeln('Bbl }l{elaete prodol}l{ut'' vvod dannblx? Y/N');

  c:=readkey; {для readkey не забываем подключать crt}

procedure AddInSortSpisok(z: ....; var first2:....);
{Добавление одного эл-та z в отсортированный список с указ-м first2 с сохранением упорядоченности}
var p, pr, n: ukazateli ; 
begin
... new(n); n^ := z; {новый эл-т}
    p := first2; pr := nil;
    while p<>nil and p^.ball<z.ball do {ищем место привязки по баллу }
    begin pred := p; p:= p^.next;  
    end;
    {вставка, привязка на нужное место "между" p и pr}
    n^.next := p; 
    if pr = nil {будет первый эл-т в списке} then 
       first2 := n
    else pr^.next := n; 
end;
....
first2 := nil;  {новый упорядоченный список}
 t:= first;      
 while t<> nil do {двигаемся по исходному списку}
 begin z := t^;
         AddInSortSpisok(z, var first2);
         t := t^.next;
 end;
...

procedure create(var spisok, nach:link; var z : kom);
var
  a : char;
  i, n : integer;
begin
  clrscr;
  repeat
    write('Фамилия Имя Отчество: ');
    readln(z.fio);
    write('Адрес проживания: ');
    readln(z.adres);
    write('Оценки (мат, физика, русс-й) через пробел: ');
    readln(z.mat, z.fiz, z.rus);
    z.next := nil;
    if nach = nil then
    begin
      new(nach);
      nach^ := z;
      spisok := nach;
      nach^.next:=nil;
    end
    else
    begin
      new(spisok^.next);
      spisok:=spisok^.next;
      spisok^ := z;
      spisok^.next:=nil;
    end;
    writeln('Вы желаете продолжить ввод данных? Y/N ');
    a := readKey;
  until a = 'n'
end;{ create }

Program Ex3_Repeat;
Uses Crt;
Var Ch:Char;
Begin
Repeat
  Ch:=ReadKey; Write(Ch);
Until Ch='j'
End.