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

' Classes/System/DateTime.ab

#ifndef __SYSTEM_DATETIME_AB__
#define __SYSTEM_DATETIME_AB__

Class DateTime
    m_Date As Int64
Public
    Static MaxValue = 3162240000000000000 As Int64 'Const
    Static MinValue = 316224000000000 As Int64 'Const

    Sub DateTime()
        DateTime(316224000000000)
    End Sub

    Sub DateTime(ticks As Int64)
        Ticks = ticks
        Kind = DateTimeKind.Unspecified
    End Sub

    Sub DateTime(ticks As Int64, kind As DateTimeKind)
        DateTime(ticks)
        Kind = kind
    End Sub

    Sub DateTime(year As Long, month As Long, day As Long)
        If year < 1 Or year > 9999 Or month < 1 Or month > 12 Or day < 1 Or day > DaysInMonth(year, month) Then
            'ArgumentOutOfRangeException
            debug
        End If
        DateTime(316224000000000)
        DateTime( AddYears(year - 1) )

        Dim days As Long
        Dim i As Long
        For i = 1 To month - 1
            days += DaysInMonth(Year, i)
        Next
        days += day
        DateTime( AddDays(days - 1) )
    End Sub

    Sub DateTime(year As Long, month As Long, day As Long, kind As DateTimeKind)
        DateTime(year, month, day)
        Kind = kind
    End Sub

    Sub DateTime(year As Long, month As Long, day As Long, hour As Long, minute As Long, second As Long)
        If hour < 0 Or hour > 23 Or minute < 0 Or minute > 59 Or second < 0 Or second > 59 Then
            'ArgumentOutOfRangeException
            debug
        End If

        DateTime(year, month, day)
        DateTime( AddHours(hour) )
        DateTime( AddMinutes(minute) )
        DateTime( AddSeconds(second) )
    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)
        DateTime(year, month, day, hour, minute, second)
        Kind = 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)
        DateTime(year, month, day, hour, minute, second)
        DateTime( AddMilliseconds(millisecond) )
    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)
        DateTime(year, month, day, hour, minute, second, millisecond)
        Kind = kind
    End Sub

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

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

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

    Sub ~DateTime()
    End Sub

    Function Operator + (ByRef value As TimeSpan) As DateTime
        Dim date As DateTime(Ticks + value.Ticks)
        Return date
    End Function

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

    Function Operator - (ByRef value As TimeSpan) As DateTime
        Dim date As DateTime(Ticks - value.Ticks)
        Return date
    End Function

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

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

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

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

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

    Function Operator <= (ByRef value As DateTime) As Boolean
        If DateTime.Compare(This, value) <= 0 Then
            Return True
        Else
            Return False
        End If
    End Function
    
    'Property
    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
        Dim day As Long
        day = DayOfYear

        Dim i As Long
        For i = 1 To Month - 1
            day -= DaysInMonth(Year, i)
        Next
        Return day
    End Function

    Function Month() As Long
        Dim year As Long
        Dim day As Long
        year = Year
        day = DayOfYear

        Dim i As Long
        For i = 1 To 12
            day -= DaysInMonth(year, i)
            If day <= 0 Then Return i
        Next
        Return 12
    End Function

    Function Year() As Long
        Dim day As Long
        day = totalDays()
        Return Int((day + day \ 36523 - day \ 146097) / 365.25)
    End Function

    Function DayOfWeek() As Long
        Return totalDays() Mod 7 - 1
    End Function

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

    Function DayOfYear() As Long
        Dim day As Long
        day = totalDays()
        Return day - Int(Year * 365.25 - day \ 36523 + day \ 146097)
    End Function

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

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

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

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

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

    Static Function Equals(ByRef t1 As DateTime, ByRef 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(ByRef value As TimeSpan) As DateTime
        Return This + value
    End Function

    Function AddTicks(value As Int64) As DateTime
        Dim ticks As Int64
        ticks = Ticks
        If (ticks > MaxValue - value) Or (ticks < MinValue - value) Then
            'ArgumentOutOfRangeException
            debug
        End If

        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 year As Long
        Dim intValue As Long
        Dim ticks As Int64
        year = Year
        intValue = Int(value)
        ticks = Ticks + intValue * 315360000000000 + 864000000000 * ((year Mod 4 + intValue) \ 4 - (year Mod 100 + intValue) \ 100 + (year Mod 400 + intValue) \ 400)

        If value < 0 Then
            If (year Mod 4 + intValue <= 0 And year Mod 100 > 4) Or (year Mod 400 <= 4) Then
                ticks -= 864000000000
            End If
        End If
        If IsLeapYear(year) = TRUE Then
            ticks += (value - intValue) * 316224000000000
        Else
            ticks += (value - intValue) * 315360000000000
        End If
        
        Return New DateTime( ticks, Kind )
    End Function

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

    Function Subtract(ByRef 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
        Return GetDateTimeFormats(NULL)
    End Function

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

        GetDateTimeFormats = New String()

        Dim size As Long
        size = GetDateFormat(LOCALE_USER_DEFAULT, 0, time, format, NULL, 0)
        GetDateTimeFormats.ReSize(size - 1)
        GetDateFormat(LOCALE_USER_DEFAULT, 0, time, format, GetDateTimeFormats, size)

        Dim temp As String      
        If format = NULL Then
            size = GetTimeFormat(LOCALE_USER_DEFAULT, 0, time, format, NULL, 0)
            temp.ReSize(size - 1)
            GetTimeFormat(LOCALE_USER_DEFAULT, 0, time, format, temp, size)
            GetDateTimeFormats = GetDateTimeFormats + " " + temp
        Else
            size = GetTimeFormat(LOCALE_USER_DEFAULT, 0, time, GetDateTimeFormats, NULL, 0)
            temp.ReSize(size - 1)
            GetTimeFormat(LOCALE_USER_DEFAULT, 0, time, GetDateTimeFormats, temp, size)
            GetDateTimeFormats = temp
        End If
    End Function

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

    Function ToBinary() As Int64
        Return m_Date
    End Function

    Static Function FromFileTime(fileTime As FILETIME) As DateTime
        Dim localTime As FILETIME
        Dim time As SYSTEMTIME
        FileTimeToLocalFileTime(fileTime, localTime)
        FileTimeToSystemTime(localTime, time)

        Dim date As DateTime(time, DateTimeKind.Local)
        Return date
    End Function

    Function ToFileTime() As FILETIME
        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
        Dim fileTime As FILETIME
        SystemTimeToFileTime(time, fileTime)
        Return fileTime
    End Function

    Static Function FromFileTimeUtc(fileTime As FILETIME) As DateTime
        Dim time As SYSTEMTIME
        FileTimeToSystemTime(fileTime, time)

        Dim date As DateTime(time, DateTimeKind.Utc)
        Return date
    End Function

    Function ToFileTimeUtc() As FILETIME
        Dim fileTime As FILETIME
        fileTime = ToFileTime()
        If Kind = DateTimeKind.Utc Then
            ToFileTimeUtc = fileTime
        Else
            LocalFileTimeToFileTime(fileTime, ToFileTimeUtc) 'Return
        End If
    End Function

    Function ToLocalTime() As DateTime
        If Kind = DateTimeKind.Local Then
            ToLocalTime = This
        Else
            ToLocalTime = DateTime.FromFileTime(ToFileTime())
            ToLocalTime.Kind = DateTimeKind.Local
        End If
    End Function

    Function ToUniversalTime() As DateTime
        If Kind = DateTimeKind.Utc Then
            ToUniversalTime = This
        Else
            ToUniversalTime = DateTime.FromFileTimeUtc(ToFileTimeUtc())
            ToUniversalTime.Kind = DateTimeKind.Utc
        End If
    End Function
Private
    Sub Ticks(value As Int64)
        Dim kind As DateTimeKind
        kind = Kind
        m_Date = value
        Kind = kind
    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

    Function totalDays() As Long
        Return (Ticks \ TimeSpan.TicksPerDay) As Long
    End Function

    Function kindFromBinary(dateData As Int64) As DateTimeKind
        dateData = (dateData >> 62) And &H03
        If dateData = &H01 Then
            Return DateTimeKind.Local
        ElseIf dateData = &H02 Then
            Return DateTimeKind.Unspecified
        ElseIf dateData = &H03 Then
            Return DateTimeKind.Utc
        Else
            ' どれにも該当しなかったときはどうなるんでしょうか？？
            Return DateTimeKind.Local
        End If
    End Function
End Class

Enum DateTimeKind
    Local
    Unspecified
    Utc
End Enum

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

#endif '__SYSTEM_DATETIME_AB__