АИСД, 1.3

program lab13;

{$APPTYPE CONSOLE}

uses
  SysUtils, windows;

type
  Num = record
    N: integer;
    Name: string;
    LastName: string;
    Number: string;
    Patronoic: string;
  end;

  LElem = ^Elem;

  Elem = record
    Data: Num;
    Next: LElem;
  end;

var
  First: LElem;
  LastName, Number: string;
  Sort: integer;
  Flag: boolean;
  isexist: boolean;

  procedure FindByLastName(X: LElem; LastName: string);
  var
    Count: integer;
  begin
    Count := 0;
    while X <> nil do
    begin
      if X^.Data.LastName = LastName then
      begin
        Write(X^.Data.Name: 10, ' ');
        Write(X^.Data.LastName: 15, ' ');
        Write(X^.Data.Patronoic: 15, ' ');
        WriteLn(X^.Data.Number: 17);
        Inc(Count);
      end;
      X := X^.Next;
    end;
    if Count = 0 then
      WriteLn('??????? ?? ??????????!');

  end;

 procedure FindByNumber(X: LElem; Number: string);
  var
    Count: integer;
    IsExist: boolean;
  begin
        Count := 0;
  while X <> nil do
    begin
      IsExist := True;
      if X^.Data.Number = Number then
      begin
        Write(X^.Data.Name: 10, ' ');
        Write(X^.Data.LastName: 15, ' ');
        Write(X^.Data.Patronoic: 15, ' ');
        WriteLn(X^.Data.Number: 17);
        Inc(Count);

      end;
      X := X^.Next;
    end;
    if Count = 0 then
    begin
      IsExist := False;
      WriteLn('??????? ?? ??????????!');
    end;
  end;

  procedure Input(var X: integer);
  var
    Error: integer;
    Sus: string;
  begin

    repeat
      ReadLn(Sus);
      Val(Sus, X, Error);
      if (Error <> 0) or (Length(Sus) <> 7) then
        WriteLn('??????!');
    until (Error = 0) and (Length(Sus) = 7);

  end;

  procedure Make(X: LElem);
  var
    Y: LElem;
    Number, N: integer;
    Name, LastName, Patronoic: string;
    Change: string;
  begin
    Change := '??';
    N := 1;
    while (Change <> '???') do
    begin

      Write('??????? ???: ');
      ReadLn(Name);
      Write('??????? ???????: ');
      ReadLn(LastName);
      Write('??????? ????????: ');
      ReadLn(Patronoic);
      Write('??????? ?????????? ?????: ');
      Input(Number);

      X^.Data.Number := '+37544' + IntToStr(Number);

      X^.Data.Name := Name;
      X^.Data.LastName := LastName;
      X^.Data.Patronoic := Patronoic;
      X^.Data.N := N;
      Inc(N);
      Y := X;
      New(X);

      Y^.Next := X;
      Write('?????? ???????? ??? ?????? ????????? (??/???) ');
      ReadLn(Change);
    end;
    Y^.Next := nil;

  end;

  procedure Show(X: LElem);
  begin

    while (X <> nil) do
    begin
      Write(X^.Data.Name: 10, ' ');
      Write(X^.Data.LastName: 15, ' ');
      Write(X^.Data.Patronoic: 15, ' ');
      WriteLn(X^.Data.Number: 17);
      X := X^.Next;
    end;
  end;

  procedure SortNumber(Y: LElem; Sort: integer);
  var
    Len, I, J: integer;
    X: LElem;
    Tmps: Num;
    Flag: boolean;
  begin
    X := Y;
    Len := 0;
    while X <> nil do
    begin
      Inc(Len);
      X := X^.Next;
    end;

    for I := 1 to Len do
    begin
      X := Y;
      for J := 1 to Len - I do
      begin
        Flag := False;
        case Sort of
          1:
            if X^.Data.Name > X^.Next^.Data.Name then
              Flag := True;
          2:
            if X^.Data.LastName > X^.Next^.Data.LastName then
              Flag := True;
          3:
            if X^.Data.Patronoic > X^.Next^.Data.Patronoic then
              Flag := True;
        end;

        if Flag then
        begin
          Tmps := X^.Data;
          X^.Data := X^.Next^.Data;
          X^.Next^.Data := Tmps;
        end;
        X := X^.Next;
      end;
    end;
  end;

begin
SetConsoleCP(1251);
SetConsoleOutputCP(1251);
  New(First);
  Make(First);
  WriteLn;
  WriteLn('??????????? ??: 1 - ?????, 2 - ???????, 3 - ????????');
  Flag := False;
  repeat
    ReadLn(Sort);
    if (Sort in [1, 2, 3]) then
      Flag := True;
  until Flag;

  SortNumber(First, Sort);

  WriteLn;
  Show(First);
  WriteLn;
  WriteLn('??????? ???????, ????? ????? ?????????? ?????');
  ReadLn(LastName);
  WriteLn;
  FindByLastName(First, LastName);
  WriteLn;
  WriteLn('??????? ?????????? ?????, ????? ????? ???????');
  repeat
  ReadLn(Number);
  WriteLn;
  FindByNumber(First, Number);
  until isexist;
    Dispose(First);

  Sleep(500000);
end.