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

Last change on this file since 36 was 36, checked in by OverTaker, 17 years ago

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