1 | ' Classes/System/DateTime.ab
|
---|
2 |
|
---|
3 | #ifndef __SYSTEM_DATETIME_AB__
|
---|
4 | #define __SYSTEM_DATETIME_AB__
|
---|
5 |
|
---|
6 |
|
---|
7 | Class DateTime
|
---|
8 | m_Date As Int64
|
---|
9 | Public
|
---|
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
|
---|
447 | Private
|
---|
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
|
---|
476 | End Class
|
---|
477 |
|
---|
478 | Const Enum DateTimeKind
|
---|
479 | Local
|
---|
480 | Unspecified
|
---|
481 | Utc
|
---|
482 | End Enum
|
---|
483 |
|
---|
484 | Const Enum DayOfWeek
|
---|
485 | Sunday = 0
|
---|
486 | Monday
|
---|
487 | Tuesday
|
---|
488 | Wednesday
|
---|
489 | Thursday
|
---|
490 | Friday
|
---|
491 | Saturday
|
---|
492 | End Enum
|
---|
493 |
|
---|
494 | #endif '__SYSTEM_DATETIME_AB__
|
---|