1  Namespace System


2 


3 


4  Class DateTime


5  m_Date As Int64


6  Public


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


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


9 


10  Sub DateTime()


11  initialize(MinValue, DateTimeKind.Unspecified)


12  End Sub


13 


14  Sub DateTime(ticks As Int64)


15  initialize(ticks, DateTimeKind.Unspecified)


16  End Sub


17 


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


19  initialize(ticks, kind)


20  End Sub


21 


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


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


24  End Sub


25 


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


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


28  End Sub


29 


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


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


32  End Sub


33 


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


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


36  End Sub


37 


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


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


40  End Sub


41 


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


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


44  End Sub


45 


46  Sub DateTime(ByRef time As SYSTEMTIME)


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


48  End Sub


49 


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


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


52  End Sub


53 


54  'Copy Constructor


55  Sub DateTime(dateTime As DateTime)


56  This.m_Date = dateTime.m_Date


57  End Sub


58 


59  Sub ~DateTime()


60  End Sub


61 


62  Function Operator + (value As TimeSpan) As DateTime


63  Return New DateTime(Ticks + value.Ticks)


64  End Function


65 


66  Function Operator  (value As DateTime) As TimeSpan


67  Return TimeSpan.FromTicks(Ticks  value.Ticks)


68  End Function


69 


70  Function Operator  (value As TimeSpan) As DateTime


71  Return New DateTime(Ticks  value.Ticks)


72  End Function


73 


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


75  Return Equals(value)


76  End Function


77 


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


79  Return Not Equals(value)


80  End Function


81 


82  Function Operator > (value As DateTime) As Boolean


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


84  Return True


85  Else


86  Return False


87  End If


88  End Function


89 


90  Function Operator < (value As DateTime) As Boolean


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


92  Return True


93  Else


94  Return False


95  End If


96  End Function


97 


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


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


100  Return True


101  Else


102  Return False


103  End If


104  End Function


105 


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


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


108  Return True


109  Else


110  Return False


111  End If


112  End Function


113 


114  'Public Properties


115  Function Ticks() As Int64


116  Return (m_Date And &H3FFFFFFFFFFFFFFF)


117  End Function


118 


119  Function Millisecond() As Long


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


121  End Function


122 


123  Function Second() As Long


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


125  End Function


126 


127  Function Minute() As Long


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


129  End Function


130 


131  Function Hour() As Long


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


133  End Function


134 


135  Function Day() As Long


136  Return DayOfYear  totalDaysOfMonth(Year, Month  1)


137  End Function


138 


139  Function Month() As Long


140  Dim year = Year As Long


141  Dim day = DayOfYear As Long


142  Dim i = 1 As Long


143  While day > totalDaysOfMonth(year, i)


144  i++


145  Wend


146  Return i


147  End Function


148 


149  Function Year() As Long


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


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


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


153  Return year + 1


154  Else


155  Return year


156  End If


157  End Function


158 


159  Function DayOfWeek() As Long 'As DayOfWeek


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


161  End Function


162 


163  Function Kind() As DateTimeKind


164  Return kindFromBinary(m_Date)


165  End Function


166 


167  Function DayOfYear() As Long


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


169  End Function


170 


171  Function Date() As DateTime


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


173  End Function


174 


175  Static Function Now() As DateTime


176  Dim time As SYSTEMTIME


177  GetLocalTime(time)


178  Return New DateTime(time, DateTimeKind.Local)


179  End Function


180 


181  Static Function Today() As DateTime


182  Dim time As SYSTEMTIME


183  GetLocalTime(time)


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


185  End Function


186 


187  Static Function UtcNow() As DateTime


188  Dim time As SYSTEMTIME


189  GetSystemTime(time)


190  Return New DateTime(time, DateTimeKind.Utc)


191  End Function


192 


193  'Public Methods


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


195  Return t1.Ticks  t2.Ticks


196  End Function


197 


198  Function Equals(value As DateTime) As Boolean


199  If value.m_Date = m_Date Then


200  Return True


201  Else


202  Return False


203  End If


204  End Function


205 


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


207  If t1.m_Date = t2.m_Date Then


208  Return True


209  Else


210  Return False


211  End If


212  End Function


213 


214  Override Function GetHashCode() As Long


215  Return HIDWORD(m_Date) Xor LODWORD(m_Date)


216  End Function


217 


218  Function Add(value As TimeSpan) As DateTime


219  Return This + value


220  End Function


221 


222  Function AddTicks(value As Int64) As DateTime


223  Return New DateTime(Ticks + value, Kind )


224  End Function


225 


226  Function AddMilliseconds(value As Double) As DateTime


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


228  End Function


229 


230  Function AddSeconds(value As Double) As DateTime


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


232  End Function


233 


234  Function AddMinutes(value As Double) As DateTime


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


236  End Function


237 


238  Function AddHours(value As Double) As DateTime


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


240  End Function


241 


242  Function AddDays(value As Double) As DateTime


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


244  End Function


245 


246  Function AddYears(value As Double) As DateTime


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


248  Dim ticks = Ticks _


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


250   Hour * TimeSpan.TicksPerHour _


251   Minute * TimeSpan.TicksPerMinute _


252   Second * TimeSpan.TicksPerSecond _


253   Millisecond * TimeSpan.TicksPerMillisecond As Int64


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


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


256  Else


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


258  End If


259  Return date.AddTicks(ticks)


260  End Function


261 


262  Function Subtract(value As DateTime) As TimeSpan


263  Return This  value


264  End Function


265 


266  Function Subtract(value As TimeSpan) As DateTime


267  Return This  value


268  End Function


269 


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


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


272  'ArgumentOutOfRangeException


273  debug


274  End If


275 


276  If IsLeapYear(year) And month = 2 Then


277  Return 29


278  Else


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


280  Return daysInMonth[month  1]


281  End If


282  End Function


283 


284  Static Function IsLeapYear(year As Long) As Boolean


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


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


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


288  Return False


289  End Function


290 


291  Function GetDateTimeFormats() As String


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


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


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


295  Dim strLength = dateFormatSize + timeFormatSize


296  Dim dateTimeFormats = GC_malloc_atomic(SizeOf (TCHAR) * (strLength)) As PTSTR


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


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


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


300  'Debug


301  Return New String(dateTimeFormats, strLength)


302  End Function


303 


304  Function GetDateTimeFormats(format As *TCHAR) As String


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


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


307  Dim dateFormats = malloc(dateFormatSize) As PTSTR


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


309 


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


311  Dim dateTimeFormats = malloc(dateTimeFormatSize) As PTSTR


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


313 


314  Return New String(dateTimeFormats)


315  End Function


316 


317  Static Function FromBinary(date As Int64) As DateTime


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


319  End Function


320 


321  Function ToBinary() As Int64


322  Return m_Date


323  End Function


324 


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


326  Dim localTime As FILETIME


327  Dim time As SYSTEMTIME


328  FileTimeToLocalFileTime(fileTime, localTime)


329  FileTimeToSystemTime(localTime, time)


330  Return New DateTime(time, DateTimeKind.Local)


331  End Function


332 


333  Function ToFileTime() As FILETIME


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


335  Dim fileTime As FILETIME


336  SystemTimeToFileTime(time, fileTime)


337  Return fileTime


338  End Function


339 


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


341  Dim time As SYSTEMTIME


342  FileTimeToSystemTime(fileTime, time)


343  Return New DateTime(time, DateTimeKind.Utc)


344  End Function


345 


346  Function ToFileTimeUtc() As FILETIME


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


348  If Kind = DateTimeKind.Utc Then


349  Return fileTime


350  Else


351  Dim utcTime As FILETIME


352  LocalFileTimeToFileTime(fileTime, utcTime)


353  Return utcTime


354  End If


355  End Function


356 


357  Function ToLocalTime() As DateTime


358  If Kind = DateTimeKind.Local Then


359  Return New DateTime(This)


360  Else


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


362  Return DateTime.FromFileTime(fileTime)


363  End If


364  End Function


365 


366  Override Function ToString() As String


367  Return GetDateTimeFormats()


368  End Function


369 


370  Function ToUniversalTime() As DateTime


371  If Kind = DateTimeKind.Utc Then


372  Return New DateTime(m_Date)


373  Else


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


375  Return DateTime.FromFileTimeUtc(fileTime)


376  End If


377  End Function


378 


379  Private


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


381  Kind = kind


382  Ticks = ticks


383  End Sub


384 


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


386  If month < 1 Or month > 12 _


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


388  Or hour < 0 Or hour => 24 _


389  Or minute < 0 Or minute => 60 _


390  Or second < 0 Or second => 60 _


391  Or millisecond < 0 Or millisecond => 1000 Then


392  debug 'ArgumentOutOfRangeException


393  End If


394 


395  initialize(


396  yearToDay(year) * TimeSpan.TicksPerDay _


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


398  + (day  1) * TimeSpan.TicksPerDay _


399  + hour * TimeSpan.TicksPerHour _


400  + minute * TimeSpan.TicksPerMinute _


401  + second * TimeSpan.TicksPerSecond _


402  + millisecond * TimeSpan.TicksPerMillisecond,


403  kind


404  )


405  End Sub


406 


407  Sub Ticks(value As Int64)


408  If value < MinValue Or value > MaxValue Then


409  debug 'ArgumentOutOfRangeException


410  End If


411 


412  Dim temp = Kind As DateTimeKind


413  m_Date = value


414  Kind = temp


415  End Sub


416 


417  Sub Kind(kind As DateTimeKind)


418  Dim temp As Int64


419  temp = kind


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


421  m_Date = (m_Date And &H3FFFFFFFFFFFFFFF) Or temp


422  End Sub


423 


424  Static Function kindFromBinary(date As Int64) As DateTimeKind


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


426  If date = &H01 Then


427  Return DateTimeKind.Local


428  ElseIf date = &H02 Then


429  Return DateTimeKind.Unspecified


430  ElseIf date = &H03 Then


431  Return DateTimeKind.Utc


432  End If


433 


434  ' ここにはこないはず


435  debug


436  End Function


437 


438  Function getSystemTime() As SYSTEMTIME


439  Dim time As SYSTEMTIME


440  With time


441  .wYear = Year As Word


442  .wMonth = Month As Word


443  .wDayOfWeek = DayOfWeek As Word


444  .wDay = Day As Word


445  .wHour = Hour As Word


446  .wMinute = Minute As Word


447  .wSecond = Second As Word


448  .wMilliseconds = Millisecond As Word


449  End With


450  Return time


451  End Function


452 


453  Static Function yearToDay(year As Long) As Long


454  year


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


456  End Function


457 


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


459  Dim days As Long


460  Dim i As Long


461  For i = 1 To month


462  days += DaysInMonth(year, i)


463  Next


464  Return days


465  End Function


466  End Class


467 


468  Enum DateTimeKind


469  Local


470  Unspecified


471  Utc


472  End Enum


473 


474  Enum DayOfWeek


475  Sunday = 0


476  Monday


477  Tuesday


478  Wednesday


479  Thursday


480  Friday


481  Saturday


482  End Enum


483 


484 


485  End Namespace

