Spiski_2

type
      PRec = ^TRec;   { Тип указатель на запись }
      TRec = record               { Тип записи для базы данных }
        mNumber : integer;
        mFam    : string[31];
        mNext   : PRec;
      end;
var   List : PRec;  { Указатель на начало списка}

  { Размещение нового элемента в сортированном списке }
procedure AddToSortList(aNumber: integer; const aFam : string);
var p, q : PRec;
begin
  New(p); { Создаем динамическую переменную-запись }
  { Размещаем данные в полях записи }
  p^.mNumber:= aNumber; p^.mFam:= aFam; p^.mNext:=nil;
  { Если список пуст... }
  if List=nil
    then List:= p  { ...голова указывает на новую запись }
    else begin
           q:= List;  { Поиск места вставки начинаем с головы }
           { Двигаемся по списку, пока следующий элемент существует
             и его номер меньше вставляемого }
           while (q^.mNext<>nil) and (q^.mNext^.mNumber < aNumber)
              do q:=q^.mNext;
           if q^.mNumber > aNumber then begin
              { вставка на первое место }
              p^.mNext:=List;      { первый становится вторым }
              List:=p;             { а текущий- первым }
           end else begin
              { вставка в середине или в конце списка }
              p^.mNext:=q^.mNext;  { связываем текущий со следующим }
              q^.mNext:=p;         { связываем предыдущий с текущим }
           end
         end
end;

procedure PrintList;    { Распечатка списка }
var P : PRec;
begin
  P:= List;
  while P<>nil do begin
    Writeln(P^.mNumber, '':3, P^.mFam);
    P:= P^.mNext;
  end;
end;

function Find(aNumber: integer): PRec;   { Поиск в сортированном списке }
var p : PRec;
begin
  p:= List;  { Поиск начинаем с головы }
  { Двигаемся по списку, пока следующий элемент существует
     и его номер меньше искомого }
  while (p<>nil) and (p^.mNext<>nil) and (p^.mNext^.mNumber <= aNumber)
     do p:=p^.mNext;
  { Если конец списка не достигнут и номер совпадает... }
  if (p<>nil) and (p^.mNumber = aNumber)
    then Find:= p    { ... то успешно! }
    else Find:= nil; { ... а иначе не нашли }
end;

var i, N : integer;
       P : PRec;

begin   { Главная программа }
  List:= nil;
  for i:=1 to 20 do AddToSortList(100+Random(100), 'Family');
  { Просмотр списка }
  PrintList;
  { Цикл экспериментов по поиску в списке }
  repeat
    Write('Номер авто = '); Readln(N);
    if N>0 then begin
      P:= Find(N);
      if P<>nil
        then Writeln(P^.mNumber, '':3, P^.mFam)
        else Writeln ('Не найден!');
    end;
  until N=0
end.