Category : BASIC Source Code
Archive   : QB_CAL.ZIP
Filename : CALEND6.BAS

'Calend6.BAS: The file-handling routines
'$INCLUDE: 'Calend.Bi'
'$STATIC
DIM SHARED ErrorFlag, FileDay, DayPtr&(366), LinePtr&(20)
DIM SHARED LocalLine(20) AS STRING * 32

ErrorTrap:
ErrorFlag = ERR
RESUME NEXT

SUB CreateFile (File$) 'Create a diary file and initialize pointers
OPEN File$ FOR BINARY AS 1
ERASE DayPtr&
FOR Lp = 1 TO 366
PUT #1, , DayPtr&(Lp)
NEXT Lp
FileOpen = TRUE
CalenLink = TRUE
END SUB

SUB OpenDatFile (File$) 'Open an existing diary file
ERASE DayPtr&
OPEN File$ FOR BINARY AS 1
FOR Lp = 1 TO 366
GET #1, , DayPtr&(Lp)
NEXT Lp
FileOpen = TRUE
CalenLink = TRUE
END SUB

FUNCTION FileExists (File$) 'Determine whether a file exists
ErrorFlag = FALSE
ON ERROR GOTO ErrorTrap
OPEN File$ FOR INPUT AS 1
CLOSE 1
FileExists = (ErrorFlag = FALSE)
ON ERROR GOTO 0
END FUNCTION

SUB OpenYear (Yr%) 'Create file name and open file for a year
CLOSE
FileOpen = FALSE
F$ = MID$(STR$(Yr), 2) + "DATE.DAT"
IF FileExists(F$) THEN
OpenDatFile (F$)
ELSE
CLS
PRINT "The file "; F$; " does not exist."
PRINT "Do you want to create it (y/n) ==> ";
DO
Ch$ = UCASE$(INPUT$(1))
LOOP WHILE INSTR("YN", Ch$) = 0
IF Ch$ = "Y" THEN CreateFile (F$)
END IF
END SUB

SUB ReadDay (DayNum) 'Read data for specific day
ERASE LinePtr&
ERASE LocalLine$
ERASE DiaryLine$
FileDay = DayNum
IF DayPtr&(DayNum) <> 0 THEN
SEEK #1, DayPtr&(DayNum)
FOR Lp = 1 TO 20
GET #1, , LinePtr&(Lp)
NEXT Lp
FOR Lp = 1 TO 20
IF LinePtr&(Lp) <> 0 THEN
SEEK #1, LinePtr&(Lp)
GET #1, , LocalLine$(Lp)
END IF
NEXT Lp
FOR Lp = 1 TO 20
DiaryLine$(Lp) = LocalLine$(Lp)
NEXT Lp
END IF
END SUB

SUB SaveDay 'Save data for a specific day
DIM Temp AS STRING * 32
ChangeFlag = FALSE
FOR Lp = 1 TO 20
IF DiaryLine$(Lp) <> LocalLine$(Lp) THEN
ChangeFlag = TRUE
END IF
NEXT Lp
IF ChangeFlag = TRUE THEN
IF DayPtr&(FileDay) = 0 THEN 'First time entry for this day?
DayPtr&(FileDay) = LOF(1) + 1
SEEK #1, ((FileDay - 1) * 4&) + 1 'Find place for Day pointer
PUT #1, , DayPtr&(FileDay) 'Save new address
SEEK #1, DayPtr&(FileDay) 'Move to that position
FOR Lp = 1 TO 20 'Save line pointers (all 0&)
LinePtr&(Lp) = 0
PUT #1, , LinePtr&(Lp)
NEXT Lp
END IF
FOR Lp = 1 TO 20 'For each line
IF DiaryLine$(Lp) <> LocalLine$(Lp) THEN
IF LinePtr&(Lp) = 0 THEN
LinePtr&(Lp) = LOF(1) + 1
END IF
SEEK #1, LinePtr&(Lp)
PUT #1, , DiaryLine$(Lp)
END IF
NEXT Lp
SEEK #1, DayPtr&(FileDay)
FOR Lp = 1 TO 20
PUT #1, , LinePtr&(Lp)
NEXT Lp
END IF
END SUB