home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / CMPLTPAS.ZIP / DAYOWEEK.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-09-01  |  2.5 KB  |  61 lines
  1. {->>>>DateToDayOfWeek<<<<--------------------------------------}
  2. {                                                              }
  3. { Filename : DAYOWEEK.SRC -- Last Modified 7/11/88             }
  4. {                                                              }
  5. { This function "calculates" the day of week from the month,   }
  6. { day, and year values passed to it.  The actual calculation   }
  7. { is done by DOS, by setting the current date in the PC to the }
  8. { date passed, and then reading back the current date          }
  9. { to get the day of week in AL.  (The real current date was    }
  10. { read and saved and is restored before control returns to the }
  11. { caller.)  The bulk of the routine deals with the fact that   }
  12. { DOS cannot correctly calculate the day of the week for any   }
  13. { leap year day.  Fortunately, it's consistent in its error,   }
  14. { and the error can be easily corrected for.                   }
  15. {                                                              }
  16. {     From: COMPLETE TURBO PASCAL 5.0  by Jeff Duntemann       }
  17. {    Scott, Foresman & Co., Inc. 1988   ISBN 0-673-38355-5     }
  18. {--------------------------------------------------------------}
  19.  
  20. FUNCTION DateToDayOfWeek(Year,Month,Day : Integer) : Integer;
  21.  
  22.  
  23. VAR
  24.   SaveDate,WorkDate : Registers;
  25.   DayNumber         : Integer;
  26.   LeapYearDay       : Boolean;
  27.  
  28. CONST
  29.   DayArray : ARRAY[1..12] OF Integer =
  30.     (31,28,31,30,31,30,31,31,30,31,30,31);
  31.  
  32. BEGIN
  33.   LeapYearDay := False;
  34.   IF (Month = 2) AND ((Year MOD 4)=0) AND (Day = 29) THEN
  35.     LeapYearDay := True;
  36.   IF (NOT LeapYearDay) AND (Day > DayArray[Month]) THEN
  37.     DateToDayOfWeek := -1
  38.     ELSE
  39.       BEGIN
  40.         WorkDate.AH := $2B;
  41.         SaveDate.AH := $2A;  { Saves date encoded in registers }
  42.         MSDOS(SaveDate);            { Fetch & save today's date }
  43.         WITH WorkDate DO
  44.           BEGIN
  45.             CX := Year;      { Set the clock to the input date }
  46.             DH := Month;
  47.             DL := Day;
  48.             MSDOS(WorkDate);
  49.             AH := $2A;       { Turn around and read it back }
  50.             MSDOS(WorkDate); {  to find the day-of-week indicator }
  51.             DayNumber := AL; {  in AL. }
  52.             IF LeapYearDay THEN     { Correct for DOS's leap year bug }
  53.               IF DayNumber = 0 THEN DayNumber := 6
  54.                 ELSE DayNumber := Pred(DayNumber);
  55.             DateToDayOfWeek := DayNumber
  56.           END;
  57.         SaveDate.AH := $2B;  { Restore clock to today's date }
  58.         MSDOS(SaveDate);
  59.       END
  60. END;
  61.