Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/NUTUG11.ZIP/DATIM.PAS

Pascal/Delphi Source File | 1987-11-21 | 5.9 KB | 218 lines

              {NORTHWESTERN UNIVERSITY TURBO USERS GROUP UTILITIES}

                       (** NUtility DATIM PROGRAM **)

                          {(C) J. E. Hilliard 1986}

         {This is a complete program ready for compiling which illus-
         trates the use of some the NUtility routines.               }



PROGRAM DATIM;                         {For IBM PC and Compatables.         }

         {This utility can be run from the AUTOEXEC.BAT file after
         the DOS date and time functions have been set by a command
         to a clock/calendar board. It provides a means of regularly
         checking the proper functioning of the clock/calendar. The
         utility displays a greeting, the full date and the time in
         am/pm style. Eg:

         Good Afternoon!

         Today is Saturday, December 21st. 1985 and the time is: 4:35 pm.
                                                                     }

Uses     Crt,
         Dos;
CONST

  ThisYear = 1986;                     {Used to check for BAD DATE.         }
                                       {Update as necessary.                }

         {/Note the definition of the following two arrays as typed
         constants. This simplifies the loading and speeds execution./}

  MonthName : array [1..12] of string[9] =

     ('January', 'February',  'March',   'April',    'May', 'June', 'July',
      'August',  'September', 'October', 'November', 'December');

  DayName   : array [0..6] of string[6] =

     ('Sun', 'Mon', 'Tues', 'Wednes', 'Thurs', 'Fri', 'Satur');

TYPE

  String2  = string[2];
  String12 = string[12];

  RegType  = Registers;

         {/Note that no global variables are used.                 /}


PROCEDURE GetDosTime (VAR Hour, Min : integer);

         {Gets the time with MS-DOS interrupt call.                  }

VAR

  Reg : RegType;

Begin

  Reg.AX := $2C00;                     {Function call $2C returns time.     }
  MsDos (Reg);

  with Reg do
    begin
      Hour   := CH;
      Min    := CL;
    { Sec    := DH); }              {For illustration only. We do not   }
    { CSec   := DL); }              {need Sec or Sec/100.               }
    end {with}

End; {GetDosTime}


PROCEDURE GetDosDate (VAR Y, M, DofM, DofW : integer);

         {Gets date with MS-DOS call.                                       }

VAR

  Reg : RegType;

Begin

  Reg.AX := $2A00;                     {Function call $2A returns the date. }
  MsDos (Reg);

  with Reg do
    begin
      Y    := CX;
      M    := DH;
      DofM := DL;
      DofW := AL;                      {Undocumented. See GetDosTime.       }
    end {with}                         {Sun = 0, Sat = 6.                   }

End; {GetDosDate (VAR Y, M, DofM, DofW : integer}


FUNCTION NumSuf (N : integer): String2;

         {Returns the suffix 'st', 'nd', 'rd' or 'th' appropriate for
         the integer N.                                              }

Begin

  case (N mod 10) of

    1 : NumSuf := 'st';
    2 : NumSuf := 'nd';
    3 : NumSuf := 'rd';
     else
        NumSuf := 'th'

  end; {case N of}

  if N in [11..13]
    then
      NumSuf := 'th';                  {Allow for the exceptions.           }

End; {NumSuf (N : integer): String2}


FUNCTION TimeString (Hour24, Min : integer) : String12;

          {Converts Hour24 and Min to a string and appends 'am' or 'pm'.    }

VAR

  IntStrH, IntStrM : string[5];        {Strings for hour and minutes.       }
  HoldFunc         : String12;         {Temp. hold while constructing       }
  Hour12           : integer;          {function. Reqd. to avoid recursive  }
                                       {call to TimeString.                 }
Begin

  Hour12 := Hour24 mod 12;
  if Hour12 = 0 then
    Hour12 := 12;                      {Follow usual convention.            }
  Str (Hour12, IntStrH);
  Str (Min,    IntStrM);
  if length (IntStrM) = 1 then         {Add leading 0.                      }
    IntStrM := '0' + IntStrM;
  HoldFunc := IntStrH + ':' + IntStrM;
  if Hour24 > 11
    then
      TimeString := HoldFunc + ' pm.'
    else
      TimeString := HoldFunc + ' am.'

End; {TimeString (Hour24, Min : integer) : String12}


PROCEDURE WriteMessage;

          {This is the main routine.                                        }

VAR

  Line1   : string[20];
  Line2   : string[80];

  Hour24, Min      : integer;
  Year, Month, Day : integer;
  DofW             : integer;          {Day of week (Sunday = 0).           }
  IntStrD, IntStrY : string[5];        {Strings for Day and Year.           }

Begin

  GetDosTime (Hour24, Min);
    case Hour24 of

       0..11 : Line1 := 'Morning!';
      12..17 : Line1 := 'Afternoon!';
        else
               Line1 := 'Evening!'

    end; {case Hour24 of}

  Line1 := 'Good ' + Line1;

  GetDosDate (Year, Month, Day, DofW);
  Str (Day,  IntStrD);
  Str (Year, IntStrY);

  Line2 := 'Today is ' + DayName [DofW] + 'day, ' + MonthName [Month]
             + ' ' + IntStrD + NumSuf (Day) + '. ' + IntStrY +
             ' and the time is: ' + TimeString (Hour24, Min);

  LowVideo; ClrScr;
  GoToXY (5, 2); write (Line1);
  GoToXY (5, 4); write (Line2);
  if Year < ThisYear then              {Error in calendar setting.          }
    begin
      GoToXY (33, 6); NormVideo;
      write (' BAD DATE ');
      LowVideo
    end;
  writeln; writeln; writeln;

End; {WriteMessage}

         {/The reason that 'WriteMessage' was made a procedure and then
         invoked by the following single program line was to eliminate
         the use of global variables. This ensures that there can be no
         possibilty of side effects if additions are made in the future.
         For example, routines to display the users' horoscope or to
         announce that today was the birthday of some historic personage./}

BEGIN

  WriteMessage;

END.