Year 2000 Compliant Serial Date Routine
Written for QB4.5
If you are one of the many programmers that
are directed here by the major search engines, welcome. This bit
of code is a fully functional serial date routine that allows
passing of standard dates to a serial date and back. There are
other date converters available on the web, but most have limited
capabilities and even errors. The serial dates provided by this
routine are compatible with the ones used by many spreadsheets.
While this routine can be stolen and used
as a cut-n-paste, novice programmers are advised to examine the
code to see how proper annotation makes reading code simpler.
Trust me, programmers do have to go back and change or update
code long after they have totally forgotton anything about it.
If you like the code, drop me an email. The minimal licensing
fee isn't an issue for me, but notification of the fee does satisfy
some legal requirements.
SUB DateConverter (StandardDate$, month%, DayOfMonth%, year%, DayNumber, DayOfWeek$, DayOfWeekNum%, week%, Language%)
'(C) 1998 by Theatre Support Services, Inc., 310 SW 66th Terr., Margate, FL
' Shareware $2.00 licensing fee.
'This routine allows input of a date in standard MM-DD-YYYY format or as
'mm%,dd%,yy% or yyyy% to get the day of week (MON, etc.) and a day number
'that corresponds to the MS Works integer day number.
'This routine is only needed for QB or qBasic.
'VB Users have similar functionality by using SerialDate.
'The routine is highly annotated to show the logic to non-programmers.
'Experienced programmers may cringe at the occasional GOTO, but without
'the use of GOTOs, you wouldn't be here. Every single hyperlink on the net
'is essentially a GOTO with a different name, so lighten up guys!
'Standard integer%, String$, etc. extensions are used for clarity.
'If a day number is input to this routine instead of a date,
'the date and day of week are returned.
'Proper conversions are crucial to any program offering continuous
'reporting functions, and to insure against Y2K problems.
'Faster code would start with a later date and eliminate floating point numbers
'but the routine is usually used only a few times in a program, so speed
'isn't an issue as much as compatibility and not relying on any outside code.
'The Players, in order of appearance:
'StandardDate$
'Month%
'DayOfMonth%
'Year%
'DayNumber 'this could be long, but no harm is done using float
'DayofWeek$
'DayOfWeekNum%
'Week%
'Language%
'The roles of the supporting cast become obvious.
'---- DEFINITIONS BEGIN HERE ----------
DIM MO%(12)
DIM DayOfWeek$(7)
True% = 1 'Yeah, I know, -1. Whatever.
False% = 0
'Yes, the following could be in a data file to shrink the dgroup memory usage.
'This is clearer and keeps the constants safer than in a data file.
MO%(1) = 31
MO%(2) = 28
MO%(3) = 31
MO%(4) = 30
MO%(5) = 31
MO%(6) = 30
MO%(7) = 31
MO%(8) = 31
MO%(9) = 30
MO%(10) = 31
MO%(11) = 30
MO%(12) = 31
SELECT CASE Language%
CASE 0
DayOfWeek$(1) = "FRI"
DayOfWeek$(2) = "SAT"
DayOfWeek$(3) = "SUN"
DayOfWeek$(4) = "MON"
DayOfWeek$(5) = "TUE"
DayOfWeek$(6) = "WED"
DayOfWeek$(7) = "THU"
CASE 1
DayOfWeek$(1) = "Friday"
DayOfWeek$(2) = "Saturday"
DayOfWeek$(3) = "Sunday"
DayOfWeek$(4) = "Monday"
DayOfWeek$(5) = "Tuesday"
DayOfWeek$(6) = "Wednesday"
DayOfWeek$(7) = "Thursday"
CASE 2
DayOfWeek$(1) = "VIE"
DayOfWeek$(2) = "SAB"
DayOfWeek$(3) = "DOM"
DayOfWeek$(4) = "LUN"
DayOfWeek$(5) = "MAR"
DayOfWeek$(6) = "MIE"
DayOfWeek$(7) = "JUE"
'add cases as needed for language
END SELECT
FinishedFlag% = False%
'---- MAIN PROGRAM BEGINS HERE --------
ConvertDateToDOW:
'First, check to see if a DayNumber has been passed. It has priority.
IF DayNumber < 0 THEN DayNumber = 0
IF DayNumber > 0 AND FinishedFlag% = False% THEN
NumDays = DayNumber
GOTO ConvertDayNumToDate
END IF
IF StandardDate$ > "" THEN 'break it into sections the program can eat
'Note- This version does not allow for other international date conventions.
year% = VAL(MID$(StandardDate$, 7, 4))
month% = VAL(MID$(StandardDate$, 1, 2))
DayOfMonth% = VAL(MID$(StandardDate$, 4, 2))
END IF
'but if the sections have been entered manually or by the calling program,
'those sections take presidence over a full date
IF month% > 0 AND month% < 13 THEN Mn% = month%
IF DayOfMonth% > 0 AND DayOfMonth% < 32 THEN Da% = DayOfMonth%
IF year% >= 1900 THEN Yr% = year%
'many bios default to 01-01-1980, so since 1980 was about the date of
'pc introduction, we'll use that as the pivot for two digit years
'(This is the first part of Y2K compliance.)
IF year% >= 80 AND year% <= 99 THEN Yr% = year% + 1900
IF year% >= 0 AND year% < 80 THEN Yr% = year% + 2000
'limit wild entries
IF month% > 12 OR month% < 0 THEN BadDateFlag% = True%
SELECT CASE month%
CASE 1, 3, 5, 7, 8, 10, 12
IF DayOfMonth% > 31 OR DayOfMonth% < 0 THEN BadDateFlag% = True%
CASE 4, 6, 9, 11
IF DayOfMonth% > 30 OR DayOfMonth% < 0 THEN BadDateFlag% = True%
CASE 2
IF DayOfMonth% > 29 OR DayOfMonth% < 0 THEN BadDateFlag% = True%
END SELECT
IF year% > 2099 OR year% < 1900 THEN BadDateFlag% = True%
IF BadDateFlag% = True% THEN
BadDateFlag% = False%
month% = 1
DayOfMonth% = 1
year% = 1980
FinishedFlag% = False%
END IF
'Now that we have the year, month, and day of the month, we loop to
'come up with an integer representing the day. MS uses the part after the
'decimal to represent the seconds in a day, but that isn't used here.
'Day 1 is Jan 1, 1900
NumDays = 1 'calls January 1 the number 1 instead of 0
FOR TestYr% = 1900 TO Yr% - 1 'start a loop at Jan 1, 1900 adding days
'find if any year fits the definition of a leap year
'(This is the second part of Y2K compliance)
IF (TestYr% MOD 4 = 0 AND TestYr% MOD 100 <> 0) OR (TestYr% MOD 400 = 0) THEN
'This is a leap year; Add the number of days in a leap year.
NumDays = NumDays + 366
ELSE 'Add the number of days in a regular year
NumDays = NumDays + 365
END IF
NEXT 'keep adding until all days up to the current year Jan 1 are totalled
'we don't want to add the current year in or we would be 365 days ahead
'thats why the loop specifies yr% - 1
YearDays = NumDays 'we know we have at least this many days.
'Now we need to know if the _current_ year is a leap year.
'(This is the third part of Y2K compliance)
IF (Yr% MOD 4 = 0 AND Yr% MOD 100 <> 0) OR (Yr% MOD 400 = 0) THEN
'It is a leap year. February has an extra day
MO%(2) = 29
END IF
FOR TestMo% = 1 TO Mn% - 1 'now do the same adding for the months
NumDays = NumDays + MO%(TestMo%)
NEXT 'again, don't add the current month
'now we add the days
NumDays = NumDays + Da% 'Numdays is the total of year days + month days,
'Da% is the day of the month and cannot be 0
'this is as far as the DATE$ functions go in many microsoft products -
'they don't go the extra step to find the day of the week, as shown below
'use the MOD function to get rid of all whole weeks and get a number
'from 0 to 6 representing a day of the week
DayOfWeekNum% = NumDays MOD 7
'for TSS applications DayOfWeekNum% 1 = Friday and so on.
'Since Friday normally starts a film week, this simplifies other code.
SELECT CASE DayOfWeekNum%
CASE 0 'sat
DayOfWeekNum% = 2
CASE 1 'sun
DayOfWeekNum% = 3
CASE 2 'mon
DayOfWeekNum% = 4
CASE 3 'tue
DayOfWeekNum% = 5
CASE 4 'wed
DayOfWeekNum% = 6
CASE 5 'thu
DayOfWeekNum% = 7
CASE 6 'fri
DayOfWeekNum% = 1
END SELECT
DayOfWeek$ = DayOfWeek$(DayOfWeekNum%)
DayOfYear% = NumDays - YearDays
week% = FIX((DayNumber - YearDays) / 7)
DayNumber = NumDays
FinishedFlag2% = True%
'-------------------------------------------------------------------------
ConvertDayNumToDate: 'now to reverse the process
IF FinishedFlag% = True% GOTO FinishSub
BuiltDays = 0
NumDays = NumDays - 1 'get back in synch with the algorythem
FOR BuiltYr% = 1900 TO 2099 'use the loop at the year 1900 adding days
'find if any year fits the definition of a leap year
IF (BuiltYr% MOD 4 = 0 AND BuiltYr% MOD 100 <> 0) OR (BuiltYr% MOD 400 = 0) THEN
'BuiltYr% qualifies as a leap year, add the number of days in a leap year
BuiltDays = BuiltDays + 366 '(BuiltDays is the total days of all previous years)
IF NumDays <= BuiltDays THEN 'the date is within this year
FoundYear% = BuiltYr%
MonthAndDay% = 366 - (BuiltDays - NumDays)
EXIT FOR
END IF
ELSE 'add the number of days in a regular year
BuiltDays = BuiltDays + 365
IF NumDays <= BuiltDays THEN 'the date is in this year
FoundYear% = BuiltYr%
MonthAndDay% = 365 - (BuiltDays - NumDays)
EXIT FOR
END IF
END IF
NEXT 'Year :keep adding until all days up to the current year Jan 1 are totalled
'we don't want to add the current year in or we would be 365 days ahead
'now we need to know if FoundYear% is a leap year
IF (FoundYear% MOD 4 = 0 AND FoundYear% MOD 100 <> 0) OR (FoundYear% MOD 400 = 0) THEN
'correct the # of days in Feb
MO%(2) = 29
END IF
BuiltMo% = 0 'reset incrementer
FOR TestMo% = 1 TO 12 'now do the same adding for the months
IF MonthAndDay% > BuiltMo% + MO%(TestMo%) THEN
BuiltMo% = BuiltMo% + MO%(TestMo%) '(add this month's days and continue to BuiltMo%)
ELSE 'the number of days left are less than the days in the next month
FoundMonth% = TestMo%
FoundDay% = MonthAndDay% - BuiltMo%
EXIT FOR
END IF
NEXT
month% = FoundMonth%
DayOfMonth% = FoundDay%
year% = FoundYear%
FinMonth$ = RIGHT$("0" + LTRIM$(STR$(month%)), 2)
FinDay$ = RIGHT$("0" + LTRIM$(STR$(DayOfMonth%)), 2)
FinYear$ = RIGHT$(LTRIM$(STR$(year%)), 4)
StandardDate$ = FinMonth$ + "-" + FinDay$ + "-" + FinYear$
IF FinishedFlag2% = True% GOTO FinishSub
IF FinishedFlag% = False% THEN 'we still need to get a day of the week
FinishedFlag% = True%
GOTO ConvertDateToDOW
END IF
FinishSub:
END SUB
Home