Need a formula: Extracting Years from Seconds Since January 1, 0001 12:00 AM

Question

Input: # of seconds since January 1st, of Year 0001

Output: # of Full years during this time period

I have developed an algorithm that I do not think is the

Answer 1

The following assumes that the Gregorian calendar will remain in effect for the upcoming five hundred and eighty four and a half billion years. Be prepared for disappointment, though; the calendar may end up being scrapped as our sun begins to expand, changing the orbit of the Earth and the duration of the year, and it is very likely something else will be adopted when the Earth falls into the sun seven and a half billion years from now.

As an aside, I don't even try to handle dates prior to the adoption of the Gregorian calendar. I simply return the number of days the date occurred prior to the 15th of October, 1582, and the need to be able to express that sort of return value is the only reason the GetDateFromSerial function has an asString parameter.

Sub GetDateFromSerial(ByVal dateSerial As ULong, ByRef year As Long, ByRef month As Integer, ByRef dayOfMonth As Integer, ByRef secondsIntoDay As Integer, ByRef asString As String)
    Const SecondsInOneDay As ULong = 86400 ' 24 hours * 60 minutes per hour * 60 seconds per minute

    'Dim startOfGregorianCalendar As DateTime = New DateTime(1582, 10, 15)
    'Dim startOfGregorianCalendarInSeconds As ULong = (startOfGregorianCalendar - New DateTime(1, 1, 1)).TotalSeconds

    Const StartOfGregorianCalendarInSeconds As ULong = 49916304000

    secondsIntoDay = dateSerial Mod SecondsInOneDay

    If dateSerial < StartOfGregorianCalendarInSeconds Then
        year = -1
        month = -1
        dayOfMonth = -1

        Dim days As Integer = (StartOfGregorianCalendarInSeconds - dateSerial) \ SecondsInOneDay

        asString = days & IIf(days = 1, " day", " days") & " before the adoption of the Gregorian calendar on October 15, 1582"
    Else
        'Dim maximumDateValueInSeconds As ULong = (DateTime.MaxValue - New DateTime(1, 1, 1)).TotalSeconds
        Const MaximumDateValueInSeconds As ULong = 315537897600

        If dateSerial <= MaximumDateValueInSeconds Then
            Dim parsedDate As DateTime = DateTime.MinValue.AddSeconds(dateSerial)

            year = parsedDate.Year
            month = parsedDate.Month
            dayOfMonth = parsedDate.Day
        Else
            ' Move the date back into the range that DateTime can parse, by stripping away blocks of
            ' 400 years. Aim to put the date within the range of years 2001 to 2400.
            Dim dateSerialInDays As ULong = dateSerial \ SecondsInOneDay

            Const DaysInFourHundredYears As Integer = 365 * 400 + 97 ' Three multiple-of-4 years in each 400 are not leap years.

            Dim fourHundredYearBlocks As Integer = dateSerialInDays \ DaysInFourHundredYears

            Dim blocksToFactorInLater As Integer = fourHundredYearBlocks - 5

            Dim translatedDateSerialInDays As ULong = dateSerialInDays - blocksToFactorInLater * CLng(DaysInFourHundredYears)

            ' Parse the date as normal now.
            Dim parsedDate As DateTime = DateTime.MinValue.AddDays(translatedDateSerialInDays)

            year = parsedDate.Year
            month = parsedDate.Month
            dayOfMonth = parsedDate.Day

            ' Factor back in the years we took out earlier.
            year += blocksToFactorInLater * 400L
        End If

        asString = New DateTime(2000, month, dayOfMonth).ToString("dd MMM") & ", " & year
    End If
End Sub

Function GetSerialFromDate(ByVal year As Long, ByVal month As Integer, ByVal dayOfMonth As Integer, ByVal secondsIntoDay As Integer) As ULong
    Const SecondsInOneDay As Integer = 86400 ' 24 hours * 60 minutes per hour * 60 seconds per minute

    If (year < 1582) Or _
       ((year = 1582) And (month < 10)) Or _
       ((year = 1582) And (month = 10) And (dayOfMonth < 15)) Then
        Throw New Exception("The specified date value has no meaning because it falls before the point at which the Gregorian calendar was adopted.")
    End If

    ' Use DateTime for what we can -- which is years prior to 9999 -- and then factor the remaining years
    ' in. We do this by translating the date back by blocks of 400 years (which are always the same length,
    ' even factoring in leap years), and then factoring them back in after the fact.

    Dim fourHundredYearBlocks As Integer = year \ 400

    Dim blocksToFactorInLater As Integer = fourHundredYearBlocks - 5

    If blocksToFactorInLater < 0 Then blocksToFactorInLater = 0

    year = year - blocksToFactorInLater * 400L

    Dim dateValue As DateTime = New DateTime(year, month, dayOfMonth)

    Dim translatedDateSerialInDays As ULong = (dateValue - New DateTime(1, 1, 1)).TotalDays

    Const DaysInFourHundredYears As ULong = 365 * 400 + 97 ' Three multiple-of-4 years in each 400 are not leap years.

    Dim dateSerialInDays As ULong = translatedDateSerialInDays + blocksToFactorInLater * DaysInFourHundredYears

    Dim dateSerial As ULong = dateSerialInDays * SecondsInOneDay + secondsIntoDay

    Return dateSerial
End Function