some date/time/timestamp functions revisited

[mdijkens]

I've written this a long time ago and still using it everywhere to handle/calculate with dates/times:

Code: (Select All)

Function timeStamp~&& (dt$)
  year% = Val(Left$(dt$, 4)): month% = Val(Mid$(dt$, 6, 2)): day% = Val(Mid$(dt$, 9, 2))
  hour% = Val(Mid$(dt$, 13, 2)): minute% = Val(Mid$(dt$, 16, 2)): second% = Val(Mid$(dt$, 19, 2))
  timeStamp~&& = TIM.stamp(year%, month%, day%, hour%, minute%, second%)
End Function

Function timeString$ (dt~&&)
  dt$ = TIM.dateTime$(dt~&&, year%, month%, day%, hour%, minute%, second%)
  timeString$ = Left$(dt$, 4) + "-" + Mid$(dt$, 5, 2) + "-" + Mid$(dt$, 7, 2) + "  " + Mid$(dt$, 9, 2) + ":" + Mid$(dt$, 11, 2) + ":" + Mid$(dt$, 13, 2)
End Function

Function TIM.now~&& ()
  dat$ = Date$: tim~& = Timer
  month% = Val(Left$(dat$, 2))
  day% = Val(Mid$(dat$, 4, 2))
  year% = Val(Mid$(dat$, 7, 4))
  TIM.now~&& = TIM.days~&(year%, month%, day%) * 86400~&& + tim~&
End Function

Function TIM.utc~&& ()
  Type UTCtype
    year As Integer
    month As Integer
    weekday As Integer
    day As Integer
    hour As Integer
    minute As Integer
    second As Integer
    millis As Integer
  End Type
  Declare Dynamic Library "Kernel32"
    Sub GetUTC Alias GetSystemTime (lpSystemTime As UTCtype)
  End Declare
  Dim utc As UTCtype: GetUTC utc
  TIM.utc~&& = TIM.stamp~&&(utc.year, utc.month, utc.day, utc.hour, utc.minute, utc.second)
End Function

Function TIM.stamp~&& (year%, month%, day%, hour%, minute%, second%)
  TIM.stamp~&& = TIM.days~&(year%, month%, day%) * 86400~&& + TIM.seconds~&(hour%, minute%, second%)
End Function

Function TIM.days~& (year%, month%, day%)
  leap% = TIM.leapYear(year%): prevYear% = year% - 1
  dPrevYears& = ((((prevYear% * 365) + (prevYear% \ 4)) - (prevYear% \ 100)) + (prevYear% \ 400))
  Select Case month%
    Case 1: TIM.days~& = ((dPrevYears&) + day%) - 1
    Case 2: TIM.days~& = ((dPrevYears& + 31) + day%) - 1
    Case 3: TIM.days~& = ((dPrevYears& + 59 - leap%) + day%) - 1
    Case 4: TIM.days~& = ((dPrevYears& + 90 - leap%) + day%) - 1
    Case 5: TIM.days~& = ((dPrevYears& + 120 - leap%) + day%) - 1
    Case 6: TIM.days~& = ((dPrevYears& + 151 - leap%) + day%) - 1
    Case 7: TIM.days~& = ((dPrevYears& + 181 - leap%) + day%) - 1
    Case 8: TIM.days~& = ((dPrevYears& + 212 - leap%) + day%) - 1
    Case 9: TIM.days~& = ((dPrevYears& + 243 - leap%) + day%) - 1
    Case 10: TIM.days~& = ((dPrevYears& + 273 - leap%) + day%) - 1
    Case 11: TIM.days~& = ((dPrevYears& + 304 - leap%) + day%) - 1
    Case 12: TIM.days~& = ((dPrevYears& + 334 - leap%) + day%) - 1
    Case Else: TIM.days~& = 0
  End Select
End Function

Function TIM.seconds~& (hour%, minute%, second%)
  TIM.seconds~& = hour% * 3600 + minute% * 60 + second%
End Function

Function TIM.dateTime$ (timestmp~&&, year%, month%, day%, hour%, minute%, second%)
  tdays~& = timestmp~&& \ 86400 + 306
  secs~& = timestmp~&& Mod 86400
  era% = tdays~& \ 146097
  doe~& = tdays~& Mod 146097 ' [0, 146096]
  yoe% = (doe~& - doe~& \ 1460 + doe~& \ 36524 - doe~& \ 146096) \ 365 ' [0, 399]
  year% = yoe% + era% * 400
  doy% = doe~& - (365 * yoe% + yoe% \ 4 - yoe% \ 100) ' [0, 365]
  mp% = (5 * doy% + 2) \ 153 ' [0, 11]
  day% = doy% - (153 * mp% + 2) \ 5 + 1 ' [1, 31]
  If mp% < 10 Then month% = mp% + 3 Else month% = mp% - 9 ' [1, 12]
  year% = year% - (month% <= 2)
  dat$ = Right$("000" + LTrim$(Str$(year%)), 4) + _
    Right$("0" + LTrim$(Str$(month%)), 2) + _
    Right$("0" + LTrim$(Str$(day%)), 2)
  hour% = secs~& \ 3600
  minsec% = secs~& - (hour% * 3600)
  minute% = minsec% \ 60
  second% = minsec% - (minute% * 60)
  TIM.dateTime$ = dat$ + _
  Right$("0" + LTrim$(Str$(hour%)), 2) + _
    Right$("0" + LTrim$(Str$(minute%)), 2) + _
    Right$("0" + LTrim$(Str$(second%)), 2)
End Function

Function TIM.format$ (ts~&&)
  dt$ = TIM.dateTime$(ts~&&, year, month, day, hour, minute, second)
  dt2$ = Mid$("SuMoTuWeThFrSa", TIM.weekDay(ts~&&) * 2 + 1, 2)+" " + _
    Mid$(dt$, 7, 2) + "-" + Mid$(dt$, 5, 2) + "-" + Mid$(dt$, 1, 4) + " " + _
    Mid$(dt$, 9, 2) + ":" + Mid$(dt$, 11, 2) + ":" + Mid$(dt$, 13, 2)
  TIM.format$ = dt2$
End Function

Function TIM.leapYear% (year%)
  If (year% Mod 4) <> 0 Then
    TIM.leapYear% = FALSE
  ElseIf (year% Mod 100) = 0 Then
    TIM.leapYear% = (year% Mod 400) = 0
  Else
    TIM.leapYear% = TRUE
  End If
End Function

Function TIM.weekDay% (ts~&&)
  tdays~& = ts~&& \ 86400
  TIM.weekDay% = (tdays~& + 1) Mod 7
End Function