Program AiSD_1_4;

{$APPTYPE CONSOLE}

Uses
    SysUtils,
    Windows;

Type
    Number = ^Elem;

    Elem = Record
        AbonentNumber: String[30];
        NextNumber: Number;
        PrevNumber: Number;
    End;

    Number2 = ^Elem2;

    Elem2 = Record
        Data: String[30];
        Next: Number2;
    End;

Function InputAmount(): Integer;  //ввод количества
Const
    MIN_NUMBER = 1;
    MAX_NUMBER = 9;
Var
    Amount: Integer;
    IsCorrect: Boolean;
Begin
    Writeln('Введите количество номеров телефонов:');
    Repeat
        Try
            IsCorrect := True;
            Readln(Amount);
        Except
            Writeln('Проверьте корректность ввода и повторите попытку!');
            IsCorrect := False;
        End;
        If (IsCorrect) And ((Amount < MIN_NUMBER) Or (Amount > MAX_NUMBER)) Then
        Begin
            IsCorrect := False;
            Writeln('Неправильное значение! Введите от', MIN_NUMBER, 'до', MAX_NUMBER, '!');
        End;
    Until (IsCorrect);
    InputAmount := Amount;
End;

Procedure InputElements(Var List: Number; Amount: Integer);  //ввод  номеров
Const
    MIN_LENGTH = 3;
    MAX_LENGTH = 7;
Var
    X, Head, Y: Number;
    I: Integer;
    IsCorrect: Boolean;
Begin
    New(X);
    List := X;
    X^.PrevNumber := Nil;
    For I := 1 To Amount Do
    Begin
        Y := X;
        Writeln('Введите ', I, '-й телефонный номер:');
        Repeat
            Try
                IsCorrect := True;
                Readln(Y^.AbonentNumber);
            Except
                Writeln('Проверьте корректность ввода и повторите попытку!');
                IsCorrect := False;
            End;
            If (IsCorrect) And ((Length(Y^.AbonentNumber) <> MIN_LENGTH) And
                (Length(Y^.AbonentNumber) <> MAX_LENGTH)) Then
            Begin
                IsCorrect := False;
                Writeln('Введено некорректный номер! Длина номера телефона может состовлять либо',
                    MIN_LENGTH, ', либо ', MAX_LENGTH, '!');
            End;
        Until (IsCorrect);
        New(X);
        Y^.NextNumber := X;
        X^.PrevNumber := Y;
    End;
    Y^.NextNumber := Nil;
End;

Procedure OutputInputData(Y: Number); //вывод введенных номеров
Begin
    Writeln('Список введённых номеров телефонов:');
    While Y <> Nil Do
    Begin
        Write(Y^.AbonentNumber + ' ');
        Y := Y^.NextNumber;
    End;
End;

Procedure ReverseList(List: Number); //список в обратном порядке
Begin
    While List^.NextNumber <> Nil Do
        List := List^.NextNumber;
    While List <> Nil Do
    Begin
        Write(' ', List^.AbonentNumber);
        List := List^.PrevNumber;
    End;
End;

Procedure GetNewList(Var NewList: Number2; List: Number); //создание списка 7-значных
Var
    Head, Current: Number2;
Begin
    New(Head);
    NewList := Head;
    While List <> Nil Do
    Begin
        If Length(List^.AbonentNumber) = 7 Then
        Begin
            Current := Head;
            Current^.Data := List^.AbonentNumber;
            New(Head);
            Current^.Next := Head;
            List := List^.NextNumber;
        End
        Else
            List := List^.NextNumber;
    End;
    Current^.Next := Nil;
End;

Procedure Sort(NewList: Number2); //сортировка
Begin
    While NewList <> Nil Do
    Begin
        Var
        Temp := NewList^.Next;
        While Temp <> Nil Do
        Begin
            If Temp^.Data < NewList^.Data Then
            Begin
                Var
                TempSwap := Temp^.Data;
                Temp^.Data := NewList^.Data;
                NewList^.Data := TempSwap;
            End;
            Temp := Temp^.Next;
        End;
        NewList := NewList^.Next;
    End;
End;

Procedure WriteSortList(NewList: Number2);   //Вывод отсортированных 7-значных номеров
Begin
    Writeln;
    Writeln('Список семизначных номеров:');
    While NewList <> Nil Do
    Begin
        Write(NewList^.Data + ' ');
        NewList := NewList^.Next;
    End;
End;


//Main
Var
    Amount: Integer;
    List: Number;
    NewList: Number2;
Begin
    InputElements(List, InputAmount());
    Writeln('------------------------------------------');
    OutputInputData(List);
    Writeln;
    Writeln('Список номеров телефонов:');
    ReverseList(List);
    GetNewList(NewList, List);
    Sort(NewList);
    WriteSortList(NewList);
    Readln;
End.