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

Last change on this file since 87 was 82, checked in by OverTaker, 18 years ago

KindがUnspecifiedのとき、UTCとLocalの変換ができないバグを修正
File size: 11.7 KB
Line 
1' Classes/System/DateTime.ab
2
3#ifndef __SYSTEM_DATETIME_AB__
4#define __SYSTEM_DATETIME_AB__
5
6
7Class DateTime
8 m_Date As Int64
9Public
10 Static MaxValue = 3162240000000000000 As Int64 'Const
11 Static MinValue = 316224000000000 As Int64 'Const
12
13 Sub DateTime(ticks As Int64)
14 Ticks = ticks
15 Kind = Unspecified
16 End Sub
17
18 Sub DateTime(ticks As Int64, kind As DateTimeKind)
19 DateTime(ticks)
20 Kind = kind
21 End Sub
22
23 Sub DateTime(year As Long, month As Long, day As Long)
24 If year < 1 Or year > 9999 Or month < 1 Or month > 12 Or day < 1 Or day > DaysInMonth(year, month) Then
25 'ArgumentOutOfRangeException
26 debug
27 End If
28 DateTime(316224000000000)
29 AddYears(year - 1)
30
31 Dim days As Long
32 Dim i As Long
33 For i = 1 To month - 1
34 days += DaysInMonth(Year, i)
35 Next
36 days += day
37 AddDays(days - 1)
38 End Sub
39
40 Sub DateTime(year As Long, month As Long, day As Long, kind As DateTimeKind)
41 DateTime(year, month, day)
42 Kind = kind
43 End Sub
44
45 Sub DateTime(year As Long, month As Long, day As Long, hour As Long, minute As Long, second As Long)
46 If hour < 0 Or hour > 23 Or minute < 0 Or minute > 59 Or second < 0 Or second > 59 Then
47 'ArgumentOutOfRangeException
48 debug
49 End If
50 DateTime(year, month, day)
51 AddHours(hour)
52 AddMinutes(minute)
53 AddSeconds(second)
54 End Sub
55
56/* Sub DateTime(year As Long, month As Long, day As Long, hour As Long, minute As Long, second As Long, kind As DateTimeKind)
57 DateTime(year, month, day, hour, minute, second)
58 Kind = kind
59 End Sub*/
60
61 Sub DateTime(year As Long, month As Long, day As Long, hour As Long, minute As Long, second As Long, millisecond As Long)
62 DateTime(year, month, day, hour, minute, second)
63 AddMilliseconds(millisecond)
64 End Sub
65
66 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)
67 DateTime(year, month, day, hour, minute, second, millisecond)
68 Kind = kind
69 End Sub
70
71 Sub DateTime(ByRef time As SYSTEMTIME)
72 DateTime(time.wYear, time.wMonth, time.wDay, time.wHour, time.wMinute, time.wSecond, time.wMilliseconds)
73 End Sub
74
75 Sub DateTime(ByRef time As SYSTEMTIME, kind As DateTimeKind)
76 DateTime(time.wYear, time.wMonth, time.wDay, time.wHour, time.wMinute, time.wSecond, time.wMilliseconds, kind)
77 End Sub
78
79 'Copy Constructor
80 Sub DateTime( ByRef datetime As DateTime )
81 This.m_Date = datetime.m_Date
82 End Sub
83
84 Sub ~DateTime()
85 End Sub
86
87 Function Operator == (ByRef value As DateTime) As BOOL
88 Return Equals(value)
89 End Function
90
91 Function Operator <> (ByRef value As DateTime) As BOOL
92 Return Not Equals(value)
93 End Function
94
95 Function Operator > (ByRef value As DateTime) As BOOL
96 If DateTime.Compare(This, value) > 0 Then
97 Return _System_TRUE
98 Else
99 Return _System_FALSE
100 End If
101 End Function
102
103 Function Operator < (ByRef value As DateTime) As BOOL
104 If DateTime.Compare(This, value) < 0 Then
105 Return _System_TRUE
106 Else
107 Return _System_FALSE
108 End If
109 End Function
110
111 Function Operator >= (ByRef value As DateTime) As BOOL
112 If DateTime.Compare(This, value) => 0 Then
113 Return _System_TRUE
114 Else
115 Return _System_FALSE
116 End If
117 End Function
118
119 Function Operator <= (ByRef value As DateTime) As BOOL
120 If DateTime.Compare(This, value) <= 0 Then
121 Return _System_TRUE
122 Else
123 Return _System_FALSE
124 End If
125 End Function
126
127 'Property
128 Function Ticks() As Int64
129 Return (m_Date And &H3FFFFFFFFFFFFFFF)
130 End Function
131
132 Function Millisecond() As Long
133 Return (Ticks \ 10000 Mod 1000) As Long
134 End Function
135
136 Function Second() As Long
137 Return (Ticks \ 10000000 Mod 60) As Long
138 End Function
139
140 Function Minute() As Long
141 Return (Ticks \ 600000000 Mod 60) As Long
142 End Function
143
144 Function Hour() As Long
145 Return (Ticks \ 36000000000 Mod 24) As Long
146 End Function
147
148 Function Day() As Long
149 Dim day As Long
150 day = DayOfYear
151
152 Dim i As Long
153 For i = 1 To Month - 1
154 day -= DaysInMonth(Year, i)
155 Next
156 Return day
157 End Function
158
159 Function Month() As Long
160 Dim year As Long
161 Dim day As Long
162 year = Year
163 day = DayOfYear
164
165 Dim i As Long
166 For i = 1 To 12
167 day -= DaysInMonth(year, i)
168 If day <= 0 Then Return i
169 Next
170 Return 12
171 End Function
172
173 Function Year() As Long
174 Dim day As Long
175 day = totalDays()
176 Return Int((day + day \ 36523 - day \ 146097) / 365.25)
177 End Function
178
179 Function DayOfWeek() As DayOfWeek
180 Return totalDays() Mod 7 - 1
181 End Function
182
183 Function Kind() As DateTimeKind
184 Return kindFromBinary(m_Date)
185 End Function
186
187 Function DayOfYear() As Long
188 Dim day As Long
189 day = totalDays()
190 Return day - Int(Year * 365.25 - day \ 36523 + day \ 146097)
191 End Function
192
193 Function Date() As DateTime
194 Dim date As DateTime(Year, Month, Day, Kind)
195 Return date
196 End Function
197
198 Static Function Now() As DateTime
199 Dim time As SYSTEMTIME
200 GetLocalTime(time)
201 Dim date As DateTime(time, Local)
202 Return date
203 End Function
204
205 Static Function ToDay() As DateTime
206 Dim time As SYSTEMTIME
207 GetLocalTime(time)
208 Dim date As DateTime(time.wYear, time.wMonth, time.wDay, Local)
209 Return date
210 End Function
211
212 Static Function UtcNow() As DateTime
213 Dim time As SYSTEMTIME
214 GetSystemTime(time)
215 Dim date As DateTime(time, Utc)
216 Return date
217 End Function
218
219 'method
220 Static Function Compare(ByRef t1 As DateTime, ByRef t2 As DateTime) As Int64
221 Return t1.Ticks - t2.Ticks
222 End Function
223
224 Function Equals(ByRef value As DateTime) As BOOL
225 If value.m_Date = m_Date Then
226 Return _System_TRUE
227 Else
228 Return _System_FALSE
229 End If
230 End Function
231
232 Static Function Equals(ByRef t1 As DateTime, ByRef t2 As DateTime) As BOOL
233 If t1.m_Date = t2.m_Date Then
234 Return _System_TRUE
235 Else
236 Return _System_FALSE
237 End If
238 End Function
239
240 Sub AddTicks(value As Int64)
241 Dim ticks As Int64
242 ticks = Ticks
243 If (ticks > DateTime.MaxValue - value) Or (ticks < DateTime.MinValue - value) Then
244 'ArgumentOutOfRangeException
245 debug
246 End If
247 Ticks = ticks + value
248 End Sub
249
250 Sub AddMilliseconds(value As Double)
251 AddTicks((value * 10000) As Int64)
252 End Sub
253
254 Sub AddSeconds(value As Double)
255 AddTicks((value * 10000000) As Int64)
256 End Sub
257
258 Sub AddMinutes(value As Double)
259 AddTicks((value * 600000000) As Int64)
260 End Sub
261
262 Sub AddHours(value As Double)
263 AddTicks((value * 36000000000) As Int64)
264 End Sub
265
266 Sub AddDays(value As Double)
267 AddTicks((value * 864000000000) As Int64)
268 End Sub
269
270 Sub AddYears(value As Double)
271 Dim year As Long
272 Dim intValue As Long
273 year = Year
274 intValue = Int(value)
275 AddTicks(intValue * 315360000000000 + 864000000000 * ((year Mod 4 + intValue) \ 4 - (year Mod 100 + intValue) \ 100 + (year Mod 400 + intValue) \ 400))
276 If value < 0 Then
277 If (year Mod 4 + intValue <= 0 And year Mod 100 > 4) Or (year Mod 400 <= 4) Then
278 AddTicks(-864000000000)
279 End If
280 End If
281
282 If IsLeapYear(year) = TRUE Then
283 AddTicks(((value - intValue) * 316224000000000) As Int64)
284 Else
285 AddTicks(((value - intValue) * 315360000000000) As Int64)
286 End If
287 End Sub
288
289 Function DaysInMonth(year As Long, month As Long) As Long
290 If year < 1 Or year > 9999 Or month < 1 Or month > 12 Then
291 'ArgumentOutOfRangeException
292 debug
293 End If
294 Select Case month
295 Case 1
296 Return 31
297 Case 2
298 If IsLeapYear(year) = TRUE Then
299 Return 29
300 Else
301 Return 28
302 End If
303 Case 3
304 Return 31
305 Case 4
306 Return 30
307 Case 5
308 Return 31
309 Case 6
310 Return 30
311 Case 7
312 Return 31
313 Case 8
314 Return 31
315 Case 9
316 Return 30
317 Case 10
318 Return 31
319 Case 11
320 Return 30
321 Case 12
322 Return 31
323 End Select
324 End Function
325
326 Function IsLeapYear(year As Long) As BOOL
327 If (year Mod 4) = 0 Then
328 If (year Mod 100) = 0 Then
329 If (year Mod 400) = 0 Then
330 Return _System_TRUE
331 End If
332 Return _System_FALSE
333 Else
334 Return _System_TRUE
335 End If
336 End If
337 Return _System_FALSE
338 End Function
339
340 Function GetDateTimeFormats() As String
341 Return GetDateTimeFormats(NULL)
342 End Function
343
344 Function GetDateTimeFormats(format As *Byte) As String
345 Dim time As SYSTEMTIME
346 With time
347 .wYear = Year As Word
348 .wMonth = Month As Word
349 .wDay = Day As Word
350 .wHour = Hour As Word
351 .wMinute = Minute As Word
352 .wSecond = Second As Word
353 .wMilliseconds = Millisecond As Word
354 .wDayOfWeek = DayOfWeek() As Word
355 End With
356
357 Dim size As Long
358 size = GetDateFormat(LOCALE_USER_DEFAULT, 0, time, format, NULL, 0)
359 GetDateTimeFormats.ReSize(size - 1)
360 GetDateFormat(LOCALE_USER_DEFAULT, 0, time, format, GetDateTimeFormats, size)
361
362 Dim temp As String
363 If format = NULL Then
364 size = GetTimeFormat(LOCALE_USER_DEFAULT, 0, time, format, NULL, 0)
365 temp.ReSize(size - 1)
366 GetTimeFormat(LOCALE_USER_DEFAULT, 0, time, format, temp, size)
367 GetDateTimeFormats = GetDateTimeFormats + " " + temp
368 Else
369 size = GetTimeFormat(LOCALE_USER_DEFAULT, 0, time, GetDateTimeFormats, NULL, 0)
370 temp.ReSize(size - 1)
371 GetTimeFormat(LOCALE_USER_DEFAULT, 0, time, GetDateTimeFormats, temp, size)
372 GetDateTimeFormats = temp
373 End If
374 End Function
375
376 Static Function FromBinary(dateData As Int64) As DateTime
377 Dim date As DateTime((dateData And &H3FFFFFFFFFFFFFFF), kindFromBinary(dateData))
378 Return date
379 End Function
380
381 Function ToBinary() As Int64
382 Return m_Date
383 End Function
384
385 Static Function FromFileTime(fileTime As FILETIME) As DateTime
386 Dim localTime As FILETIME
387 Dim time As SYSTEMTIME
388 FileTimeToLocalFileTime(fileTime, localTime)
389 FileTimeToSystemTime(localTime, time)
390
391 Dim date As DateTime(time, Local)
392 Return date
393 End Function
394
395 Function ToFileTime() As FILETIME
396 Dim time As SYSTEMTIME
397 With time
398 .wYear = Year As Word
399 .wMonth = Month As Word
400 .wDayOfWeek = DayOfWeek As Word
401 .wDay = Day As Word
402 .wHour = Hour As Word
403 .wMinute = Minute As Word
404 .wSecond = Second As Word
405 .wMilliseconds = Millisecond As Word
406 End With
407 Dim fileTime As FILETIME
408 SystemTimeToFileTime(time, fileTime)
409 Return fileTime
410 End Function
411
412 Static Function FromFileTimeUtc(fileTime As FILETIME) As DateTime
413 Dim time As SYSTEMTIME
414 FileTimeToSystemTime(fileTime, time)
415
416 Dim date As DateTime(time, Utc)
417 Return date
418 End Function
419
420 Function ToFileTimeUtc() As FILETIME
421 Dim fileTime As FILETIME
422 fileTime = ToFileTime()
423 If Kind = Utc Then
424 ToFileTimeUtc = fileTime
425 Else
426 LocalFileTimeToFileTime(fileTime, ToFileTimeUtc) 'Return
427 End If
428 End Function
429
430 Function ToLocalTime() As DateTime
431 If Kind = Local Then
432 ToLocalTime = This
433 Else
434 ToLocalTime = DateTime.FromFileTime(ToFileTime())
435 ToLocalTime.Kind = Local
436 End If
437 End Function
438
439 Function ToUniversalTime() As DateTime
440 If Kind = Utc Then
441 ToUniversalTime = This
442 Else
443 ToUniversalTime = DateTime.FromFileTimeUtc(ToFileTimeUtc())
444 ToUniversalTime.Kind = Utc
445 End If
446 End Function
447Private
448 Sub Ticks(value As Int64)
449 Dim kind As DateTimeKind
450 kind = Kind
451 m_Date = value
452 Kind = kind
453 End Sub
454
455 Sub Kind(kind As DateTimeKind)
456 Dim temp As Int64
457 temp = kind
458 temp = (temp << 62) And &HC000000000000000
459 m_Date = (m_Date And &H3FFFFFFFFFFFFFFF) Or temp
460 End Sub
461
462 Function totalDays() As Long
463 Return (Ticks \ 864000000000) As Long
464 End Function
465
466 Function kindFromBinary(dateData As Int64) As Long
467 dateData = (dateData >> 62) And &H03
468 If dateData = &H01 Then
469 Return Local
470 ElseIf dateData = &H02 Then
471 Return Unspecified
472 ElseIf dateData = &H03 Then
473 Return Utc
474 End If
475 End Function
476End Class
477
478Const Enum DateTimeKind
479 Local
480 Unspecified
481 Utc
482End Enum
483
484Const Enum DayOfWeek
485 Sunday = 0
486 Monday
487 Tuesday
488 Wednesday
489 Thursday
490 Friday
491 Saturday
492End Enum
493
494#endif '__SYSTEM_DATETIME_AB__
Note: See TracBrowser for help on using the repository browser.