Программа

{ Вечный календарь }
PROGRAM Calendar;
VAR Year,Month,Day:word; { Год, месяц, день }
    Ch:char;
{$I-} { Отключение проверки ошибок ввода-вывода }
FUNCTION Question(S:string):boolean; { Функция получения ответа на вопрос }
  Var Ch:char;                       { Ответ на вопрос }
  Begin
    repeat
      Write(S,' [Y/N] ');   { Вывод вопроса }
      ReadLn(Ch) { Ввод символа }
    until Ch in ['Y','y','N','n','Н','н','Т','т'];
                            { Выход из цикла при получении коректного ответа }
    Question:=Ch in ['Y','y','Н','н'] { Определение значения функции }
  End;
FUNCTION InputYear:word;  { Функция ввода года }
  Var YearBuf:real;  { Буферная переменная для ввода года }
  Begin
    Write('год '); { Вывод приглашения ввести год }
    ReadLn(YearBuf); { Ввод года }
    while (IOResult<>0)or(YearBuf<=0)or(YearBuf>65535)or(Frac(YearBuf)<>0)
      do              { Цикл повторного ввода года при ошибке }
      Begin
        { Вывод сообщений при ошибке }
        WriteLn('Параметр неверен',#7);
        WriteLn('Повторите ввод');
        Write('год ');  { Вывод приглашения ввести год }
        ReadLn(YearBuf); { Ввод года }
      End;
    InputYear:=Round(YearBuf)  { Определение значения функции }
  End;
FUNCTION InputMonth:word;  { Функция ввода месяца }
  Var MonthBuf:real;  { Буферная переменная для ввода месяца }
  Begin
    Write('месяц '); { Вывод приглашения ввести месяц }
    ReadLn(MonthBuf); { Ввод месяца }
    while (IOResult<>0)or(MonthBuf<1)or(MonthBuf>12)or(Frac(MonthBuf)<>0) do
                                   { Цикл повторного ввода месяца при ошибке }
      Begin
        { Вывод сообщений при ошибке }
        WriteLn('Параметр неверен',#7);
        WriteLn('Повторите ввод');
        Write('месяц ');  { Вывод приглашения ввести месяц }
        ReadLn(MonthBuf); { Ввод месяца }
      End;
    InputMonth:=Round(MonthBuf)  { Определение значения функции }
  End;
FUNCTION InputDay:word;  { Функция ввода числа }
  Var DayBuf:real;  { Буферная переменная для ввода числа }
  Begin
    Write('число '); { Вывод приглашения ввести число }
    ReadLn(DayBuf); { Ввод числа }
    while (IOResult<>0)
          or
          (DayBuf<1)
          or
          (DayBuf>31) and (Month in [1,3,5,7,8,10,12])
          or
          (DayBuf>30) and (Month in [4,6,9,11])
          or
          (DayBuf>28) and (Month in [2]) and (Year mod 4<>0)
          or
          (DayBuf>29) and (Month in [2]) and (Year mod 4 =0)
          or
          (Frac(DayBuf)<>0)
      do     { Цикл повторного ввода числа при ошибке }
      Begin
        { Вывод сообщений при ошибке }
        WriteLn('Параметр неверен',#7);
        WriteLn('Повторите ввод');
        Write('число ');  { Вывод приглашения ввести число }
        ReadLn(DayBuf); { Ввод числа }
      End;
    InputDay:=Round(DayBuf)  { Определение значения функции }
  End;
FUNCTION GetDayWeek(Year:longint;Month,Day:word):string;
                                            { Функция определения дня недели }
  Var EraDay:longint;  { День эры }
  Begin
    begin { Вычисление дня эры }
      EraDay:=Round((Year-1)*365)+(Year-1) div 4;
      case Month of
         1:;
         2:EraDay:=EraDay+31;
         3:EraDay:=EraDay+31+28;
         4:EraDay:=EraDay+31+28+31;
         5:EraDay:=EraDay+31+28+31+30;
         6:EraDay:=EraDay+31+28+31+30+31;
         7:EraDay:=EraDay+31+28+31+30+31+30;
         8:EraDay:=EraDay+31+28+31+30+31+30+31;
         9:EraDay:=EraDay+31+28+31+30+31+30+31+31;
        10:EraDay:=EraDay+31+28+31+30+31+30+31+31+30;
        11:EraDay:=EraDay+31+28+31+30+31+30+31+31+30+31;
        12:EraDay:=EraDay+31+28+31+30+31+30+31+31+30+31+30
      end;
      if (Year mod 4 =0) and (Month>2) then EraDay:=EraDay+1;
      EraDay:=EraDay+Day
    end;
    case (EraDay-1) mod 7 of { Определение значения функции }
      0:GetDayWeek:='ВОСКРЕСЕНЬЕ';
      1:GetDayWeek:='ПОНЕДЕЛЬНИК';
      2:GetDayWeek:='ВТОРНИК';
      3:GetDayWeek:='СРЕДА';
      4:GetDayWeek:='ЧЕТВЕРГ';
      5:GetDayWeek:='ПЯТНИЦА';
      6:GetDayWeek:='СУББОТА'
    end
  End;
BEGIN
  repeat
    WriteLn; { Пропуск строки }
    WriteLn('Введите дату: '); { Вывод приглашения ввести дату }
    Year:=InputYear; { Ввод года }
    Month:=InputMonth; { Ввод месяца }
    Day:=InputDay;  { Ввод числа }
    WriteLn(GetDayWeek(Year,Month,Day)); { Вычисление и вывод результата }
  until Question('Закончить работу?')
                       { Выход из цикла при получении утвердительного ответа }
END.