Lab "АиСД" №1

program Lab1_AiSD;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  System.SysUtils, Windows;

Type pt = ^elem;
    Elem = Record
        Data: Record
            Abonent, Number: String[30];
        End;
        Next: pt;
        Prev: pt;
    End;

    Pt2 = ^Elem2;
    Elem2 = Record
        Data: Record
            Abon, Num: String[30];
        end;
        Next: Pt2;
        Prev: Pt2;
    End;
    TString = String[30];

Var
    SPservice: Integer;
    First, Y: pt;
    First2, Z: pt2;
    Correct: Boolean;

Procedure Input (var x: pt);
Var
    y: pt;
    I, Count: Integer;
Begin
    Writeln('Введите количество номеров');
    Readln(Count);
    New(X);
    first := x;
    x^.prev := nil;
    For I := 1 to Count do
    Begin
        Write('Имя: ');
        Y := X;
        Readln(y^.data.Abonent);
        Write('Телефонный номер: ');
        Readln(y^.data.Number);
        If i <> Count Then
        Begin
            New(X);
            y^.next := x;
            x^.prev := y;
        End
        Else
            y^.next := nil;
    End;
End;

Procedure Overwriting (var F: Boolean; var First; var Y: pt; var Z: pt2; var First2: pt2; var Service: Integer);
Begin
    Service := 0;
    F := False;
    new (z);
    first2 := z;
    Writeln;
    Writeln('Список номеров телефонов');
    While y <> nil do
    Begin
        If Length(y^.data.Number) = 7 Then
        Begin
            F := True;
            new (z^.next);
            z := z^.next;
            z^.data.Abon := y^.data.Abonent;
            z^.data.num := y^.data.Number;
        End;
        Writeln(y^.data.Abonent, ' ', y^.data.Number);
        If Length(y^.data.Number) = 3 Then inc(Service);
        y := y^.prev;
    End;
    z^.next := nil;
End;

Procedure Sort (var Z, First2: pt2);
var
    i, j, k: Integer;
    S1, S2: TString;
Begin
    k := 0;
    z := first2;
    while z <> nil do
    Begin
        inc(k);
        z := z^.next;
    End;
    For J := 1 to K - 1 do
    Begin
        z := first2;
        For I := 1 to K - J do
        Begin
            If z^.data.Num > z^.next^.data.Num Then
            Begin
                S1 := z^.data.Num;
                S2 := z^.data.Abon;
                z^.data.Num := z^.next^.data.Num;
                z^.data.Abon := z^.next^.data.Abon;
                z^.next^.data.num := S1;
                z^.next^.data.Abon := S2;
            End;
            z := z^.next;
        End;
    End;
End;


procedure output2 (var F: Boolean; var z: pt2);
begin
    Z := First2;
    Writeln;
    Write('Список номеров абонентов:');
    While z <> nil do
    Begin
        Writeln(z^.data.Abon, ' ', z^.data.Num);
        Z := z^.next;
    End;
    Writeln;
    If SPservice <> 0 Then
        Writeln('В списке ', SPservice, ' номер(а) спецслужб(ы).');
    If F = False Then
        Writeln('В списке нет ни одного номера абонентов.');
end;

Begin
    setconsoleCP(1251);
    setconsoleoutputCP(1251);
    Input(Y);
    Overwriting (Correct, First, Y, Z, First2, SPservice);
    Sort (Z, First2);
    output2 (Correct, Z);
    readln
End.