home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Monster Media 1994 #1
/
monster.zip
/
monster
/
PROG_BAS
/
WEEKDAY.ZIP
/
WEEKDAY.BAS
< prev
next >
Wrap
BASIC Source File
|
1994-01-14
|
6KB
|
224 lines
'*******************************WEEKDAY.BAS*******************************
'Day of the Week for any date from 1-1-1980 to 12-31-2099
'Date limitation is that imposed by MS-DOS's day-of-the-week code.
'
'JRD NOTE:
'from an assembly program example in Norton's "PC Programmer's Bible"
'(3rd Edition: Microsoft Press, 1993) on page 426 extolling that it
'was a "real program" used in Norton's Utilities.
'
'This is a real program in QuickBasic 4.5.
'
'1st - Save the present date
'2nd - Change to new date
'3rd - Get Weekday of new date
'4th - Change back to correct date
'5th - Verify correct date (this is not necessary,
' but I wear a belt and suspenders)
'
'MS-DOS Date Service INTERRUPT information on page 394 same book
'
'The SUB - DosInt (ax%, bx%, cx%, dx%) - is the backbone of this program.
'Everytime it is CALLed, variables are passed to it and -returned- from it
'This SUB passes variables to the DOS Interrupt &H21
'
'All Registers contain integers (2 bytes or a WORD)
'Only the AX,BX,CX,DX Registers can be split into High and Low bytes.
'One byte numbers can be used to pass variables.
'eg:
'To get the AH and AL bytes of AX we to use the following code:
'
'HiByte% = Regs.AX \ 256 'AH
'LowByte% = Regs.AX MOD 256 'AL
'because it's easier to remember than...
'LowByte%= Regs.AX AND 255 'AL
'
'Variables to know about
'
'WeekDay% in AL; 0 = Sunday; 6 = Saturday
'
'Year% in CX; 1980 through 2099
'
'Month% in DH; 1 through 12
'
'Day% in DL; 1 to 28,29,30,31 depending on the month
'
'==============================END OF TEXT=============================
'
'Declarations, Routines and include files below
DEFINT A-Z
'You -could- load QuickBASIC's include file for CALL INTERRUPT by
'removing the REM from the next line
REM ' $INCLUDE: 'qb.bi'
'and then erase the User Defined TYPE that follows...
'BUT the following TYPE can be used for
'both CALL INTERRUPT and CALL INTERRUPTX
TYPE RegType
ax AS INTEGER
bx AS INTEGER
cx AS INTEGER
dx AS INTEGER
bp AS INTEGER
si AS INTEGER
di AS INTEGER
Flags AS INTEGER
ds AS INTEGER
es AS INTEGER
END TYPE
'can =NOT= use "Regs" for both "InRegs" and "OutRegs" if you plan to
'compile this; but if you just run this program in the QuickBASIC
'environment then you can use the DECLARE as:
'DECLARE SUB INTERRUPT (IntNum%, Regs AS RegType, Regs AS RegType)
'and it will work just fine.... weird!
DECLARE SUB INTERRUPT (IntNum%, InRegs AS RegType, OutRegs AS RegType)
DECLARE SUB DosInt (ax%, bx%, cx%, dx%)
DECLARE SUB LocateIt (Row%, text$)
DECLARE SUB ColorIt (Fgd%, Bkg%)
'executable code starts here
DEF FnCenter% (text$) = 41 - (LEN(text$) \ 2)
Again:
CALL ColorIt(15, 1)
CLS
DIM DayName(0 TO 6) AS STRING
DayName(0) = "Sunday"
DayName(1) = "Monday"
DayName(2) = "Tuesday"
DayName(3) = "Wednesday"
DayName(4) = "Thursday"
DayName(5) = "Friday"
DayName(6) = "Saturday"
text$ = "Find Day of the Week, TYPE:"
CALL LocateIt(5, text$)
text$ = "Month(1 to 12), Day(1 to 31), Year(1980 to 2099)"
CALL LocateIt(7, text$)
text$ = "Use -commas- between numbers"
CALL LocateIt(9, text$)
text$ = SPACE$(10)
CALL ColorIt(11, 0)
CALL LocateIt(11, text$)
LOCATE 11, FnCenter(text$)
'With a little effort; you can convert this code into a FUNCTION
'that returns the WeekDay$ of a valid date eg:
'PayDay$ = WeekDay$(month%,day,year%)
INPUT "", month%, day%, year%
CALL ColorIt(15, 1)
DIM Regs AS RegType 'don't have to use InRegs and OutRegs
'to pass variables to and get variables
'from INTERRUPT; BUT, =must= in DECLARE
'store date numbers
ax% = &H2A00 'Function AH = 2A Get Date.
'&H2A00 is written this way and STORED
'"back-words" as &H002A
CALL DosInt(ax%, bx%, cx%, dx%) 'THE MAIN SUB
'returns variables as below
StoreMonDay% = dx% 'DH = month%; DL = day%
StoreYear% = cx% 'CX = year from 1980 to 2099
'change to new date
ax% = &H2B00 'Function AH = 2B Set date
dx% = day% + (month% * 256) 'DH = month%; DL= Day%
cx% = year%
CALL DosInt(ax%, bx%, cx%, dx%)
IF ax% MOD 256 = &HFF THEN '&H00 returned to AL if date is valid
BEEP '&HFF returned if date is INVALID
CALL ColorIt(14 + 16, 1) 'make it blink
text$ = "ILLEGAL DATE" 'see... this is "better" than the Assembly
CALL LocateIt(13, text$) 'program as there was no error checking
'in the Assembly code.
text$ = "PRESS: A key to Try Again..."
CALL LocateIt(15, text$)
SLEEP 'why this key trap? Oh, I don't know...
WHILE INKEY$ <> "": WEND 'but removes the key press
GOTO Again 'loop back to the beginning, redraw the screen.
END IF
'now we get the new Weekday% number
ax% = &H2A00 'Function AH = 2A Get Date.
CALL DosInt(ax%, bx%, cx%, dx%)
WeekDay% = ax% MOD 256
month% = dx% \ 256
day% = dx% MOD 256
year% = cx%
text$ = "New date is..."
CALL LocateIt(16, text$)
DateString$ = DayName(WeekDay%) + STR$(month%) + "-" + LTRIM$(STR$(day%)) + "-" + LTRIM$(STR$(year%))
CALL LocateIt(18, DateString$)
'change back to correct date
ax% = &H2B00 'Function AH = 2B Set date
dx% = StoreMonDay%
cx% = StoreYear%
CALL DosInt(ax%, bx%, cx%, dx%)
'now show that we restored the correct date, really don't need this
ax% = &H2A00 'Function AH = 2A Get Date.
CALL DosInt(ax%, bx%, cx%, dx%)
WeekDay% = ax% MOD 256
month% = dx% \ 256
day% = dx% MOD 256
year% = cx%
text$ = "Correct date is..."
CALL LocateIt(20, text$)
DateString$ = DayName(WeekDay%) + STR$(month%) + "-" + LTRIM$(STR$(day%)) + "-" + LTRIM$(STR$(year%))
CALL LocateIt(22, DateString$)
CALL ColorIt(7, 0)
END
SUB ColorIt (Fgd, Bkg)
COLOR Fgd, Bkg
END SUB
SUB DosInt (ax%, bx%, cx%, dx%)
DIM Regs AS RegType
Regs.ax = ax%
Regs.bx = bx%
Regs.cx = cx%
Regs.dx = dx%
CALL INTERRUPT(&H21, Regs, Regs)
ax% = Regs.ax
bx% = Regs.bx
cx% = Regs.cx
dx% = Regs.dx
END SUB
SUB LocateIt (Row%, text$)
LOCATE Row%, FnCenter(text$)
PRINT text$;
END SUB