REM PROGRAM GETDATE 1.2.1
REM PROGRAMMER D. ALLEM
REM CREATED JUL 27, 1986
REM UPDATED SEP 07, 1998
REM COPYRIGHT (C) 1986
'
'    THE PURPOSE OF THIS PROGRAM IS TO ELIMINATE THE NEED TO TYPE
'    IN THE DATE UPON BOOT UP.  THE USER CAN ADVANCE OR BACKUP
'    THE DATE SIMPLY BY MOVING THE CURSOR KEYS.
'
'    VARIABLE TABLE:
'      A,A$      -  ONE CHARACTER INPUT
'      BREAK.    -  BREAK KEY
'      CENTURY   -  CURRENT CENTURY
'      D,D!,D#,D$-  DUMMY VARIABLES
'      DAY       -  CURRENT DAY OF MONTH
'      FOUND     -  FLAG, 0=FALSE, -1=TRUE
'      CH.CR     -  ASCII CHAR, CARRIAGE RETURN
'      CH.L      -  ASCII CHAR, LEFT
'      CH.L2     -  ASCII CHAR, CTRL-LEFT
'      CH.R      -  ASCII CHAR, RIGHT
'      CH.R2     -  ASCII CHAR, CTRL-RIGHT
'      FNSETR$() -  FUNC, JUSTIFY RIGHT STRING
'      FNSPC$()  -  FUNC, SPACE STRING
'      FP.COL    -  CURRENT SCREEN COLUMN POSITION
'      FP.ROW    -  CURRENT SCREEN ROW POSTION
'      GET.DATE$ -  GETDATE DATA FILE NAME
'      I         -  CURRENT POSITION IN REC$
'      J         -  LENGTH OF REC$
'      MARKER    -  DATE MARKER
'      MAX.DAY   -  MAXIMUM NUMBER OF DAYS ON MONTH
'      MONTH     -  CURRENT MONTH
'      MONTH$()  -  MONTH DESCRIPTION TABLE
'      QUIT      -  FLAG, RETURN TO DOS
'      REC$      -  DATA RECORD STRING
'      W$        -  WORKING STORAGE
'      WEEK      -  CURRENT DAY OF WEEK
'      WEEK$()   -  DAY OF WEEK DESCRIPTION TABLE
'      YEAR      -  CURRENT YEAR
'
'    INITIALIZATIONS.
'
DEFINT A-Z
DEF FNSPC$(D)=STRING$(-(D>0)*D,32)
DEF FNSETR$(D$,D)=FNSPC$(D-LEN(D$))+RIGHT$(D$,D)
DIM MONTH$(12)
DIM WEEK$(7)
GOTO INITIALIZATION
REM
REM     UTILITY ROUTINES SECTION.
REM
'
INIT.DATE:
'
'    THE PURPOSE OF THIS ROUTINE IS TO INITIALIZE THE DATE.
'
MONTH=7 : DAY=27 : YEAR=86 : WEEK=1 : CENTURY = 19
RETURN
'
GET.DATE:
'
'    THE PURPOSE OF THIS ROUTINE IS TO RETRIEVE THE DATE STORED
'    IN THE FILE SPECIFIED BY GET.DATE$.  IF AN ERROR OCCURS,
'    THE ERROR FLAG IS NOT RESET.
'
EF=-1
CLOSE 1 : OPEN "R", 1, GET.DATE$, 1
FIELD 1, 1 AS W$
GET 1, 1 : MONTH=ASC(W$)
GET 1, 2 : DAY=ASC(W$)
GET 1, 3 : YEAR=ASC(W$)
GET 1, 4 : WEEK=ASC(W$)
GET 1, 5 : CENTURY=ASC(W$)
FOUND=0
IF MONTH<1 OR MONTH>12 THEN FOUND=-1
IF DAY<1 OR DAY>31 THEN FOUND=-1
IF WEEK<1 OR WEEK>7 THEN FOUND=-1
IF CENTURY<1 OR CENTURY>99 THEN FOUND=-1
IF FOUND THEN GOSUB INIT.DATE
EF=0
RETURN
'
PUT.DATE:
'
'    THE PURPOSE OF THIS ROUTINE IS TO STORE THE CURRENT DATE IN
'    THE FILE SPECIFIED BY GET.DATE$.  IF AN ERROR OCCURS, THE
'    ERROR FLAG IS NOT RESET.
'
EF=-1
LSET W$=CHR$(MONTH) : PUT 1, 1
LSET W$=CHR$(DAY)   : PUT 1, 2
LSET W$=CHR$(YEAR)  : PUT 1, 3
LSET W$=CHR$(WEEK)  : PUT 1, 4
LSET W$=CHR$(CENTURY) : PUT 1, 5
CLOSE 1
EF=0
RETURN
'
MAX.DAY:
'
'    THE PURPOSE OF THIS ROUTINE IS TO DETERMINE THE MAXIMUM NUMBER
'    OF DAYS IN A GIVEN MONTH.
'
D = (CENTURY*100) + YEAR
SELECT CASE MONTH
CASE 2
  MAX.DAY=28 : IF D=INT(D/4)*4 THEN MAX.DAY=29
  IF MAX.DAY=29 AND D=INT(D/100)*100 AND D<>INT(D/400)*400 THEN MAX.DAY=28
CASE 4, 6, 9, 11
: MAX.DAY=30
CASE ELSE
: MAX.DAY=31
END SELECT
RETURN
'
CLS.:
'
'    THE PURPOSE OF THIS ROUTINE IS TO PRINT A CLEAR SCREEN AND
'    HOME THE CURSOR.
'
: CLS
RETURN
'
LOCATE.:
'
'    THE PURPOSE OF THIS ROUTINE IS TO POSITION THE CURSOR AT
'    LOCATION FP.ROW AND FP.COL.
'
: LOCATE FP.ROW, FP.COL
RETURN
'
ERROR.HANDLER:
'
'    THE PURPOSE OF THIS ROUTINE IS TO HANDLE ALL PROGRAM,  AND
'    SYSTEM ERRORS.  ENTRY: ON ERROR GOTO ERROR.HANDLER\
'
D$=""
IF ERR<50 THEN D$="Syntax Error"
IF ERR=53 THEN D$="File not Found"
IF ERR=64 THEN D$="Bad File Name"
IF D$=""  THEN D$="Disk Error"
PRINT "**  ";D$;", ERR#";ERR
IF ERR <= 50 THEN PRINT "** Error Line Number";ERL
IF ERP THEN
  PRINT "Enter anything to continue, 'Q' to quit."
  A$=INPUT$(1) : IF A$="Q" OR A$="q" THEN STOP
END IF
RESUME RESUMED
RESUMED:
RETURN
REM
REM     UTILITY ROUTINES EXIT.
REM
'
INITIALIZATION:
'
'    THE PURPOSE OF THIS ROUTINE IS TO INITIALIZE PROGRAM VARIABLES
'    AND TABLES.
'
: ON ERROR GOTO ERROR.HANDLER
ERP=-1
MARKER=&H55
: GET.DATE$="GETDATE.DAT" : BREAK.=27
  CH.CR=13 : CH.L=75 : CH.R=77 : CH.L2 = 115 : CH.R2 = 116
'
'    INITIALIZE TABLES.
'
FOR D = 1 TO 7
  READ WEEK$(D)
NEXT D
DATA Sunday, Monday, Tuesday, Wednesday, Thursday, Friday, Saturday
FOR D = 1 to 12
  READ MONTH$(D)
NEXT D
DATA January, February, March, April, May, June
DATA July, August, September, October, November, December
REM
REM     MAIN ROUTINE
REM
'
'    THE PURPOSE OF THIS ROUTINE IS TO CONTROL THE PROGRAM.  THE
'    CURRENT DATE IS DISPLAYED.  THE USER IS PROMPTED FOR A KEY.
'    ENTRY: INITIALIZATION.
'
GOSUB CLS. : PRINT
PRINT "GETDATE 1.2.1"
PRINT "(C) Copyright 1986 by Dennis Allen"
PRINT "Portions (C) Copyright"
PRINT "Microsoft Corp. 1982, 1983, 1984, 1985, 1986"
PRINT "All Rights Reserved"
PRINT
PRINT
PRINT
PRINT "Please press one of the following keys:"
PRINT "<ENTER> if date is correct"
PRINT "<Esc> to exit without setting date"
PRINT "<right-arrow> to advance date one day"
PRINT "<left-arrow>  to backup date one day"
PRINT "<Ctrl>-<right-arrow> to advance date one month"
PRINT "<Ctrl>-<left-arrow>  to backup date one month"
GOSUB GET.DATE : IF EF THEN STOP
QUIT=0
DO
  GOSUB PRINT.DATE
  DO
    A$=INKEY$
  LOOP UNTIL A$<>""
  IF LEN(A$)=2 THEN A$=MID$(A$,2,1)
  SELECT CASE ASC(A$)
  CASE CH.CR  : QUIT=-1
  CASE BREAK. : SYSTEM
  CASE CH.R   : GOSUB ADVANCE.DATE
  CASE CH.R2  : GOSUB ADVANCE.DATE : WHILE DAY <> 1 : GOSUB ADVANCE.DATE : WEND
  CASE CH.L   : GOSUB BACKUP.DATE
  CASE CH.L2  : GOSUB BACKUP.DATE : WHILE DAY <> 1 : GOSUB BACKUP.DATE : WEND
  CASE ELSE
  END SELECT
LOOP UNTIL QUIT
GOSUB SET.DATE
GOSUB PUT.DATE : IF EF THEN STOP
SYSTEM
REM
REM     MAIN ROUTINES SECTION.
REM
'
PRINT.DATE:
'
'    THE PURPOSE OF THIS ROUTINE IS TO CREATE AND DISPLAY THE DATE
'    STRING, GIVEN THE MONTH, DAY, AND YEAR.  ENTRY & EXIT:
'    THE MAIN ROUTINE.
'
FP.ROW=8 : FP.COL=1
REC$=MONTH$(MONTH)+" "
REC$=REC$+FNSETR$("0"+MID$(STR$(DAY),2),2)+", "
REC$=REC$+FNSETR$("0"+MID$(STR$(CENTURY),2),2)
REC$=REC$+FNSETR$("0"+MID$(STR$(YEAR),2),2)
GOSUB LOCATE. : PRINT "                               ";
GOSUB LOCATE. : PRINT WEEK$(WEEK);", ";REC$;
RETURN
'
ADVANCE.DATE:
'
'    THE PURPOSE OF THIS ROUTINE IS TO ADVANCE THE CURRENT DATE
'    BY ONE DAY.  ENTRY & EXIT:  THE MAIN ROUTINE.
'
WEEK=WEEK+1 : IF WEEK>7 THEN WEEK=1
DAY=DAY+1 : GOSUB MAX.DAY
IF DAY>MAX.DAY THEN
  DAY=1
  MONTH=MONTH+1
  IF MONTH>12 THEN MONTH=1 : YEAR=YEAR+1
  IF YEAR > 99 THEN YEAR = 0 : CENTURY = CENTURY + 1
  IF CENTURY > 99 THEN GOSUB INIT.DATE
END IF
RETURN
'
BACKUP.DATE:
'
'    THE PURPOSE OF THIS ROUTINE IS TO BACKUP THE CURRENT DATE
'    BY ONE DAY.  ENTRY & EXIT:  THE MAIN ROUTINE.
'
WEEK=WEEK-1 : IF WEEK<1 THEN WEEK=7
DAY=DAY-1
IF DAY<1 THEN
  MONTH=MONTH-1 : IF MONTH<1 THEN MONTH=12 : YEAR=YEAR-1
  IF YEAR < 0 THEN YEAR = 99 : CENTURY = CENTURY - 1
  IF CENTURY < 0 THEN GOSUB INIT.DATE
  GOSUB MAX.DAY : DAY=MAX.DAY
END IF
RETURN
'
SET.DATE:
'
'    THE PURPOSE OF THIS ROUTINE IS TO SET THE SYSTEM DATE.
'    ENTRY & EXIT:  THE MAIN ROUTINE.
'
REC$="DATE "+FNSETR$("0"+MID$(STR$(MONTH),2),2)+"/"
REC$=REC$   +FNSETR$("0"+MID$(STR$(DAY),2),2)  +"/"
REC$=REC$   +FNSETR$("0"+MID$(STR$(CENTURY),2),2)
REC$=REC$   +FNSETR$("0"+MID$(STR$(YEAR),2),2)
: SHELL REC$
RETURN
REM
REM     MAIN ROUTINES EXIT.
REM
END