#if 0
    ----------------------------                      PowerBASIC v8.x
 ---|          DASoft          |------------------------------------------
    ----------------------------         Code           DATE: 2006-04-08
    | FILE NAME  TimeStamp.bas |          by
    ----------------------------  Don Schullian, Jr.

              This code is released into the Public Domain
       ----------------------------------------------------------
        No guarantee as to the viability, accuracy, or safety of
         use of this code is implied, warranted, or guaranteed
       ----------------------------------------------------------
                         Use at your own risk!
       ----------------------------------------------------------
                  CONTACT AUTHOR AT don@DASoftVSS.com
 -------------------------------------------------------------------------

This 32 bit time stamp holds the date and time with a resolution of 2 secs.
The span of dates capable of being held is variable by setting the constant
%DateOffset. Two values are offered in this file. To be able to extract the
day of the week from the day count (Days??) the first date (Day 1) must be
Jan. 1 of a year that is the first year after a leap year and the day of the
week must be Monday.

By setting %DateOffset to zero you can use the date packers as longs and have
a spread of 5M years.

#endif


#COMPILE EXE
#COMPILER PBWIN 8, PBCC 4
#DEBUG ERROR ON
#TOOLS ON
#DIM ALL

TYPE SYSTEMTIME
  wYear         AS WORD
  wMonth        AS WORD
  wDayOfWeek    AS WORD
  wDay          AS WORD
  wHour         AS WORD
  wMinute       AS WORD
  wSecond       AS WORD
  wMilliseconds AS WORD
END TYPE

DECLARE SUB GetLocalTime LIB "KERNEL32.DLL" ALIAS "GetLocalTime" (lpSystemTime AS SYSTEMTIME)

 %DateOffset = 728658 ' Jan 1, 1996 -> Jun 5, 2175
'%DateOffset = 685195 ' Jan 1, 1877 -> Jun 5, 2056
'
'------------------------------------------------------------------------------
'
FUNCTION fLeapYear (BYVAL Year AS LONG) AS LONG

  IF ( ( Year MOD   4 ) = 0 ) AND _
     ( ( Year MOD 100 ) > 0 )  OR _
     ( ( Year MOD 400 ) = 0 ) THEN FUNCTION = 1

END FUNCTION
'
'------------------------------------------------------------------------------
'
FUNCTION fJulianDay (BYVAL Year  AS LONG, _
                     BYVAL Month AS LONG, _
                     BYVAL Day   AS LONG  ) AS LONG

  Day = Day + VAL(READ$(Month))
  IF Month > 2 THEN
    Day = Day + fLeapYear(Year)
  END IF

  FUNCTION = Day

  DATA 000, 031, 059, 090, 120, 151
  DATA 181, 212, 243, 273, 304, 334

END FUNCTION
'
'------------------------------------------------------------------------------
'
SUB Julian2MD ( BYVAL Year  AS LONG, _
                BYVAL Days  AS LONG, _
                      Month AS LONG, _
                      Day   AS LONG  )


  DIM LeapYear AS LOCAL LONG

  LeapYear = fLeapYear(Year)
  Month    = 12

  DO
    Day = VAL(READ$(Month)) + LeapYear
    IF Days > Day THEN
      Day = Days - Day
      EXIT SUB
    END IF
    DECR Month
    IF Month = 2 THEN LeapYear = 0
  LOOP UNTIL Month = 0

  DATA 000, 031, 059, 090, 120, 151
  DATA 181, 212, 243, 273, 304, 334

END SUB
'
'------------------------------------------------------------------------------
'
FUNCTION fDaysInMonth (BYVAL Year  AS LONG, _
                       BYVAL Month AS LONG  ) AS LONG

  DIM Days AS LOCAL LONG

  Days = VAL(READ$(Month))
  IF Month = 2 THEN Days = Days + fLeapYear(Year)

  FUNCTION = Days

  DATA 31, 28, 31, 30, 31, 30
  DATA 31, 31, 30, 31, 30, 31

END FUNCTION
'
'------------------------------------------------------------------------------
'
FUNCTION fDays2YMD (BYVAL Days  AS LONG, _
                          Year  AS LONG, _
                          Month AS LONG, _
                          Day   AS LONG  ) AS LONG

  DIM DoW  AS LOCAL LONG
  DIM Temp AS LOCAL LONG

  Days = Days + %DateOffset
  DoW  = (Days MOD 7)
  Year = (Days \ 365)
  Temp = (Year \ 4) - (Year \ 100) + (Year \ 400)
  Days = (Days MOD 365) - Temp

  WHILE Days < 1
    Days = Days + 365 + fLeapYear(Year)
    DECR Year
  WEND

  INCR Year

  Julian2MD Year, Days, Month, Day

  FUNCTION = DoW

END FUNCTION
'
'------------------------------------------------------------------------------
'
FUNCTION fYMD2Days (BYVAL Year  AS LONG, _
                    BYVAL Month AS LONG, _
                    BYVAL Day   AS LONG  ) AS LONG

  IF ( Year  = 0 )   OR _
     ( Month = 0 )   OR _
     ( Day   = 0 ) THEN EXIT FUNCTION

  IF Month > 1 THEN Day = fJulianDay(Year,Month,Day)     'compute Julian day
  DECR Year                                              'don't count 'this year'
  Day = Day + (Year * 365) + _                           ' add full years
              (Year \   4) - _                           ' add a day for each olympiad
              (Year \ 100) + _                           ' subtract a day for each century
              (Year \ 400)                               ' add a day for each epoc
                                                         '
  FUNCTION = Day - %DateOffset                           'RETURN day count
                                                         '  unREM to use WORDs
END FUNCTION
'
'------------------------------------------------------------------------------
'
FUNCTION fTimeStamp () AS DWORD

  DIM  Days AS LOCAL WORD
  DIM  Mins AS LOCAL WORD
  DIM tS    AS LOCAL SystemTime

  GetLocalTime tS

  Mins = (tS.wHour * 1800) + (tS.wMinute * 30) + (tS.wSecond \ 2)
  Days = fYMD2Days(tS.wYear,tS.wMonth,tS.wDay)

  FUNCTION = MAK(DWORD,Mins,Days)

END FUNCTION
'
'------------------------------------------------------------------------------
'
FUNCTION PBMAIN () AS LONG

  DIM D AS LOCAL LONG
  DIM W AS LOCAL STRING
  DIM H AS LOCAL LONG
  DIM M AS LOCAL LONG
  DIM S AS LOCAL LONG
  DIM Y AS LOCAL LONG
  DIM T AS LOCAL DWORD

  fDays2YMD &h00001, Y, M, D
  ? "First Date" & STR$(Y) & STR$(M) & STR$(D)
  fDays2YMD &h0ffff, Y, M, D
  ? "Last Date" & STR$(Y) & STR$(M) & STR$(D)

  T = fTimeStamp
  ? "Time Stamp" & STR$(T)
  D = HI(WORD,T)
  W = READ$((D MOD 7) +1)
  fDays2YMD D, Y, M, D
  ? "Date " &  W & STR$(Y) & STR$(M) & STR$(D)
  T = LO(WORD,T)
  H = T \ 1800
  S = T MOD 30
  M = (T - (H*1800)) \ 30
  ? "Time" & STR$(H) & STR$(M) & STR$(S)

#IF %DEF(%PB_CC32)
  INPUT FLUSH
  WAITKEY$
#ENDIF

  DATA Sun, Mon, Tue, Wed, Thr, Fri, Sat

END FUNCTION