home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / basic / library / qb_pds / date / weekday / weekday.bas < prev    next >
Encoding:
BASIC Source File  |  1994-01-14  |  6.3 KB  |  224 lines
  1. '*******************************WEEKDAY.BAS*******************************
  2. 'Day of the Week for any date from 1-1-1980 to 12-31-2099
  3. 'Date limitation is that imposed by MS-DOS's day-of-the-week code.
  4. '
  5. 'JRD NOTE:
  6. 'from an assembly program example in Norton's "PC Programmer's Bible"
  7. '(3rd Edition: Microsoft Press, 1993) on page 426 extolling that it
  8. 'was a "real program" used in Norton's Utilities.
  9. '
  10. 'This is a real program in QuickBasic 4.5.
  11. '
  12. '1st - Save the present date
  13. '2nd - Change to new date
  14. '3rd - Get Weekday of new date
  15. '4th - Change back to correct date
  16. '5th - Verify correct date (this is not necessary,
  17. '                           but I wear a belt and suspenders)
  18. '
  19. 'MS-DOS Date Service INTERRUPT information on page 394 same book
  20. '
  21. 'The SUB - DosInt (ax%, bx%, cx%, dx%) - is the backbone of this program.
  22. 'Everytime it is CALLed, variables are passed to it and -returned- from it
  23. 'This SUB passes variables to the DOS Interrupt &H21
  24. '
  25. 'All Registers contain integers (2 bytes or a WORD)
  26. 'Only the AX,BX,CX,DX Registers can be split into High and Low bytes.
  27. 'One byte numbers can be used to pass variables.
  28. 'eg:
  29. 'To get the AH and AL bytes of AX we to use the following code:
  30. '
  31. 'HiByte%  = Regs.AX \ 256               'AH
  32. 'LowByte% = Regs.AX MOD 256             'AL
  33. 'because it's easier to remember than...
  34. 'LowByte%= Regs.AX AND 255              'AL
  35. '
  36. 'Variables to know about
  37. '
  38. 'WeekDay% in AL; 0 = Sunday; 6 = Saturday
  39. '
  40. 'Year% in CX; 1980 through 2099
  41. '
  42. 'Month% in DH; 1 through 12
  43. '
  44. 'Day% in DL; 1 to 28,29,30,31 depending on the month
  45. '
  46. '==============================END OF TEXT=============================
  47. '
  48. 'Declarations, Routines and include files below
  49. DEFINT A-Z
  50.  
  51. 'You -could- load QuickBASIC's include file for CALL INTERRUPT by
  52. 'removing the REM from the next line
  53. REM ' $INCLUDE: 'qb.bi'
  54.  
  55. 'and then erase the User Defined TYPE that follows...
  56. 'BUT the following TYPE  can be used for
  57. 'both CALL INTERRUPT and CALL INTERRUPTX
  58.  
  59. TYPE RegType
  60.      ax        AS INTEGER
  61.      bx        AS INTEGER
  62.      cx        AS INTEGER
  63.      dx        AS INTEGER
  64.      bp        AS INTEGER
  65.      si        AS INTEGER
  66.      di        AS INTEGER
  67.      Flags     AS INTEGER
  68.      ds        AS INTEGER
  69.      es        AS INTEGER
  70. END TYPE
  71.  
  72. 'can =NOT= use "Regs" for both "InRegs" and "OutRegs" if you plan to
  73. 'compile this; but if you just run this program in the QuickBASIC
  74. 'environment then you can use the DECLARE as:
  75. 'DECLARE SUB INTERRUPT (IntNum%, Regs AS RegType, Regs AS RegType)
  76. 'and it will work just fine.... weird!
  77.  
  78. DECLARE SUB INTERRUPT (IntNum%, InRegs AS RegType, OutRegs AS RegType)
  79. DECLARE SUB DosInt (ax%, bx%, cx%, dx%)
  80. DECLARE SUB LocateIt (Row%, text$)
  81. DECLARE SUB ColorIt (Fgd%, Bkg%)
  82.  
  83. 'executable code starts here
  84. DEF FnCenter% (text$) = 41 - (LEN(text$) \ 2)
  85.  
  86. Again:
  87. CALL ColorIt(15, 1)
  88. CLS
  89.  
  90. DIM DayName(0 TO 6) AS STRING
  91.    
  92.     DayName(0) = "Sunday"
  93.     DayName(1) = "Monday"
  94.     DayName(2) = "Tuesday"
  95.     DayName(3) = "Wednesday"
  96.     DayName(4) = "Thursday"
  97.     DayName(5) = "Friday"
  98.     DayName(6) = "Saturday"
  99.  
  100.  
  101. text$ = "Find Day of the Week, TYPE:"
  102. CALL LocateIt(5, text$)
  103.  
  104. text$ = "Month(1 to 12), Day(1 to 31), Year(1980 to 2099)"
  105. CALL LocateIt(7, text$)
  106.  
  107. text$ = "Use -commas- between numbers"
  108. CALL LocateIt(9, text$)
  109.  
  110. text$ = SPACE$(10)
  111. CALL ColorIt(11, 0)
  112. CALL LocateIt(11, text$)
  113. LOCATE 11, FnCenter(text$)
  114.  
  115. 'With a little effort; you can convert this code into a FUNCTION
  116. 'that returns the WeekDay$ of a valid date eg:
  117. 'PayDay$ = WeekDay$(month%,day,year%)
  118.  
  119. INPUT "", month%, day%, year%
  120. CALL ColorIt(15, 1)
  121.  
  122. DIM Regs AS RegType                 'don't have to use InRegs and OutRegs
  123.                                     'to pass variables to and get variables
  124.                                     'from INTERRUPT; BUT, =must= in DECLARE
  125.  
  126. 'store date numbers
  127. ax% = &H2A00                        'Function AH = 2A Get Date.
  128.                                     '&H2A00 is written this way and STORED
  129.                                     '"back-words" as &H002A
  130.                                     
  131. CALL DosInt(ax%, bx%, cx%, dx%)     'THE MAIN SUB
  132.                                    
  133.                                     'returns variables as below
  134. StoreMonDay% = dx%                  'DH = month%; DL = day%
  135. StoreYear% = cx%                    'CX = year from 1980 to 2099
  136.  
  137. 'change to new date
  138. ax% = &H2B00                        'Function AH = 2B Set date
  139. dx% = day% + (month% * 256)         'DH = month%; DL= Day%
  140. cx% = year%
  141.  
  142. CALL DosInt(ax%, bx%, cx%, dx%)
  143.  
  144. IF ax% MOD 256 = &HFF THEN          '&H00 returned to AL if date is valid
  145.     BEEP                            '&HFF returned if date is INVALID
  146.     CALL ColorIt(14 + 16, 1)        'make it blink
  147.     text$ = "ILLEGAL DATE"          'see... this is "better" than the Assembly
  148.     CALL LocateIt(13, text$)        'program as there was no error checking
  149.                                     'in the Assembly code.
  150.     text$ = "PRESS: A key to Try Again..."
  151.     CALL LocateIt(15, text$)
  152.     SLEEP                           'why this key trap? Oh, I don't know...
  153.     WHILE INKEY$ <> "": WEND        'but removes the key press
  154.     GOTO Again                      'loop back to the beginning, redraw the screen.
  155. END IF
  156.  
  157. 'now we get the new Weekday% number
  158. ax% = &H2A00                       'Function AH = 2A Get Date.
  159.  
  160. CALL DosInt(ax%, bx%, cx%, dx%)
  161.  
  162. WeekDay% = ax% MOD 256
  163. month% = dx% \ 256
  164. day% = dx% MOD 256
  165. year% = cx%
  166.  
  167. text$ = "New date is..."
  168. CALL LocateIt(16, text$)
  169.  
  170. DateString$ = DayName(WeekDay%) + STR$(month%) + "-" + LTRIM$(STR$(day%)) + "-" + LTRIM$(STR$(year%))
  171. CALL LocateIt(18, DateString$)
  172.  
  173. 'change back to correct date
  174. ax% = &H2B00                       'Function AH = 2B Set date
  175. dx% = StoreMonDay%
  176. cx% = StoreYear%
  177.  
  178. CALL DosInt(ax%, bx%, cx%, dx%)
  179.  
  180. 'now show that we restored the correct date, really don't need this
  181. ax% = &H2A00                       'Function AH = 2A Get Date.
  182.  
  183. CALL DosInt(ax%, bx%, cx%, dx%)
  184.  
  185. WeekDay% = ax% MOD 256
  186. month% = dx% \ 256
  187. day% = dx% MOD 256
  188. year% = cx%
  189.  
  190. text$ = "Correct date is..."
  191. CALL LocateIt(20, text$)
  192.  
  193. DateString$ = DayName(WeekDay%) + STR$(month%) + "-" + LTRIM$(STR$(day%)) + "-" + LTRIM$(STR$(year%))
  194. CALL LocateIt(22, DateString$)
  195. CALL ColorIt(7, 0)
  196. END
  197.  
  198. SUB ColorIt (Fgd, Bkg)
  199. COLOR Fgd, Bkg
  200. END SUB
  201.  
  202. SUB DosInt (ax%, bx%, cx%, dx%)
  203. DIM Regs AS RegType
  204.  
  205. Regs.ax = ax%
  206. Regs.bx = bx%
  207. Regs.cx = cx%
  208. Regs.dx = dx%
  209.  
  210. CALL INTERRUPT(&H21, Regs, Regs)
  211.  
  212. ax% = Regs.ax
  213. bx% = Regs.bx
  214. cx% = Regs.cx
  215. dx% = Regs.dx
  216.             
  217. END SUB
  218.  
  219. SUB LocateIt (Row%, text$)
  220. LOCATE Row%, FnCenter(text$)
  221. PRINT text$;
  222. END SUB
  223.  
  224.