' 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 AddTicks.Ticks = ticks + value AddTicks.Kind = 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 AddYears.Ticks = ticks AddYears.Kind = 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 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 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__