source: Include/Classes/System/DateTime.ab@ 274

' Classes/System/DateTime.ab

Class DateTime
    m_Date As Int64
Public
    Static MaxValue = 3162240000000000000 As Int64 'Const TicksPerDay*366*10000
    Static MinValue = 316224000000000 As Int64     'Const TicksPerDay*366

    Sub DateTime()
        initialize(MinValue, DateTimeKind.Unspecified)
    End Sub

    Sub DateTime(ticks As Int64)
        initialize(ticks, DateTimeKind.Unspecified)
    End Sub

    Sub DateTime(ticks As Int64, kind As DateTimeKind)
        initialize(ticks, kind)
    End Sub

    Sub DateTime(year As Long, month As Long, day As Long)
        initialize(year, month, day, 0, 0, 0, 0, DateTimeKind.Unspecified)
    End Sub

    Sub DateTime(year As Long, month As Long, day As Long, kind As DateTimeKind)
        initialize(year, month, day, 0, 0, 0, 0, kind)
    End Sub

    Sub DateTime(year As Long, month As Long, day As Long, hour As Long, minute As Long, second As Long)
        initialize(year, month, day, hour, minute, second, 0, DateTimeKind.Unspecified)
    End Sub

    Sub DateTime(year As Long, month As Long, day As Long, hour As Long, minute As Long, second As Long, kind As DateTimeKind)
        initialize(year, month, day, hour, minute, second, 0, kind)
    End Sub

    Sub DateTime(year As Long, month As Long, day As Long, hour As Long, minute As Long, second As Long, millisecond As Long)
        initialize(year, month, day, hour, minute, second, millisecond, DateTimeKind.Unspecified)
    End Sub

    Sub DateTime(year As Long, month As Long, day As Long, hour As Long, minute As Long, second As Long, millisecond As Long, kind As DateTimeKind)
        initialize(year, month, day, hour, minute, second, millisecond, kind)
    End Sub

    Sub DateTime(ByRef time As SYSTEMTIME)
        initialize(time.wYear, time.wMonth, time.wDay, time.wHour, time.wMinute, time.wSecond, time.wMilliseconds, DateTimeKind.Unspecified)
    End Sub

    Sub DateTime(ByRef time As SYSTEMTIME, kind As DateTimeKind)
        initialize(time.wYear, time.wMonth, time.wDay, time.wHour, time.wMinute, time.wSecond, time.wMilliseconds, kind)
    End Sub

    'Copy Constructor
    Sub DateTime(dateTime As DateTime)
        This.m_Date = dateTime.m_Date
    End Sub

    Sub ~DateTime()
    End Sub

    Function Operator + (value As TimeSpan) As DateTime
        Return New DateTime(Ticks + value.Ticks)
    End Function

    Function Operator - (value As DateTime) As TimeSpan
        Return TimeSpan.FromTicks(Ticks - value.Ticks)
    End Function

    Function Operator - (value As TimeSpan) As DateTime
        Return New DateTime(Ticks - value.Ticks)
    End Function

    Function Operator == (value As DateTime) As Boolean
        Return Equals(value)
    End Function

    Function Operator <> (value As DateTime) As Boolean
        Return Not Equals(value)
    End Function

    Function Operator > (value As DateTime) As Boolean
        If DateTime.Compare(This, value) > 0 Then
            Return True
        Else
            Return False
        End If
    End Function

    Function Operator < (value As DateTime) As Boolean
        If DateTime.Compare(This, value) < 0 Then
            Return True
        Else
            Return False
        End If
    End Function

    Function Operator >= (value As DateTime) As Boolean
        If DateTime.Compare(This, value) => 0 Then
            Return True
        Else
            Return False
        End If
    End Function

    Function Operator <= (value As DateTime) As Boolean
        If DateTime.Compare(This, value) <= 0 Then
            Return True
        Else
            Return False
        End If
    End Function
    
    'Public Properties
    Function Ticks() As Int64
        Return (m_Date And &H3FFFFFFFFFFFFFFF)
    End Function

    Function Millisecond() As Long
        Return (Ticks \ TimeSpan.TicksPerMillisecond Mod 1000) As Long
    End Function

    Function Second() As Long
        Return (Ticks \ TimeSpan.TicksPerSecond Mod 60) As Long
    End Function

    Function Minute() As Long
        Return (Ticks \ TimeSpan.TicksPerMinute Mod 60) As Long
    End Function

    Function Hour() As Long
        Return (Ticks \ TimeSpan.TicksPerHour Mod 24) As Long
    End Function

    Function Day() As Long
        Return DayOfYear - totalDaysOfMonth(Year, Month - 1)
    End Function

    Function Month() As Long
        Dim year = Year As Long
        Dim day = DayOfYear As Long
        Dim i = 1 As Long
        While day > totalDaysOfMonth(year, i)
            i++
        Wend
        Return i
    End Function

    Function Year() As Long
        Dim day = (Ticks \ TimeSpan.TicksPerDay) As Long
        Dim year = Int((day + day \ 36524 - day \ 146097) / 365.25) + 1 As Long
        If day - yearToDay(year - 1) + 1 = 366 Then
            Return year + 1
        Else
            Return year
        End If
    End Function

    Function DayOfWeek() As Long 'As DayOfWeek
        Return ((Ticks \ TimeSpan.TicksPerDay) Mod 7) As Long + 1
    End Function

    Function Kind() As DateTimeKind
        Return kindFromBinary(m_Date)
    End Function

    Function DayOfYear() As Long
        Return ((Ticks \ TimeSpan.TicksPerDay) - yearToDay(Year) + 1) As Long
    End Function

    Function Date() As DateTime
        Return New DateTime(Year, Month, Day, Kind)
    End Function

    Static Function Now() As DateTime
        Dim time As SYSTEMTIME
        GetLocalTime(time)
        Return New DateTime(time, DateTimeKind.Local)
    End Function

    Static Function Today() As DateTime
        Dim time As SYSTEMTIME
        GetLocalTime(time)
        Return New DateTime(time.wYear, time.wMonth, time.wDay, DateTimeKind.Local)
    End Function

    Static Function UtcNow() As DateTime
        Dim time As SYSTEMTIME
        GetSystemTime(time)
        Return New DateTime(time, DateTimeKind.Utc)
    End Function
        
    'Public Methods
    Static Function Compare(t1 As DateTime, t2 As DateTime) As Int64
        Return t1.Ticks - t2.Ticks
    End Function

    Function Equals(value As DateTime) As Boolean
        If value.m_Date = m_Date Then
            Return True
        Else
            Return False
        End If
    End Function

    Static Function Equals(t1 As DateTime, t2 As DateTime) As Boolean
        If t1.m_Date = t2.m_Date Then
            Return True
        Else
            Return False
        End If
    End Function

    Override Function GetHashCode() As Long
        Return HIDWORD(m_Date) Xor LODWORD(m_Date)
    End Function

    Function Add(value As TimeSpan) As DateTime
        Return This + value
    End Function

    Function AddTicks(value As Int64) As DateTime
        Return New DateTime(Ticks + value, Kind )
    End Function

    Function AddMilliseconds(value As Double) As DateTime
        Return AddTicks((value * TimeSpan.TicksPerMillisecond) As Int64)
    End Function

    Function AddSeconds(value As Double) As DateTime
        Return AddTicks((value * TimeSpan.TicksPerSecond) As Int64)
    End Function

    Function AddMinutes(value As Double) As DateTime
        Return AddTicks((value * TimeSpan.TicksPerMinute) As Int64)
    End Function

    Function AddHours(value As Double) As DateTime
        Return AddTicks((value * TimeSpan.TicksPerHour) As Int64)
    End Function

    Function AddDays(value As Double) As DateTime
        Return AddTicks((value * TimeSpan.TicksPerDay) As Int64)
    End Function

    Function AddYears(value As Double) As DateTime
        Dim date = New DateTime(Year + Int(value), Month, Day, Hour, Minute, Second, Millisecond, Kind)
        Dim ticks = Ticks _
                - (yearToDay(Year) + totalDaysOfMonth(Year, Month - 1) + Day - 1) * TimeSpan.TicksPerDay _
                - Hour * TimeSpan.TicksPerHour _
                - Minute * TimeSpan.TicksPerMinute _
                - Second * TimeSpan.TicksPerSecond _
                - Millisecond * TimeSpan.TicksPerMillisecond As Int64
        If IsLeapYear(Year + Int(value)) Then
            ticks += (value - Int(value)) * 366 * TimeSpan.TicksPerDay
        Else
            ticks += (value - Int(value)) * 365 * TimeSpan.TicksPerDay
        End If
        Return date.AddTicks(ticks)
    End Function

    Function Subtract(value As DateTime) As TimeSpan
        Return This - value
    End Function

    Function Subtract(value As TimeSpan) As DateTime
        Return This - value
    End Function

    Static Function DaysInMonth(year As Long, month As Long) As Long
        If year < 1 Or year > 9999 Or month < 1 Or month > 12 Then
            'ArgumentOutOfRangeException
            debug
        End If

        If IsLeapYear(year) And month = 2 Then
            Return 29
        Else
            Dim daysInMonth[11] = [31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31] As Byte
            Return daysInMonth[month - 1]
        End If
    End Function

    Static Function IsLeapYear(year As Long) As Boolean
        If (year Mod 400) = 0 Then Return True
        If (year Mod 100) = 0 Then Return False
        If (year Mod 4) = 0 Then Return True
        Return False
    End Function

    Function GetDateTimeFormats() As String
        Dim time = getSystemTime() 'As SYSTEMTIME を記述すると内部エラーが発生
        Dim dateFormatSize = GetDateFormat(LOCALE_USER_DEFAULT, 0, time, NULL, NULL, 0)
        Dim timeFormatSize = GetTimeFormat(LOCALE_USER_DEFAULT, 0, time, NULL, NULL, 0)
        Dim strLength = dateFormatSize + timeFormatSize
        Dim dateTimeFormats = GC_malloc_atomic(SizeOf (TCHAR) * (strLength)) As PTSTR
        GetDateFormat(LOCALE_USER_DEFAULT, 0, time, NULL, dateTimeFormats, dateFormatSize)
        dateTimeFormats[dateFormatSize - 1] = Asc(" ")
        GetTimeFormat(LOCALE_USER_DEFAULT, 0, time, NULL, dateTimeFormats + dateFormatSize, timeFormatSize)
'Debug
        Return New String(dateTimeFormats, strLength)
    End Function

    Function GetDateTimeFormats(format As *TCHAR) As String
        Dim time = getSystemTime() 'As SYSTEMTIME を記述すると内部エラーが発生
        Dim dateFormatSize = GetDateFormat(LOCALE_USER_DEFAULT, 0, time, format, NULL, 0)
        Dim dateFormats = malloc(dateFormatSize) As PTSTR
        GetDateFormat(LOCALE_USER_DEFAULT, 0, time, format, dateFormats, dateFormatSize)

        Dim dateTimeFormatSize = GetTimeFormat(LOCALE_USER_DEFAULT, 0, time, dateFormats, NULL, 0)
        Dim dateTimeFormats = malloc(dateTimeFormatSize) As PTSTR
        GetTimeFormat(LOCALE_USER_DEFAULT, 0, time, dateFormats, dateTimeFormats, dateTimeFormatSize)

        Return New String(dateTimeFormats)
    End Function

    Static Function FromBinary(date As Int64) As DateTime
        Return New DateTime((date And &H3FFFFFFFFFFFFFFF), kindFromBinary(date))
    End Function

    Function ToBinary() As Int64
        Return m_Date
    End Function

    Static Function FromFileTime(ByRef fileTime As FILETIME) As DateTime
        Dim localTime As FILETIME
        Dim time As SYSTEMTIME
        FileTimeToLocalFileTime(fileTime, localTime)
        FileTimeToSystemTime(localTime, time)
        Return New DateTime(time, DateTimeKind.Local)
    End Function

    Function ToFileTime() As FILETIME
        Dim time = getSystemTime() 'As SYSTEMTIME を記述すると内部エラーが発生 rev.207
        Dim fileTime As FILETIME
        SystemTimeToFileTime(time, fileTime)
        Return fileTime
    End Function

    Static Function FromFileTimeUtc(ByRef fileTime As FILETIME) As DateTime
        Dim time As SYSTEMTIME
        FileTimeToSystemTime(fileTime, time)
        Return New DateTime(time, DateTimeKind.Utc)
    End Function

    Function ToFileTimeUtc() As FILETIME
        Dim fileTime = ToFileTime() 'As FILETIME を記述すると内部エラー rev.207
        If Kind = DateTimeKind.Utc Then
            Return fileTime
        Else
            Dim utcTime As FILETIME
            LocalFileTimeToFileTime(fileTime, utcTime)
            Return utcTime
        End If
    End Function

    Function ToLocalTime() As DateTime
        If Kind = DateTimeKind.Local Then
            Return New DateTime(This)
        Else
            Dim fileTime = ToFileTime() '直接入れると計算できなくなります。 rev.207
            Return DateTime.FromFileTime(fileTime)
        End If
    End Function

    Override Function ToString() As String
        Return GetDateTimeFormats()
    End Function

    Function ToUniversalTime() As DateTime
        If Kind = DateTimeKind.Utc Then
            Return New DateTime(m_Date)
        Else
            Dim fileTime = ToFileTimeUtc() '直接入れると計算できなくなります。 rev.207
            Return DateTime.FromFileTimeUtc(fileTime)
        End If
    End Function

Private
    Sub initialize(ticks As Int64, kind As DateTimeKind)
        Kind = kind
        Ticks = ticks
    End Sub

    Sub initialize(year As Long, month As Long, day As Long, hour As Long, minute As Long, second As Long, millisecond As Long, kind As DateTimeKind)
        If month < 1 Or month > 12 _
            Or day < 1 Or day > DaysInMonth(year, month) _
            Or hour < 0 Or hour => 24 _
            Or minute < 0 Or minute => 60 _
            Or second < 0 Or second => 60 _
            Or millisecond < 0 Or millisecond  => 1000 Then
            debug 'ArgumentOutOfRangeException
        End If

        initialize(
            yearToDay(year) * TimeSpan.TicksPerDay _
            + totalDaysOfMonth(year, month - 1) * TimeSpan.TicksPerDay _
            + (day - 1) * TimeSpan.TicksPerDay _
            + hour * TimeSpan.TicksPerHour _
            + minute * TimeSpan.TicksPerMinute _
            + second * TimeSpan.TicksPerSecond _
            + millisecond * TimeSpan.TicksPerMillisecond,
            kind
            )
    End Sub

    Sub Ticks(value As Int64)
        If value < MinValue Or value > MaxValue Then
            debug 'ArgumentOutOfRangeException
        End If

        Dim temp = Kind As DateTimeKind
        m_Date = value
        Kind = temp
    End Sub

    Sub Kind(kind As DateTimeKind)
        Dim temp As Int64
        temp = kind
        temp = (temp << 62) And &HC000000000000000
        m_Date = (m_Date And &H3FFFFFFFFFFFFFFF) Or temp
    End Sub

    Static Function kindFromBinary(date As Int64) As DateTimeKind
        date = (date >> 62) And &H03
        If date = &H01 Then
            Return DateTimeKind.Local
        ElseIf date = &H02 Then
            Return DateTimeKind.Unspecified
        ElseIf date = &H03 Then
            Return DateTimeKind.Utc
        End If

        ' ここにはこないはず
        debug
    End Function

    Function getSystemTime() As SYSTEMTIME
        Dim time As SYSTEMTIME
        With time
            .wYear = Year As Word
            .wMonth = Month As Word
            .wDayOfWeek = DayOfWeek As Word
            .wDay = Day As Word
            .wHour = Hour As Word
            .wMinute = Minute As Word
            .wSecond = Second As Word
            .wMilliseconds = Millisecond As Word
        End With
        Return time
    End Function

    Static Function yearToDay(year As Long) As Long
        year--
        Return (Int(year * 365.25) - Int(year * 0.01) + Int(year * 0.0025))
    End Function

    Static Function totalDaysOfMonth(year As Long, month As Long) As Long
        Dim days As Long
        Dim i As Long
        For i = 1 To month
            days += DaysInMonth(year, i)
        Next
        Return days
    End Function
End Class

Enum DateTimeKind
    Local
    Unspecified
    Utc
End Enum

Enum DayOfWeek
    Sunday = 0
    Monday
    Tuesday
    Wednesday
    Thursday
    Friday
    Saturday
End Enum