1  ' Classes/System/DateTime.ab


2 


3  Class DateTime


4  m_Date As Int64


5  Public


6  Static MaxValue = 3162240000000000000 As Int64 'Const TicksPerDay*366*10000


7  Static MinValue = 316224000000000 As Int64 'Const TicksPerDay*366


8 


9  Sub DateTime()


10  initialize(MinValue, DateTimeKind.Unspecified)


11  End Sub


12 


13  Sub DateTime(ticks As Int64)


14  initialize(ticks, DateTimeKind.Unspecified)


15  End Sub


16 


17  Sub DateTime(ticks As Int64, kind As DateTimeKind)


18  initialize(ticks, kind)


19  End Sub


20 


21  Sub DateTime(year As Long, month As Long, day As Long)


22  initialize(year, month, day, 0, 0, 0, 0, DateTimeKind.Unspecified)


23  End Sub


24 


25  Sub DateTime(year As Long, month As Long, day As Long, kind As DateTimeKind)


26  initialize(year, month, day, 0, 0, 0, 0, kind)


27  End Sub


28 


29  Sub DateTime(year As Long, month As Long, day As Long, hour As Long, minute As Long, second As Long)


30  initialize(year, month, day, hour, minute, second, 0, DateTimeKind.Unspecified)


31  End Sub


32 


33  Sub DateTime(year As Long, month As Long, day As Long, hour As Long, minute As Long, second As Long, kind As DateTimeKind)


34  initialize(year, month, day, hour, minute, second, 0, kind)


35  End Sub


36 


37  Sub DateTime(year As Long, month As Long, day As Long, hour As Long, minute As Long, second As Long, millisecond As Long)


38  initialize(year, month, day, hour, minute, second, millisecond, DateTimeKind.Unspecified)


39  End Sub


40 


41  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)


42  initialize(year, month, day, hour, minute, second, millisecond, kind)


43  End Sub


44 


45  Sub DateTime(ByRef time As SYSTEMTIME)


46  initialize(time.wYear, time.wMonth, time.wDay, time.wHour, time.wMinute, time.wSecond, time.wMilliseconds, DateTimeKind.Unspecified)


47  End Sub


48 


49  Sub DateTime(ByRef time As SYSTEMTIME, kind As DateTimeKind)


50  initialize(time.wYear, time.wMonth, time.wDay, time.wHour, time.wMinute, time.wSecond, time.wMilliseconds, kind)


51  End Sub


52 


53  'Copy Constructor


54  Sub DateTime(dateTime As DateTime)


55  This.m_Date = dateTime.m_Date


56  End Sub


57 


58  Sub ~DateTime()


59  End Sub


60 


61  Function Operator + (value As TimeSpan) As DateTime


62  Return New DateTime(Ticks + value.Ticks)


63  End Function


64 


65  Function Operator  (value As DateTime) As TimeSpan


66  Return TimeSpan.FromTicks(Ticks  value.Ticks)


67  End Function


68 


69  Function Operator  (value As TimeSpan) As DateTime


70  Return New DateTime(Ticks  value.Ticks)


71  End Function


72 


73  Function Operator == (value As DateTime) As Boolean


74  Return Equals(value)


75  End Function


76 


77  Function Operator <> (value As DateTime) As Boolean


78  Return Not Equals(value)


79  End Function


80 


81  Function Operator > (value As DateTime) As Boolean


82  If DateTime.Compare(This, value) > 0 Then


83  Return True


84  Else


85  Return False


86  End If


87  End Function


88 


89  Function Operator < (value As DateTime) As Boolean


90  If DateTime.Compare(This, value) < 0 Then


91  Return True


92  Else


93  Return False


94  End If


95  End Function


96 


97  Function Operator >= (value As DateTime) As Boolean


98  If DateTime.Compare(This, value) => 0 Then


99  Return True


100  Else


101  Return False


102  End If


103  End Function


104 


105  Function Operator <= (value As DateTime) As Boolean


106  If DateTime.Compare(This, value) <= 0 Then


107  Return True


108  Else


109  Return False


110  End If


111  End Function


112 


113  'Public Properties


114  Function Ticks() As Int64


115  Return (m_Date And &H3FFFFFFFFFFFFFFF)


116  End Function


117 


118  Function Millisecond() As Long


119  Return (Ticks \ TimeSpan.TicksPerMillisecond Mod 1000) As Long


120  End Function


121 


122  Function Second() As Long


123  Return (Ticks \ TimeSpan.TicksPerSecond Mod 60) As Long


124  End Function


125 


126  Function Minute() As Long


127  Return (Ticks \ TimeSpan.TicksPerMinute Mod 60) As Long


128  End Function


129 


130  Function Hour() As Long


131  Return (Ticks \ TimeSpan.TicksPerHour Mod 24) As Long


132  End Function


133 


134  Function Day() As Long


135  Return DayOfYear  totalDaysOfMonth(Year, Month  1)


136  End Function


137 


138  Function Month() As Long


139  Dim year = Year As Long


140  Dim day = DayOfYear As Long


141  Dim i = 1 As Long


142  While day > totalDaysOfMonth(year, i)


143  i++


144  Wend


145  Return i


146  End Function


147 


148  Function Year() As Long


149  Dim day = (Ticks \ TimeSpan.TicksPerDay) As Long


150  Dim year = Int((day + day \ 36524  day \ 146097) / 365.25) + 1 As Long


151  If day  yearToDay(year  1) + 1 = 366 Then


152  Return year + 1


153  Else


154  Return year


155  End If


156  End Function


157 


158  Function DayOfWeek() As Long 'As DayOfWeek


159  Return ((Ticks \ TimeSpan.TicksPerDay) Mod 7) As Long + 1


160  End Function


161 


162  Function Kind() As DateTimeKind


163  Return kindFromBinary(m_Date)


164  End Function


165 


166  Function DayOfYear() As Long


167  Return ((Ticks \ TimeSpan.TicksPerDay)  yearToDay(Year) + 1) As Long


168  End Function


169 


170  Function Date() As DateTime


171  Return New DateTime(Year, Month, Day, Kind)


172  End Function


173 


174  Static Function Now() As DateTime


175  Dim time As SYSTEMTIME


176  GetLocalTime(time)


177  Return New DateTime(time, DateTimeKind.Local)


178  End Function


179 


180  Static Function ToDay() As DateTime


181  Dim time As SYSTEMTIME


182  GetLocalTime(time)


183  Return New DateTime(time.wYear, time.wMonth, time.wDay, DateTimeKind.Local)


184  End Function


185 


186  Static Function UtcNow() As DateTime


187  Dim time As SYSTEMTIME


188  GetSystemTime(time)


189  Return New DateTime(time, DateTimeKind.Utc)


190  End Function


191 


192  'Public Methods


193  Static Function Compare(t1 As DateTime, t2 As DateTime) As Int64


194  Return t1.Ticks  t2.Ticks


195  End Function


196 


197  Function Equals(value As DateTime) As Boolean


198  If value.m_Date = m_Date Then


199  Return True


200  Else


201  Return False


202  End If


203  End Function


204 


205  Static Function Equals(t1 As DateTime, t2 As DateTime) As Boolean


206  If t1.m_Date = t2.m_Date Then


207  Return True


208  Else


209  Return False


210  End If


211  End Function


212 


213  Override Function GetHashCode() As Long


214  Return HIDWORD(m_Date) Xor LODWORD(m_Date)


215  End Function


216 


217  Function Add(value As TimeSpan) As DateTime


218  Return This + value


219  End Function


220 


221  Function AddTicks(value As Int64) As DateTime


222  Return New DateTime(Ticks + value, Kind )


223  End Function


224 


225  Function AddMilliseconds(value As Double) As DateTime


226  Return AddTicks((value * TimeSpan.TicksPerMillisecond) As Int64)


227  End Function


228 


229  Function AddSeconds(value As Double) As DateTime


230  Return AddTicks((value * TimeSpan.TicksPerSecond) As Int64)


231  End Function


232 


233  Function AddMinutes(value As Double) As DateTime


234  Return AddTicks((value * TimeSpan.TicksPerMinute) As Int64)


235  End Function


236 


237  Function AddHours(value As Double) As DateTime


238  Return AddTicks((value * TimeSpan.TicksPerHour) As Int64)


239  End Function


240 


241  Function AddDays(value As Double) As DateTime


242  Return AddTicks((value * TimeSpan.TicksPerDay) As Int64)


243  End Function


244 


245  Function AddYears(value As Double) As DateTime


246  Dim date = New DateTime(Year + Int(value), Month, Day, Hour, Minute, Second, Millisecond, Kind)


247  Dim ticks = Ticks _


248   (yearToDay(Year) + totalDaysOfMonth(Year, Month  1) + Day  1) * TimeSpan.TicksPerDay _


249   Hour * TimeSpan.TicksPerHour _


250   Minute * TimeSpan.TicksPerMinute _


251   Second * TimeSpan.TicksPerSecond _


252   Millisecond * TimeSpan.TicksPerMillisecond As Int64


253  If IsLeapYear(Year + Int(value)) Then


254  ticks += (value  Int(value)) * 366 * TimeSpan.TicksPerDay


255  Else


256  ticks += (value  Int(value)) * 365 * TimeSpan.TicksPerDay


257  End If


258  Return date.AddTicks(ticks)


259  End Function


260 


261  Function Subtract(value As DateTime) As TimeSpan


262  Return This  value


263  End Function


264 


265  Function Subtract(value As TimeSpan) As DateTime


266  Return This  value


267  End Function


268 


269  Static Function DaysInMonth(year As Long, month As Long) As Long


270  If year < 1 Or year > 9999 Or month < 1 Or month > 12 Then


271  'ArgumentOutOfRangeException


272  debug


273  End If


274 


275  If IsLeapYear(year) And month = 2 Then


276  Return 29


277  Else


278  Dim daysInMonth[11] = [31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31] As Byte


279  Return daysInMonth[month  1]


280  End If


281  End Function


282 


283  Static Function IsLeapYear(year As Long) As Boolean


284  If (year Mod 400) = 0 Then Return True


285  If (year Mod 100) = 0 Then Return False


286  If (year Mod 4) = 0 Then Return True


287  Return False


288  End Function


289 


290  Function GetDateTimeFormats() As String


291  Dim time = getSystemTime() 'As SYSTEMTIME を記述すると内部エラーが発生


292  Dim dateFormatSize = GetDateFormat(LOCALE_USER_DEFAULT, 0, time, NULL, NULL, 0)


293  Dim timeFormatSize = GetTimeFormat(LOCALE_USER_DEFAULT, 0, time, NULL, NULL, 0)


294  Dim dateTimeFormats = malloc(dateFormatSize + timeFormatSize) As PTSTR


295  GetDateFormat(LOCALE_USER_DEFAULT, 0, time, NULL, dateTimeFormats, dateFormatSize)


296  dateTimeFormats[dateFormatSize  1] = Asc(" ")


297  GetTimeFormat(LOCALE_USER_DEFAULT, 0, time, NULL, dateTimeFormats + dateFormatSize, timeFormatSize)


298 


299  Return New String(dateTimeFormats)


300  End Function


301 


302  Function GetDateTimeFormats(format As *TCHAR) As String


303  Dim time = getSystemTime() 'As SYSTEMTIME を記述すると内部エラーが発生


304  Dim dateFormatSize = GetDateFormat(LOCALE_USER_DEFAULT, 0, time, format, NULL, 0)


305  Dim dateFormats = malloc(dateFormatSize) As PTSTR


306  GetDateFormat(LOCALE_USER_DEFAULT, 0, time, format, dateFormats, dateFormatSize)


307 


308  Dim dateTimeFormatSize = GetTimeFormat(LOCALE_USER_DEFAULT, 0, time, dateFormats, NULL, 0)


309  Dim dateTimeFormats = malloc(dateTimeFormatSize) As PTSTR


310  GetTimeFormat(LOCALE_USER_DEFAULT, 0, time, dateFormats, dateTimeFormats, dateTimeFormatSize)


311 


312  Return New String(dateTimeFormats)


313  End Function


314 


315  Static Function FromBinary(date As Int64) As DateTime


316  Return New DateTime((date And &H3FFFFFFFFFFFFFFF), kindFromBinary(date))


317  End Function


318 


319  Function ToBinary() As Int64


320  Return m_Date


321  End Function


322 


323  Static Function FromFileTime(ByRef fileTime As FILETIME) As DateTime


324  Dim localTime As FILETIME


325  Dim time As SYSTEMTIME


326  FileTimeToLocalFileTime(fileTime, localTime)


327  FileTimeToSystemTime(localTime, time)


328  Return New DateTime(time, DateTimeKind.Local)


329  End Function


330 


331  Function ToFileTime() As FILETIME


332  Dim time = getSystemTime() 'As SYSTEMTIME を記述すると内部エラーが発生 rev.207


333  Dim fileTime As FILETIME


334  SystemTimeToFileTime(time, fileTime)


335  Return fileTime


336  End Function


337 


338  Static Function FromFileTimeUtc(ByRef fileTime As FILETIME) As DateTime


339  Dim time As SYSTEMTIME


340  FileTimeToSystemTime(fileTime, time)


341  Return New DateTime(time, DateTimeKind.Utc)


342  End Function


343 


344  Function ToFileTimeUtc() As FILETIME


345  Dim fileTime = ToFileTime() 'As FILETIME を記述すると内部エラー rev.207


346  If Kind = DateTimeKind.Utc Then


347  Return fileTime


348  Else


349  Dim utcTime As FILETIME


350  LocalFileTimeToFileTime(fileTime, utcTime)


351  Return utcTime


352  End If


353  End Function


354 


355  Function ToLocalTime() As DateTime


356  If Kind = DateTimeKind.Local Then


357  Return New DateTime(This)


358  Else


359  Dim fileTime = ToFileTime() '直接入れると計算できなくなります。 rev.207


360  Return DateTime.FromFileTime(fileTime)


361  End If


362  End Function


363 


364  Override Function ToString() As String


365  Return GetDateTimeFormats()


366  End Function


367 


368  Function ToUniversalTime() As DateTime


369  If Kind = DateTimeKind.Utc Then


370  Return New DateTime(m_Date)


371  Else


372  Dim fileTime = ToFileTimeUtc() '直接入れると計算できなくなります。 rev.207


373  Return DateTime.FromFileTimeUtc(fileTime)


374  End If


375  End Function


376 


377  Private


378  Sub initialize(ticks As Int64, kind As DateTimeKind)


379  Kind = kind


380  Ticks = ticks


381  End Sub


382 


383  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)


384  If month < 1 Or month > 12 _


385  Or day < 1 Or day > DaysInMonth(year, month) _


386  Or hour < 0 Or hour => 24 _


387  Or minute < 0 Or minute => 60 _


388  Or second < 0 Or second => 60 _


389  Or millisecond < 0 Or millisecond => 1000 Then


390  debug 'ArgumentOutOfRangeException


391  End If


392 


393  initialize(


394  yearToDay(year) * TimeSpan.TicksPerDay _


395  + totalDaysOfMonth(year, month  1) * TimeSpan.TicksPerDay _


396  + (day  1) * TimeSpan.TicksPerDay _


397  + hour * TimeSpan.TicksPerHour _


398  + minute * TimeSpan.TicksPerMinute _


399  + second * TimeSpan.TicksPerSecond _


400  + millisecond * TimeSpan.TicksPerMillisecond,


401  kind


402  )


403  End Sub


404 


405  Sub Ticks(value As Int64)


406  If value < MinValue Or value > MaxValue Then


407  debug 'ArgumentOutOfRangeException


408  End If


409 


410  Dim temp = Kind As DateTimeKind


411  m_Date = value


412  Kind = temp


413  End Sub


414 


415  Sub Kind(kind As DateTimeKind)


416  Dim temp As Int64


417  temp = kind


418  temp = (temp << 62) And &HC000000000000000


419  m_Date = (m_Date And &H3FFFFFFFFFFFFFFF) Or temp


420  End Sub


421 


422  Static Function kindFromBinary(date As Int64) As DateTimeKind


423  date = (date >> 62) And &H03


424  If date = &H01 Then


425  Return DateTimeKind.Local


426  ElseIf date = &H02 Then


427  Return DateTimeKind.Unspecified


428  ElseIf date = &H03 Then


429  Return DateTimeKind.Utc


430  End If


431 


432  ' ここにはこないはず


433  debug


434  End Function


435 


436  Function getSystemTime() As SYSTEMTIME


437  Dim time As SYSTEMTIME


438  With time


439  .wYear = Year As Word


440  .wMonth = Month As Word


441  .wDayOfWeek = DayOfWeek As Word


442  .wDay = Day As Word


443  .wHour = Hour As Word


444  .wMinute = Minute As Word


445  .wSecond = Second As Word


446  .wMilliseconds = Millisecond As Word


447  End With


448  Return time


449  End Function


450 


451  Static Function yearToDay(year As Long) As Long


452  year


453  Return (Int(year * 365.25)  Int(year * 0.01) + Int(year * 0.0025))


454  End Function


455 


456  Static Function totalDaysOfMonth(year As Long, month As Long) As Long


457  Dim days As Long


458  Dim i As Long


459  For i = 1 To month


460  days += DaysInMonth(year, i)


461  Next


462  Return days


463  End Function


464  End Class


465 


466  Enum DateTimeKind


467  Local


468  Unspecified


469  Utc


470  End Enum


471 


472  Enum DayOfWeek


473  Sunday = 0


474  Monday


475  Tuesday


476  Wednesday


477  Thursday


478  Friday


479  Saturday


480  End Enum

