Program Records1;
Uses
         CRT;
Const
         Max = 8;
         Msg = 'Таковых не имеется';
         Table: Array[1..12] of String = ('Овен','Телец','Близнецы','Рак',
                    'Лев','Дева','Весы','Скорпион',
                    'Стрелец','Козерог','Водолей','Рыбы');
Type
         Znak = record
                Name: String[40];
                Zodiac: Byte;
                BDay: Array[1..3] of Word;
                End;
Var
         a: Array[1..MAX] of Znak;
         i, j: Word;

Procedure Sorting;
Var t: Znak;
Begin
For i := 1 to Max do
     Begin
     For j := i to Max do
         If (a[i].Zodiac > a[j].Zodiac) then
            Begin
            t := a[i];
            a[i] := a[j];
            a[j] := t;
            End;
     End;
End;

Procedure CreatePerson(x: Byte);
Begin
ClrScr;
Writeln('Личность №',x);
Write('Имя: '); Readln(a[x].Name);
For j := 1 to 12 do
     Writeln(j,' - ',Table[j]);
Write('Зодиак: '); Readln(a[x].Zodiac);
Write('Рожден дд мм гггг: '); Readln(a[x].Bday[1],a[x].Bday[2],a[x].Bday[3]);
End;

Procedure PrintPerson(x: Byte);
Var flag: Boolean;
Begin
Flag := False;
For j := 1 to Max do
     If (a[j].BDay[2] = x) then
        Begin
        flag := True;
        Write(#13#10,a[j].Name,' рожден ',a[j].Bday[1],'.',a[j].Bday[2],'.',a[j].Bday[3]);
        End;
If Flag=False then Writeln(Msg);
End;

Begin
For i := 1 to Max do CreatePerson(i);
Sorting;
Write(#13#10,'Введите номер месяца: '); Readln(i);
PrintPerson(i);
ReadKey;
End.

Program Records3;
Uses
         CRT;
Const
         fPath = 'BOOK.TXT';
         fPath2 = 'NEW.TXT';
         Max = 8;
         Msg = 'Таковых не имеется';
         Table: Array[1..12] of String = ('Овен','Телец','Близнецы','Рак',
                    'Лев','Дева','Весы','Скорпион',
                    'Стрелец','Козерог','Водолей','Рыбы');
Type
         Znak = record
                Name: String[40];
                Zodiac: Byte;
                BDay: Array[1..3] of Word;
                End;
Var
         a: Array[1..MAX] of Znak;
         i, j: Word;
         f: Text;

Procedure Sorting;
Var t: Znak;
Begin
For i := 1 to Max do
     Begin
     For j := i to Max do
         If (a[i].Zodiac > a[j].Zodiac) then
            Begin
            t := a[i];
            a[i] := a[j];
            a[j] := t;
            End;
     End;
Assign(f, fPath);
ReWrite(f);
For i := 1 to Max do
     Begin
     With a[i] do
          Begin
          Writeln(f, i,#9,Name,#9,Zodiac,#9,BDay[1],'.',BDay[2],'.',BDay[3]);
          End;
     End;
Close(f);
End;

Procedure CreatePerson(x: Byte);
Begin
ClrScr;
Writeln('Личность №',x);
Write('Имя: '); Readln(a[x].Name);
For j := 1 to 12 do
     Writeln(j,' - ',Table[j]);
Write('Зодиак: '); Readln(a[x].Zodiac);
Write('Рожден дд мм гггг: '); Readln(a[x].Bday[1],a[x].Bday[2],a[x].Bday[3]);
End;

Procedure PrintPerson(x: Byte);
Var flag: Boolean;
Begin
Flag := False;
For j := 1 to Max do
     If (a[j].BDay[2] = x) then
        Begin
        flag := True;
        Write(#13#10,a[j].Name,' рожден ',a[j].Bday[1],'.',a[j].Bday[2],'.',a[j].Bday[3]);
        Assign(f, fPath2);
        ReWrite(f);
        With a[i] do
             Begin
             Writeln(f, i,#9,Name,#9,Zodiac,#9,BDay[1],'.',BDay[2],'.',BDay[3]);
             End;
        Close(f);
        End;
If Flag=False then Writeln(Msg);
End;

Begin
For i := 1 to Max do CreatePerson(i);
Sorting;
Write(#13#10,'Введите номер месяца: '); Readln(i);
PrintPerson(i);
ReadKey;
End.

Msg = Таковых не имеется

Writeln(Msg);

Writeln('Таковых не имеется');

Table: Array[1..12]

f: Text;