'===========================================================================
' Subject: DATES ROUTINES FOR QB             Date: 07-02-99 (13:31)       
' Author:  Don Schullian                     Code: QB, QBasic, PDS        
' Origin:  d83@DASoftVSS.com               Packet: DATETIME.ABC
'===========================================================================
  Hi,

  These routines are Y5M compliant!

  This code was reworked from code I was given by Eustice Frilingos so most of
  the credit goes to him.

  These two functions pack the three date elements (Y,M,D) into a long integer
  by counting the number of days since 1-1-0001 then unpacking that number into
  the three date elements. The last possible date is in the year 5.8M so it's
  safe to say that the Y2K thingie isn't a problem!

  The fly in the ointment is that somewhere in the 12th century 11 days were
  cut or added to the calendar (don't remember which) so if you're an historian
  you'll need to modify the routines to work around that little chronological
  blip. The reason I've not messed with it is two fold:
    1) I don't plan on going back that far
    2) that 11 day blip is ONLY good in so many countries.
  Other countries and/or religious and/or ethnic groups did things differently
  so the whole sheebang gets totally mind boggling if one wants to make this
  routine work 100% for all conditions.

  The benefits of storing dates in this manner are many fold and not limited to
  the list below:
    1) DayOfTheWeek = (Days MOD 7) ' Sunday = 0 and Saturday = 6
    2) The system is country independent
    3) ToDay +  7 = SameDay_NextWeek
       ToDay + 28 = SameDay_NextMonth (4 weeks)
    4) Validation of an incoming date is fast and quick using the same
       two routines and comparing the returned Y,M,D with what was
       sent. (You need to build such a checking routine)

  fYMD2Days&  returns the number of days since 1-1-0001
  fDays2YMD%  returns the year, month, day and day of the week for a day number
  fJulianDay& returns the day number in a given year
  fLeapYear%  returns 0 or 1 if the year is, in fact, a leap year.

  Hope these routines help you out.

  d83)

---------------------------------------------------------------
-------------------------<CUT HERE>----------------------------
---------------------------------------------------------------

DEFINT A-Z
DECLARE FUNCTION fLeapYear% (Year%)
DECLARE FUNCTION fYMD2Days& (Year%, Month%, Day%)
DECLARE FUNCTION fDays2YMD% (Days&, Year%, Month%, Day%)

CLS

T1! = TIMER
FOR Y1% = 400 TO 2400
  PRINT USING "#,###"; Y1%
  DoM& = &H3DFF7F9F
  IF fLeapYear%(Y1%) THEN DoM& = (DoM& + 32)
  FOR M1% = 1 TO 12
    FOR D1% = 1 TO (DoM& AND 31)
      IF LEN(INKEY$) THEN GOTO BailOut
      Dz1& = fYMD2Days&(Y1%, M1%, D1%)
      DoW% = fDays2YMD%(Dz1&, Y2%, M2%, D2%)
      IF (Y1% <> Y2%) OR (M1% <> M2%) OR (D1% <> D2%) THEN PRINT "ERROR": END
    NEXT
    DoM& = DoM& \ 32
    IF DoM& = 0 THEN DoM& = &H3FEFFBFF
  NEXT
NEXT

BailOut:
  T1! = TIMER - T1!
  PRINT
  PRINT USING "###.####"; T1!
  PRINT "<<DONE>>";
END

FUNCTION fDays2YMD% (Daze&, Year%, Month%, Day%)

  Year% = 1
  Month% = 1
  Days& = Daze& - 1

  IF Days& > 146096 THEN
    Year% = Year% + (Days& \ 146097) * 400
    Days& = (Days& MOD 146097)
  END IF
  IF Days& > 36523 THEN
    D% = (Days& \ 36524)
    IF D% < 4 THEN
        Year% = Year% + (D% * 100)
        Days& = (Days& MOD 36524)
      ELSE
        Year% = Year% + 300
        Days& = 36524
    END IF
  END IF
  IF Days& > 1460 THEN
    Year% = Year% + (Days& \ 1461) * 4
    Days& = (Days& MOD 1461)
  END IF
  IF Days& > 364 THEN
    D% = (Days& \ 365)
    IF D% < 4 THEN
        Year% = Year% + D%
        Days& = (Days& MOD 365)
      ELSE
        Year% = Year% + 3
        Days& = 365
    END IF
  END IF

  Day% = Days& + 1
  DoM& = &H3DFF7F9F
  IF Day% > 58 AND fLeapYear%(Year%) THEN DoM& = (DoM& + 32)
  DO
    D% = (DoM& AND 31)
    IF D% >= Day% THEN EXIT DO
    Day% = Day% - D%
    Month% = Month% + 1
    DoM& = (DoM& \ 32)
    IF DoM& = 0 THEN DoM& = &H3FEFFBFF
  LOOP

  fDays2YMD% = (Daze& MOD 7)

END FUNCTION

FUNCTION fLeapYear% (Year%)

  IF ((Year% MOD 4) = 0) AND ((Year% MOD 100) > 0) OR ((Year% MOD 400) = 0) THEN fLeapYear% = 1

END FUNCTION

FUNCTION fYMD2Days& (Y%, M%, D%)

  Days& = D%

  IF M% > 1 THEN
    Month% = M%
    DoM& = &H3DFF7F9F
    IF Month% > 2 AND fLeapYear%(Y%) THEN DoM& = (DoM& + 32)
    DO
      Days& = Days& + (DoM& AND 31)
      IF Month% = 2 THEN EXIT DO
      Month% = Month% - 1
      DoM& = DoM& \ 32
      IF DoM& = 0 THEN DoM& = &H3FEFFBFF
    LOOP
  END IF

  Year% = (Y% - 1)
  Days& = Days& + (CLNG(Year%) * 365) + (Year% \ 4) - (Year% \ 100) + (Year% \ 400)

  fYMD2Days& = Days&

END FUNCTION