' 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 sDBName = GETSTARTPATH + "Calendar.mdb":STRING

DEF IDate, NDate, EDate:STRING
DEF cyyyy, cmm, cdd, week, dayofweek, dayofyear, quarter:INT
DEF pyyyy, pmm, pdd: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)"
	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

	'                          1     2    3          4     5          6              7      8          9     10         11
	sDB="insert into calendar (cDate,cDay,cDaySuffix,cWeek,cDayOfWeek,cDayOfWeekName,cMonth,cMonthName,cYear,cDayOfYear,cQuarter) "
	'            1 2 3 4 5 6 7 8 91011
	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)

	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
		ENDIF

		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