' Create_Calendar_DB.iwb

AUTODEFINE "off"

$INCLUDE "windowssdk.inc"

' DB fields
DEF pDB:POINTER
DEF iDB:UINT
DEF sDB[250]:ISTRING
DEF errorcode:STRING
DEF holiday[2,25], hname:STRING
DEF nHolidays:INT

DEF sDBName = GETSTARTPATH + "Calendar.mdb":STRING

DEF IDate, NDate, EDate:STRING
DEF cyyyy, cmm, cdd, week, dayofweek, dayofyear, quarter:INT
DEF pyyyy, pmm, pdd, i:INT
DEF SDay, SMonth, suffix:STRING
DEF sdd:STRING

ENUM days
	Sunday = 1
	Monday
	Tuesday
	Wednesday
	Thursday
	Friday
	Saturday
ENDENUM

OPENCONSOLE

DELETEFILE sDBName

pDB = dbCreateMDB(sDBName)
IF pDB
	pDB = dbConnect("Microsoft Access Driver (*.mdb)",sDBName,";")
	IF pDB = 0
		MESSAGEBOX 0,"Error connecting\n\n" + dbGetErrorText(iDB) + "\n\n" + "DB create","Error"
		dbFreeSQL(iDB)
		iDB = NULL
		dbDisconnect(pDB)
		pDB = NULL
		END
	ENDIF
	'add tables
	sDB = "CREATE TABLE calendar (cDate date PRIMARY KEY,cDay byte, cDaySuffix char(2),cWeek byte,cDayOfWeek byte,cDayOfWeekName char(9)," + _
	      "cMonth byte,cMonthName char(9),cYear integer,cDayOfYear integer,cQuarter byte,cHolidayName varchar(30))"
	iDB = dbExecSQL(pDB,sDB)
	errorcode = DBGETERRORCODE(iDB)
	IF LEN(errorcode)
		MESSAGEBOX 0,"Failed to create DB Calendar Table\n" + errorcode + "\n" + dbGetErrorText(iDB),"Error"
		dbFreeSQL(iDB)
		iDB = NULL
		dbDisconnect(pDB)
		pDB = NULL
		END
	ENDIF
	dbFreeSQL(iDB)
	iDB = NULL

	' Start Date
	NDate = "2000-01-01"
	' End Date
	EDate = "2031-01-01"

	SplitDate(NDate)
	pyyyy = cyyyy
	pmm = cmm
	pdd = cdd
	week = 1
	dayofyear = 0

	Holidays()

	'                          1     2    3          4     5          6              7      8          9     10         11       12
	sDB="insert into calendar (cDate,cDay,cDaySuffix,cWeek,cDayOfWeek,cDayOfWeekName,cMonth,cMonthName,cYear,cDayOfYear,cQuarter,cHolidayName) "
	'            1 2 3 4 5 6 7 8 9101112
	sDB+="values(?,?,?,?,?,?,?,?,?,?,?,?)"
	iDB=dbPrepareSQL(pDB,sDB)
	dbBindParameter(iDB,1,IDate,10)
	dbBindParameter(iDB,2,cdd)
	dbBindParameter(iDB,3,suffix,2)
	dbBindParameter(iDB,4,week)
	dbBindParameter(iDB,5,dayofweek)
	dbBindParameter(iDB,6,SDay,9)
	dbBindParameter(iDB,7,cmm)
	dbBindParameter(iDB,8,SMonth,9)
	dbBindParameter(iDB,9,cyyyy)
	dbBindParameter(iDB,10,dayofyear)
	dbBindParameter(iDB,11,quarter)
	dbBindParameter(iDB,12,hname,30)

	DO
		IDate = NDate
		SplitDate(IDate)
		cyyyy = VAL(MID$(IDate,1,4))
		dayofweek = ISODayOfWeek(IDate)
		SDay = StringDay(dayofweek)
		SMonth = StringMonth(cmm)
		sdd = USING("##",cdd)
		dayofyear++

		SELECT cmm
			CASE 1
			CASE& 2
			CASE& 3
				quarter = 1
			CASE 4
			CASE& 5
			CASE& 6
				quarter = 2
			CASE 7
			CASE& 8
			CASE& 9
				quarter = 3
			DEFAULT
				quarter = 4
		ENDSELECT

		IF MID$(sdd,1,1) = "1"
			suffix = "th"
		ELSE
			SELECT MID$(sdd,2,1)
				CASE "1"
					suffix = "st"
				CASE "2"
					suffix = "nd"
				CASE "3"
					suffix = "rd"
				DEFAULT
					suffix = "th"
			ENDSELECT
		ENDIF

		IF cyyyy <> pyyyy
			PRINT "Year: ", cyyyy
			week = 1
			dayofyear = 1
			Holidays()
		ENDIF

		hname = " "
		FOR i = 0 TO nHolidays
			IF IDate = holiday[0,i]
				hname = holiday[1,i]
				i = nHolidays + 1
			ENDIF
		NEXT i

		dbExecute(iDB)
		errorcode = DBGETERRORCODE(iDB)
		IF LEN(errorcode)>0
			MESSAGEBOX 0,DBGETERRORTEXT(iDB)+"\n"+sDB+"\n"+errorcode,"Error"
			dbFreeSQL(iDB)
			iDB = NULL
			dbDisconnect(pDB)
			pDB = NULL
			END
		ENDIF

		IF dayofweek = 7 THEN week++

		NDate = DateMath(IDate,1)
		pyyyy = cyyyy
		pmm = cmm
		pdd = cdd
		'PRINT IDate, " ", EDate, " ", cyyyy
	UNTIL IDate = EDate
	DBFREESQL(iDB)
	iDB=NULL
ENDIF

IF pDB <> NULL
	dbDisconnect(pDB)
ENDIF

PRINT "Done"

DO:UNTIL INKEY$ <> ""

CLOSECONSOLE

END

'___________________________________________
SUB ISODate(yyyy:INT, mm:INT, dd:INT),STRING
'-------------------------------------------
RETURN USING("0####", yyyy) + "-" + USING("0##", mm) + "-" + USING("0##", dd)
ENDSUB

'___________________________________
SUB ISODayOfWeek(IDate:STRING),INT
'-----------------------------------
DEF yyyy, mm, dd:INT
yyyy = VAL(MID$(IDate,1,4))
mm = VAL(MID$(IDate,6,2))
dd = VAL(MID$(IDate,9,2))
RETURN DayOfWeek(yyyy, mm, dd)
ENDSUB

'__________________________________________
SUB DayOfWeek(yyyy:INT, mm:INT, dd:INT),INT
'------------------------------------------
DEF t[12], y:INT
t = 0,3,2,5,0,3,5,1,4,6,2,4
y = yyyy
y -= (mm < 3) ? 1: 0
RETURN (y + y/4 - y/100 + y/400 + t[mm-1] + dd) % 7 + 1
ENDSUB

'__________________________
SUB StringDay(x:INT),STRING
'--------------------------
SELECT x
	CASE Sunday
			 RETURN "Sunday"
	CASE Monday
			 RETURN "Monday"
	CASE Tuesday
			 RETURN "Tuesday"
	CASE Wednesday
			 RETURN "Wednesday"
	CASE Thursday
			 RETURN "Thursday"
	CASE Friday
			 RETURN "Friday"
	CASE Saturday
			 RETURN "Saturday"
	DEFAULT
			 RETURN "Unknown " + STR$(x)
ENDSELECT
RETURN "Unknown " + STR$(x)
ENDSUB

'______________________________________
SUB DateMath(id:STRING,diff:INT),STRING
'--------------------------------------
TYPE DateType
	DEF LowDW:UINT
	DEF HighDW:UINT
END TYPE

UNION uDT
	DEF qVar:UINT64
	DEF dtVar:DateType
END UNION

DEF st:SYSTEMTIME
DEF ft:FILETIME
DEF u:uDT
DEF rtn:INT

' First get the system time so that all the other structure members are filled.
GetSystemTime(st)
'Setup the SYSTEMTIME structure with the original date like so:
st.wYear = VAL(MID$(id,1,4))
st.wMonth = VAL(MID$(id,6,2))
st.wDay = VAL(MID$(id,9,2))
'PRINT USING("Original date = 0##/0##/0####", st.wMonth, st.wDay, st.wYear)

' Convert the system time to file time.
rtn = SystemTimeToFileTime(st, ft)

' Move the FILETIME info into a UINT64 variable
' and add days using the Quad variable. (This is how M$ recommends doing it)
u.dtVar.LowDW = ft.dwLowDateTime
u.dtVar.HighDW = ft.dwHighDateTime

'Add days using the Quad variable.
' 1 day in nano seconds 24 * 60 * 60 * 10000000
u.qVar += ((24 * 60 * 60 * 10000000) * diff)		'<---- diff days

ft.dwLowDateTime = u.dtVar.LowDW
ft.dwHighDateTime = u.dtVar.HighDW

' Convert the file time to system time.
rtn = FileTimeToSystemTime(ft, st)

' Now your new date will be in the SYSTEMTIME structure members.
RETURN ISODate(st.wYear, st.wMonth, st.wDay)
ENDSUB

'__________________________
SUB StringMonth(x:int),string
'--------------------------
SELECT x
	CASE 1
			 RETURN "January"
	CASE 2
			 RETURN "February"
	CASE 3
			 RETURN "March"
	CASE 4
			 RETURN "April"
	CASE 5
			 RETURN "May"
	CASE 6
			 RETURN "June"
	CASE 7
			 RETURN "July"
	CASE 8
			 RETURN "August"
	CASE 9
			 RETURN "September"
	CASE 10
			 RETURN "October"
	CASE 11
			 RETURN "November"
	CASE 12
			 RETURN "December"
	DEFAULT
			 RETURN "Unknown " + STR$(x)
ENDSELECT
RETURN "Unknown " + STR$(x)
ENDSUB

'__________________________
SUB SplitDate(IDate:STRING)
'--------------------------
cyyyy = VAL(MID$(IDate,1,4))
cmm = VAL(MID$(IDate,6,2))
cdd = VAL(MID$(IDate,9,2))
RETURN
ENDSUB

'_______________________
SUB Easter(y:INT),STRING
'-----------------------
DEF century, g, k, i, j, l, EasterMonth, EasterDay:INT
century = y / 100
g = y - (y / 19) * 19
k = (century - 17) / 25
i = century - century / 4 - (century - k) / 3 + 19 * g + 15
i = i - (i / 30) * 30
i = i - (i / 28) * (1 - (i / 28) / (i + 1)) * ((21 - g) / 11)
j = y + y / 4 + i + 2 - century + century / 4
j = j - (j / 7) * 7
l = i - j
EasterMonth = 3 + (l + 40) / 44
EasterDay = L + 28 - 31 * (EasterMonth / 4)
RETURN ISODate(y, EasterMonth, EasterDay)
ENDSUB

'____________________________________________________________
SUB NthDayOfMonth(nth:INT,weekday:INT,year:INT,month:INT),INT
'------------------------------------------------------------
DEF retday:INT
retday = (nth-1)*7 + 1 + (7 + weekday - DayOfWeek(year,month,(nth-1)*7 + 1))%7
IF retday < 1 OR retday > LastDayOfMonth(year, month)
	RETURN -1
ENDIF
RETURN retday
ENDSUB

'___________________________________
SUB LastDayOfMonth(y:INT, m:INT),INT
'-----------------------------------
DEF v:INT
DEF mo[12]:INT
'     1  2  3  4  5  6  7  8, 9,10,11,12
mo = 31,28,31,30,31,30,31,31,30,31,30,31
IF m = 2
	v = y - (y / 100) * 100
	IF v = 0
		v  = y - (y / 400) * 400
		IF v = 0
			RETURN 29
		ENDIF
	ENDIF
	v = y - (y / 4) * 4
	IF v = 0
		RETURN 29
	ENDIF
ENDIF
RETURN mo[m-1]
ENDSUB

'___________________________________
SUB LastDay(n:INT, y:INT, m:INT),INT
'-----------------------------------
DEF d, t, v:INT
d = LastDayOfMonth(y, m)
v = DayOfWeek(y, m, d)
t = v - n
t = t - (t / 7) * 7
v = d - t
IF v > d THEN v -= 7
RETURN v
ENDSUB

'_____________
SUB Holidays()
'-------------
DEF tyyyy:STRING

tyyyy = USING("####",cyyyy)

FOR i = 0 TO 24
	holiday[0,i] = ""
	holiday[1,i] = ""
NEXT i

holiday[1,00] = "New Years Day"
holiday[1,01] = "Groundhog Day"
holiday[1,02] = "Valentine's Day"
holiday[1,03] = "St. Patrick's Day"
holiday[1,04] = "April Fools Day"
holiday[1,05] = "Cinco De Mayo"
holiday[1,06] = "Independence Day"
holiday[1,07] = "Halloween"
holiday[1,08] = "Veterans Day"
holiday[1,09] = "Pearl Harbor Rememberance Day"
holiday[1,10] = "Christmas Eve"
holiday[1,11] = "Christmas Day"
holiday[1,12] = "New Years Eve"
holiday[1,13] = "Daylight Savings Time"
holiday[1,14] = "Mothers Day"
holiday[1,15] = "Memorial Day"
holiday[1,16] = "Fathers Day"
holiday[1,17] = "Labor Day"
holiday[1,18] = "Columbus Day"
holiday[1,19] = "End Daylight Savings Time"
holiday[1,20] = "Thanksgiving"
holiday[1,21] = "Easter"
holiday[1,22] = "Good Friday"

holiday[0,00] = tyyyy + "-01-01"
holiday[0,01] = tyyyy + "-02-02"
holiday[0,02] = tyyyy + "-02-14"
holiday[0,03] = tyyyy + "-03-17"
holiday[0,04] = tyyyy + "-04-01"
holiday[0,05] = tyyyy + "-05-05"
holiday[0,06] = tyyyy + "-07-04"
holiday[0,07] = tyyyy + "-10-31"
holiday[0,08] = tyyyy + "-11-11"
holiday[0,09] = tyyyy + "-12-07"
holiday[0,10] = tyyyy + "-12-24"
holiday[0,11] = tyyyy + "-12-25"
holiday[0,12] = tyyyy + "-12-31"

' 2nd Sunday of March - Daylight Savings Time
i = NthDayOfMonth(2, Sunday, cyyyy, 3)
holiday[0,13] = ISODate(cyyyy,3,i)

' 2nd Sunday of May - Mothers Day
i = NthDayOfMonth(2, Sunday, cyyyy, 5)
holiday[0,14] = ISODate(cyyyy,5,i)

' Last Monday of May - Memorial Day
i = LastDay(Monday, cyyyy, 5)
holiday[0,15] = ISODate(cyyyy,5,i)

' 3rd Sunday of June - Fathers Day
i = NthDayOfMonth(3, Sunday, cyyyy, 6)
holiday[0,16] = ISODate(cyyyy,6,i)

' 1st Monday of September - Labor Day
i = NthDayOfMonth(1, Monday, cyyyy, 9)
holiday[0,17] = ISODate(cyyyy,9,i)

' 2nd Monday of October - Columbus Day
i = NthDayOfMonth(2, Monday, cyyyy, 10)
holiday[0,18] = ISODate(cyyyy,10,i)

' 1st Sunday of October - End Daylight Savings Time
i = NthDayOfMonth(1, Sunday, cyyyy, 11)
holiday[0,19] = ISODate(cyyyy,11,i)

' 4th Thursday of November - Thanksgiving
i = NthDayOfMonth(4, Thursday, cyyyy, 11)
holiday[0,20] = ISODate(cyyyy,11,i)

holiday[0,21] = Easter(cyyyy)

' Good Friday
holiday[0,22] = DateMath(holiday[0,21],-2)

nHolidays = 22

RETURN
ENDSUB

/*
23 Holidays

01,01,New Years Day
02,02,Groundhog Day
02,14,Valentine's Day
03,17,St. Patrick's Day
04,01,April Fools Day
05,05,Cinco De Mayo
07,04,Independence Day
10,31,Halloween
11,11,Veterans Day
12,07,Pearl Harbor Rememberance Day
12,24,Christmas Eve
12,25,Christmas Day
12,31,New Years Eve

03 2nd Sunday,Daylight Savings Time
05 2nd Sunday Mothers Day
05 Last Monday Memorial Day
06 3rd Sunday Fathers Day
09 1st Monday Labor Day
10 2nd Monday Columbus Day
11 1st Sunday End Daylight Savings Time
11 4th Thursday Thanksgiving

Good Friday = Easter - 2 Days
Easter
*/