-
-
Notifications
You must be signed in to change notification settings - Fork 121
/
mormot.core.datetime.pas
3271 lines (2978 loc) · 103 KB
/
mormot.core.datetime.pas
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
/// Framework Core Low-Level Date and Time Support
// - this unit is a part of the Open Source Synopse mORMot framework 2,
// licensed under a MPL/GPL/LGPL three license - see LICENSE.md
unit mormot.core.datetime;
{
*****************************************************************************
Date and Time definitions and process shared by all framework units
- ISO-8601 Compatible Date/Time Text Encoding
- TSynDate / TSynDateTime / TSynSystemTime High-Level objects
- TUnixTime / TUnixMSTime POSIX Epoch Compatible 64-bit date/time
- TTimeLog efficient 64-bit custom date/time encoding
- TTextDateWriter supporting date/time ISO-8601 serialization
*****************************************************************************
}
interface
{$I ..\mormot.defines.inc}
uses
sysutils,
classes,
mormot.core.base,
mormot.core.os,
mormot.core.unicode,
mormot.core.text;
{ ************ ISO-8601 Compatible Date/Time Text Encoding }
const
/// UTF-8 encoded \uFFF1 special code to mark ISO-8601 SQLDATE in JSON
// - e.g. '"\uFFF12012-05-04"' pattern
// - Unicode special char U+FFF1 is UTF-8 encoded as EF BF B1 bytes
// - as generated by DateToSql/DateTimeToSql/TimeLogToSql functions, and
// expected by the TExtractInlineParameters decoder
JSON_SQLDATE_MAGIC_C = $b1bfef;
/// UTF-8 encoded \uFFF1 special code to mark ISO-8601 SQLDATE in JSON
// - e.g. '"\uFFF12012-05-04"' pattern
JSON_SQLDATE_MAGIC_STR: string[3] = #$ef#$bf#$b1;
/// '"' + UTF-8 encoded \uFFF1 special code to mark ISO-8601 SQLDATE in JSON
JSON_SQLDATE_MAGIC_QUOTE_C = ord('"') + cardinal(JSON_SQLDATE_MAGIC_C) shl 8;
/// '"' + UTF-8 encoded \uFFF1 special code to mark ISO-8601 SQLDATE in JSON
// - defined as a ShortString constant to be used as:
// ! AddShorter(JSON_SQLDATE_MAGIC_QUOTE_STR);
JSON_SQLDATE_MAGIC_QUOTE_STR: string[4] = '"'#$ef#$bf#$b1;
/// Date/Time conversion from ISO-8601
// - handle 'YYYYMMDDThhmmss' and 'YYYY-MM-DD hh:mm:ss' format
// - will also recognize '.sss' milliseconds suffix, if any
function Iso8601ToDateTime(const S: RawByteString): TDateTime; overload;
{$ifdef HASINLINE}inline;{$endif}
/// Date/Time conversion from ISO-8601
// - handle 'YYYYMMDDThhmmss' and 'YYYY-MM-DD hh:mm:ss' format
// - could have been written e.g. by DateTimeToIso8601Text()
// - will also recognize '.sss' milliseconds suffix, if any
// - if L is left to default 0, it will be computed from StrLen(P)
function Iso8601ToDateTimePUtf8Char(P: PUtf8Char; L: integer = 0): TDateTime;
{$ifdef HASINLINE}inline;{$endif}
/// Date/Time conversion from ISO-8601
// - handle 'YYYYMMDDThhmmss' and 'YYYY-MM-DD hh:mm:ss' format, with potentially
// shorten versions has handled by the ISO-8601 standard (e.g. 'YYYY')
// - will also recognize '.sss' milliseconds suffix, if any
// - any ending/trailing single quote will be removed
// - if L is left to default 0, it will be computed from StrLen(P)
procedure Iso8601ToDateTimePUtf8CharVar(P: PUtf8Char; L: integer;
var result: TDateTime);
/// Date/Time conversion from strict ISO-8601 content
// - recognize 'YYYY-MM-DDThh:mm:ss[.sss]' or 'YYYY-MM-DD' or 'Thh:mm:ss[.sss]'
// patterns, as e.g. generated by TJsonWriter.AddDateTime() or RecordSaveJson()
// - will also recognize '.sss' milliseconds suffix, if any
function Iso8601CheckAndDecode(P: PUtf8Char; L: integer;
var Value: TDateTime): boolean;
/// test if P^ contains a valid ISO-8601 text encoded value
// - calls internally Iso8601ToTimeLogPUtf8Char() and returns true if contains
// at least a valid year (YYYY)
function IsIso8601(P: PUtf8Char; L: integer): boolean;
{$ifdef HASINLINE}inline;{$endif}
/// Time conversion from ISO-8601 (with no Date part)
// - handle 'hhmmss' and 'hh:mm:ss' format
// - will also recognize '.sss' milliseconds suffix, if any
// - if L is left to default 0, it will be computed from StrLen(P)
function Iso8601ToTimePUtf8Char(P: PUtf8Char; L: integer = 0): TDateTime; overload;
{$ifdef HASINLINE}inline;{$endif}
/// Time conversion from ISO-8601 (with no Date part)
// - handle 'hhmmss' and 'hh:mm:ss' format
// - will also recognize '.sss' milliseconds suffix, if any
// - if L is left to default 0, it will be computed from StrLen(P)
procedure Iso8601ToTimePUtf8CharVar(P: PUtf8Char; L: integer;
var result: TDateTime);
/// Time conversion from ISO-8601 (with no Date part)
// - recognize 'hhmmss' and 'hh:mm:ss' format into H,M,S variables
// - will also recognize '.sss' milliseconds suffix, if any, into MS
// - if L is left to default 0, it will be computed from StrLen(P)
function Iso8601ToTimePUtf8Char(P: PUtf8Char; L: integer;
var H, M, S, MS: cardinal): boolean; overload;
/// Date conversion from ISO-8601 (with no Time part)
// - recognize 'YYYY-MM-DD' and 'YYYYMMDD' format into Y,M,D variables
// - if L is left to default 0, it will be computed from StrLen(P)
function Iso8601ToDatePUtf8Char(P: PUtf8Char; L: integer;
var Y, M, D: cardinal): boolean;
/// Interval date/time conversion from simple text
// - expected format does not match ISO-8601 Time intervals format, but Oracle
// interval litteral representation, i.e. '+/-D HH:MM:SS'
// - e.g. IntervalTextToDateTime('+0 06:03:20') will return 0.25231481481 and
// IntervalTextToDateTime('-20 06:03:20') -20.252314815
// - as a consequence, negative intervals will be written as TDateTime values:
// !DateTimeToIso8601Text(IntervalTextToDateTime('+0 06:03:20'))='T06:03:20'
// !DateTimeToIso8601Text(IntervalTextToDateTime('+1 06:03:20'))='1899-12-31T06:03:20'
// !DateTimeToIso8601Text(IntervalTextToDateTime('-2 06:03:20'))='1899-12-28T06:03:20'
function IntervalTextToDateTime(Text: PUtf8Char): TDateTime;
{$ifdef HASINLINE}inline;{$endif}
/// Interval date/time conversion from simple text
// - expected format does not match ISO-8601 Time intervals format, but Oracle
// interval litteral representation, i.e. '+/-D HH:MM:SS'
// - e.g. '+1 06:03:20' will return 1.25231481481
procedure IntervalTextToDateTimeVar(Text: PUtf8Char; var result: TDateTime);
/// basic Date/Time conversion into ISO-8601
// - use 'YYYYMMDDThhmmss' format if not Expanded
// - use 'YYYY-MM-DDThh:mm:ss' format if Expanded
// - if WithMS is TRUE, will append '.sss' for milliseconds resolution
// - if QuotedChar is not default #0, will (double) quote the resulted text
// - you may rather use DateTimeToIso8601Text() to handle 0 or date-only values
function DateTimeToIso8601(D: TDateTime; Expanded: boolean; FirstChar: AnsiChar = 'T';
WithMS: boolean = false; QuotedChar: AnsiChar = #0): RawUtf8; overload;
{$ifdef HASINLINE}inline;{$endif}
/// raw basic Date/Time conversion into ISO-8601
procedure DateTimeToIso8601Var(D: TDateTime; Expanded, WithMS: boolean;
FirstChar, QuotedChar: AnsiChar; var Result: RawUtf8);
/// basic Date/Time conversion into ISO-8601
// - use 'YYYYMMDDThhmmss' format if not Expanded
// - use 'YYYY-MM-DDThh:mm:ss' format if Expanded
// - if WithMS is TRUE, will append '.sss' for milliseconds resolution
// - if QuotedChar is not default #0, will (double) quote the resulted text
// - you may rather use DateTimeToIso8601Text() to handle 0 or date-only values
// - returns the number of chars written to P^ buffer
function DateTimeToIso8601(P: PUtf8Char; D: TDateTime; Expanded: boolean;
FirstChar: AnsiChar = 'T'; WithMS: boolean = false;
QuotedChar: AnsiChar = #0): integer; overload;
/// basic Date conversion into ISO-8601
// - use 'YYYYMMDD' format if not Expanded
// - use 'YYYY-MM-DD' format if Expanded
function DateToIso8601(Date: TDateTime; Expanded: boolean): RawUtf8; overload;
/// basic Date conversion into ISO-8601
// - use 'YYYYMMDD' format if not Expanded
// - use 'YYYY-MM-DD' format if Expanded
function DateToIso8601(Y, M, D: cardinal; Expanded: boolean): RawUtf8; overload;
/// basic Date period conversion into ISO-8601
// - will convert an elapsed number of days as ISO-8601 text
// - use 'YYYYMMDD' format if not Expanded
// - use 'YYYY-MM-DD' format if Expanded
function DaysToIso8601(Days: cardinal; Expanded: boolean): RawUtf8;
/// basic Time conversion into ISO-8601
// - use 'Thhmmss' format if not Expanded
// - use 'Thh:mm:ss' format if Expanded
// - if WithMS is TRUE, will append '.sss' for milliseconds resolution
function TimeToIso8601(Time: TDateTime; Expanded: boolean; FirstChar: AnsiChar = 'T';
WithMS: boolean = false): RawUtf8;
/// Write a Date to P^ Ansi buffer
// - if Expanded is false, 'YYYYMMDD' date format is used
// - if Expanded is true, 'YYYY-MM-DD' date format is used
function DateToIso8601PChar(P: PUtf8Char; Expanded: boolean;
Y, M, D: PtrUInt): PUtf8Char; overload;
/// convert a date into 'YYYY-MM-DD' date format
// - resulting text is compatible with all ISO-8601 functions
function DateToIso8601Text(Date: TDateTime): RawUtf8;
/// Write a Date/Time to P^ Ansi buffer
function DateToIso8601PChar(Date: TDateTime; P: PUtf8Char;
Expanded: boolean): PUtf8Char; overload;
/// Write a TDateTime value, expanded as Iso-8601 encoded text into P^ Ansi buffer
// - if DT=0, returns ''
// - if DT contains only a date, returns the date encoded as 'YYYY-MM-DD'
// - if DT contains only a time, returns the time encoded as 'Thh:mm:ss'
// - otherwise, returns the ISO-8601 date and time encoded as 'YYYY-MM-DDThh:mm:ss'
// - if WithMS is TRUE, will append '.sss' for milliseconds resolution
function DateTimeToIso8601ExpandedPChar(const Value: TDateTime; Dest: PUtf8Char;
FirstChar: AnsiChar = 'T'; WithMS: boolean = false): PUtf8Char;
/// write a TDateTime into strict ISO-8601 date and/or time text
// - if DT=0, returns ''
// - if DT contains only a date, returns the date encoded as 'YYYY-MM-DD'
// - if DT contains only a time, returns the time encoded as 'Thh:mm:ss'
// - otherwise, returns the ISO-8601 date and time encoded as 'YYYY-MM-DDThh:mm:ss'
// - if WithMS is TRUE, will append '.sss' for milliseconds resolution
// - used e.g. by TPropInfo.GetValue() and TPropInfo.NormalizeValue() methods
function DateTimeToIso8601Text(DT: TDateTime; FirstChar: AnsiChar = 'T';
WithMS: boolean = false): RawUtf8;
/// write a TDateTime into strict ISO-8601 date and/or time text
// - if DT=0, returns ''
// - if DT contains only a date, returns the date encoded as 'YYYY-MM-DD'
// - if DT contains only a time, returns the time encoded as 'Thh:mm:ss'
// - otherwise, returns the ISO-8601 date and time encoded as 'YYYY-MM-DDThh:mm:ss'
// - if WithMS is TRUE, will append '.sss' for milliseconds resolution
// - used e.g. by TPropInfo.GetValue() and TPropInfo.NormalizeValue() methods
procedure DateTimeToIso8601TextVar(DT: TDateTime; FirstChar: AnsiChar;
var result: RawUtf8; WithMS: boolean = false);
/// write a TDateTime into strict ISO-8601 date and/or time text
// - if DT=0, returns ''
// - if DT contains only a date, returns the date encoded as 'YYYY-MM-DD'
// - if DT contains only a time, returns the time encoded as 'Thh:mm:ss'
// - otherwise, returns the ISO-8601 date and time encoded as 'YYYY-MM-DDThh:mm:ss'
// - if WithMS is TRUE, will append '.sss' for milliseconds resolution
// - used e.g. by TPropInfo.GetValue() and TPropInfo.NormalizeValue() methods
procedure DateTimeToIso8601StringVar(DT: TDateTime; FirstChar: AnsiChar;
var result: string; WithMS: boolean = false);
/// Write a Time to P^ Ansi buffer
// - if Expanded is false, 'Thhmmss' time format is used
// - if Expanded is true, 'Thh:mm:ss' time format is used
// - you can custom the first char in from of the resulting text time
// - if WithMS is TRUE, will append MS as '.sss' for milliseconds resolution
function TimeToIso8601PChar(P: PUtf8Char; Expanded: boolean; H, M, S, MS: PtrUInt;
FirstChar: AnsiChar = 'T'; WithMS: boolean = false): PUtf8Char; overload;
/// Write a Time to P^ Ansi buffer
// - if Expanded is false, 'Thhmmss' time format is used
// - if Expanded is true, 'Thh:mm:ss' time format is used
// - you can custom the first char in from of the resulting text time
// - if WithMS is TRUE, will append '.sss' for milliseconds resolution
function TimeToIso8601PChar(Time: TDateTime; P: PUtf8Char; Expanded: boolean;
FirstChar: AnsiChar = 'T'; WithMS: boolean = false): PUtf8Char; overload;
/// convert any date/time Variant into a TDateTime value
// - would handle varDate kind of variant, or use a string conversion and
// ISO-8601 parsing if possible
function VariantToDateTime(const V: Variant; var Value: TDateTime): boolean;
/// decode most used TimeZone text values (CEST, GMT, +0200, -0800...)
// - on match, returns true and the time zone minutes offset in respect to UTC
// - if P is not a time zone, returns false and leave Zone to its supplied value
// - will recognize only the most used text values using a fixed table (RFC 822
// with some extensions like -0000 as current system timezone) - using
// numerical zones is the preferred way in recent RFC anyway
function ParseTimeZone(var P: PUtf8Char; var Zone: integer): boolean; overload;
/// decode most used TimeZone text values (CEST, GMT, +0200, -0800...)
// - just a wrapper around overloaded ParseTimeZone(PUtf8Char)
function ParseTimeZone(const s: RawUtf8; var Zone: integer): boolean; overload;
/// decode a month from its RFC 822 text value (Jan, Feb...)
function ParseMonth(var P: PUtF8Char; var Month: word): boolean; overload;
/// decode a month from its RFC 822 text value (Jan, Feb...)
function ParseMonth(const s: RawUtf8; var Month: word): boolean; overload;
const
/// Rotate local log file if reached this size (1MB by default)
// - .log file will be save as .log.bak file
// - a new .log file is created
// - used by AppendToTextFile() and LogToTextFile() functions (not TSynLog)
MAXLOGSIZE = 1024*1024;
/// log a message with the current timestamp to a local text file
// - the text file is located in the executable directory, and its name is
// simply the executable file name with the '.log' extension instead of '.exe'
// - format contains the current date and time, then the Msg on one line
// - date and time format used is 'YYYYMMDD hh:mm:ss (i.e. ISO-8601)'
procedure LogToTextFile(Msg: RawUtf8);
/// log a message with the current timestamp to a local text file
// - this version expects the filename to be specified
// - format contains the current date and time, then the Msg on one line
// - date and time format used is 'YYYYMMDD hh:mm:ss'
function AppendToTextFile(aLine: RawUtf8; const aFileName: TFileName;
aMaxSize: Int64 = MAXLOGSIZE; aUtcTimeStamp: boolean = false): boolean;
var
/// custom TTimeLog date to ready to be displayed text function
// - you can override this pointer in order to display the text according
// to your expected i18n settings
// - this callback will therefore be set by the mORMoti18n.pas unit
// - used e.g. by TTimeLogBits.i18nText and by TOrmTable.ExpandAsString()
// methods, i.e. TOrmTableToGrid.DrawCell()
i18nDateText: function(const Iso: TTimeLog): string = nil;
/// custom date to ready to be displayed text function
// - you can override this pointer in order to display the text according
// to your expected i18n settings
// - this callback will therefore be set by the mORMoti18n.pas unit
// - used e.g. by TOrmTable.ExpandAsString() method,
// i.e. TOrmTableToGrid.DrawCell()
i18nDateTimeText: function(const DateTime: TDateTime): string = nil;
{ ************ TSynDate / TSynDateTime / TSynSystemTime High-Level objects }
type
{$A-}
/// a simple way to store a date as Year/Month/Day
// - with no intermediate computation needed as with TDate/TUnixTime values
// - consider using TSynSystemTime if you need to handle both Date and Time
// - match the first 4 fields of TSynSystemTime - so PSynDate(@aSynSystemTime)^
// is safe to be used
// - some Delphi revisions have trouble with "object" as own method parameters
// (e.g. IsEqual or Compare) so we force to use "record" type if possible
{$ifdef USERECORDWITHMETHODS}
TSynDate = record
{$else}
TSynDate = object
{$endif USERECORDWITHMETHODS}
public
/// the Year value of this Date
Year: word;
/// the Month value of this Date (1..12)
Month: word;
/// which day of week this Date happend
// - sunday is DayOfWeek 1, saturday is 7
// - DayOfWeek field is not handled by its methods by default, but could be
// filled on demand via ComputeDayOfWeek - making this record 64-bit long
DayOfWeek: word;
/// the Day value of this Date (1..31)
Day: word;
/// set all fields to 0
procedure Clear;
{$ifdef HASINLINE}inline;{$endif}
/// set internal date to 9999-12-31
procedure SetMax;
{$ifdef HASINLINE}inline;{$endif}
/// returns true if all fields are zero
function IsZero: boolean;
{$ifdef HASINLINE}inline;{$endif}
/// try to parse a YYYY-MM-DD or YYYYMMDD ISO-8601 date from the supplied buffer
// - on success, move P^ just after the date, and return TRUE
function ParseFromText(var P: PUtf8Char): boolean;
{$ifdef HASINLINE}inline;{$endif}
/// fill fields with the current UTC/local date, using a 8-16ms thread-safe cache
procedure FromNow(localtime: boolean = false);
/// fill fields with the supplied date
procedure FromDate(date: TDate);
/// returns true if all fields do match - ignoring DayOfWeek field value
function IsEqual(const another: TSynDate): boolean;
/// compare the stored value to a supplied value
// - returns <0 if the stored value is smaller than the supplied value,
// 0 if both are equals, and >0 if the stored value is bigger
// - DayOfWeek field value is not compared
function Compare(const another: TSynDate): integer;
{$ifdef HASINLINE}inline;{$endif}
/// fill the DayOfWeek field from the stored Year/Month/Day
// - by default, most methods will just store 0 in the DayOfWeek field
// - sunday is DayOfWeek 1, saturday is 7
procedure ComputeDayOfWeek;
/// convert the stored date into a TDate floating-point value
function ToDate: TDate;
{$ifdef HASINLINE}inline;{$endif}
/// encode the stored date as ISO-8601 text
// - returns '' if the stored date is 0 (i.e. after Clear)
function ToText(Expanded: boolean = true): RawUtf8;
end;
/// store several dates as Year/Month/Day
TSynDateDynArray = array of TSynDate;
/// a pointer to a TSynDate instance
PSynDate = ^TSynDate;
/// a cross-platform and cross-compiler TSystemTime 128-bit structure
// - FPC's TSystemTime in datih.inc does NOT match Windows TSystemTime fields!
// - also used to store a Date/Time in TSynTimeZone internal structures, or
// for fast conversion from TDateTime to its ready-to-display members
// - DayOfWeek field is not handled by most methods by default, but could be
// filled on demand via ComputeDayOfWeek
// - some Delphi revisions have trouble with "object" as own method parameters
// (e.g. IsEqual) so we force to use "record" type if possible
{$ifdef USERECORDWITHMETHODS}
TSynSystemTime = record
{$else}
TSynSystemTime = object
{$endif USERECORDWITHMETHODS}
public
Year,
Month,
DayOfWeek,
Day,
Hour,
Minute,
Second,
MilliSecond: word;
/// set all fields to 0
procedure Clear;
{$ifdef HASINLINE}inline;{$endif}
/// returns true if all fields are zero
function IsZero: boolean;
{$ifdef HASINLINE}inline;{$endif}
/// returns true if all fields do match
function IsEqual(const another: TSynSystemTime): boolean;
/// returns true if date fields do match (ignoring DayOfWeek)
function IsDateEqual(const date: TSynDate): boolean;
/// used by TSynTimeZone
function EncodeForTimeChange(const aYear: word): TDateTime;
/// fill fields with the current UTC time, using a 8-16ms thread-safe cache
procedure FromNowUtc;
/// fill fields with the current Local time, using a 8-16ms thread-safe cache
procedure FromNowLocal;
/// fill fields with the current UTC or local time, using a 8-16ms thread-safe cache
procedure FromNow(localtime: boolean);
/// fill fields from the given value - but not DayOfWeek
procedure FromDateTime(const dt: TDateTime);
/// fill Year/Month/Day fields from the given value - but not DayOfWeek
// - faster than the RTL DecodeDate() function
procedure FromDate(const dt: TDateTime);
/// fill Hour/Minute/Second/Millisecond fields from the given number of milliseconds
// - faster than the RTL DecodeTime() function
procedure FromMS(ms: PtrUInt);
/// fill Hour/Minute/Second/Millisecond fields from the given number of seconds
// - faster than the RTL DecodeTime() function
procedure FromSec(s: PtrUInt);
/// fill Hour/Minute/Second/Millisecond fields from the given TDateTime value
// - faster than the RTL DecodeTime() function
procedure FromTime(const dt: TDateTime);
/// fill Year/Month/Day and Hour/Minute/Second fields from the given ISO-8601 text
// - returns true on success
function FromText(const iso: RawUtf8): boolean;
/// fill Year/Month/Day and Hour/Minute/Second fields from HTTP-date format
// - as defined by https://tools.ietf.org/html/rfc7231#section-7.1.1.1 e.g.
// $ Sun, 06 Nov 1994 08:49:37 GMT ; IMF-fixdate
// $ Sunday, 06-Nov-94 08:49:37 GMT ; obsolete RFC 850 format
// $ Sun Nov 6 08:49:37 1994 ; ANSI C's asctime() format
function FromHttpDate(const httpdate: RawUtf8;
tolocaltime: boolean = false): boolean;
/// encode the stored date/time as ISO-8601 text with Milliseconds
function ToText(Expanded: boolean = true; FirstTimeChar: AnsiChar = 'T';
const TZD: RawUtf8 = ''): RawUtf8;
/// append the stored date and time, in a log-friendly format
// - e.g. append '20110325 19241502' - with no trailing space nor tab
// - as called by TJsonWriter.AddCurrentLogTime()
procedure AddLogTime(WR: TTextWriter);
/// append the stored date and time, in apache-like format, to a TJsonWriter
// - e.g. append '19/Feb/2019:06:18:55 ' - including a trailing space
procedure AddNCSAText(WR: TTextWriter);
/// append the stored date and time, in apache-like format, to a memory buffer
// - e.g. append '19/Feb/2019:06:18:55 ' - including a trailing space
// - returns the number of chars added to P, i.e. always 21
function ToNCSAText(P: PUtf8Char): PtrInt;
/// convert the stored date and time to its text in HTTP-like format
// - i.e. "Tue, 15 Nov 1994 12:45:26 GMT" to be used as a value of
// "Date", "Expires" or "Last-Modified" HTTP header
// - handle UTC/GMT time zone by default, and allow a 'Date: ' prefix
procedure ToHttpDate(out text: RawUtf8; const tz: RawUtf8 = 'GMT';
const prefix: RawUtf8 = '');
/// convert the stored date and time to its text in HTTP-like format
procedure ToHttpDateShort(var text: shortstring; const tz: RawUtf8 = 'GMT';
const prefix: RawUtf8 = '');
/// convert the stored date and time into its Iso-8601 text, with no Milliseconds
procedure ToIsoDateTime(out text: RawUtf8; const FirstTimeChar: AnsiChar = 'T');
/// convert the stored date into its Iso-8601 text with no time part
procedure ToIsoDate(out text: RawUtf8);
/// convert the stored time into its Iso-8601 text with no date part nor Milliseconds
procedure ToIsoTime(out text: RawUtf8; const FirstTimeChar: RawUtf8 = 'T');
/// convert the stored time into a TDateTime
function ToDateTime: TDateTime;
/// copy Year/Month/DayOfWeek/Day fields to a TSynDate
procedure ToSynDate(out date: TSynDate);
{$ifdef HASINLINE}inline;{$endif}
/// convert the stored time into a timestamped local file name
// - use 'YYMMDDHHMMSS' format so year is truncated to last 2 digits,
// expecting a date > 1999 (a current date would be fine)
procedure ToFileShort(out result: TShort16);
/// fill the DayOfWeek field from the stored Year/Month/Day
// - by default, most methods will just store 0 in the DayOfWeek field
// - sunday is DayOfWeek 1, saturday is 7
procedure ComputeDayOfWeek;
{$ifdef HASINLINE}inline;{$endif}
/// add some 1..999 milliseconds to the stored time
// - not to be used for computation, but e.g. for fast AddLogTime generation
procedure IncrementMS(ms: integer);
end;
/// pointer to our cross-platform and cross-compiler TSystemTime 128-bit structure
PSynSystemTime = ^TSynSystemTime;
{$A+}
/// our own faster version of the corresponding RTL function
function TryEncodeDate(Year, Month, Day: cardinal; out Date: TDateTime): boolean;
/// our own faster version of the corresponding RTL function
function IsLeapYear(Year: cardinal): boolean;
/// retrieve the current Date, in the ISO 8601 layout, but expanded and
// ready to be displayed
function NowToString(Expanded: boolean = true; FirstTimeChar: AnsiChar = ' '): RawUtf8;
/// retrieve the current UTC Date, in the ISO 8601 layout, but expanded and
// ready to be displayed
function NowUtcToString(Expanded: boolean = true; FirstTimeChar: AnsiChar = ' '): RawUtf8;
/// convert some date/time to the ISO 8601 text layout, including milliseconds
// - i.e. 'YYYY-MM-DD hh:mm:ss.sssZ' or 'YYYYMMDD hhmmss.sssZ' format
// - TZD is the ending time zone designator ('', 'Z' or '+hh:mm' or '-hh:mm')
// - see also TJsonWriter.AddDateTimeMS method
function DateTimeMSToString(DateTime: TDateTime; Expanded: boolean = true;
FirstTimeChar: AnsiChar = ' '; const TZD: RawUtf8 = 'Z'): RawUtf8; overload;
/// convert some date/time to the ISO 8601 text layout, including milliseconds
// - i.e. 'YYYY-MM-DD hh:mm:ss.sssZ' or 'YYYYMMDD hhmmss.sssZ' format
// - TZD is the ending time zone designator ('', 'Z' or '+hh:mm' or '-hh:mm')
// - see also TJsonWriter.AddDateTimeMS method
function DateTimeMSToString(HH, MM, SS, MS, Y, M, D: cardinal; Expanded: boolean;
FirstTimeChar: AnsiChar = ' '; const TZD: RawUtf8 = 'Z'): RawUtf8; overload;
/// convert some date/time to the "HTTP-date" format as defined by RFC 7231
// - i.e. "Tue, 15 Nov 1994 12:45:26 GMT" to be used as a value of
// "Date", "Expires" or "Last-Modified" HTTP header
// - if you care about timezones, dt value must be converted to UTC first
// using TSynTimeZone.LocalToUtc, or tz should be properly set
function DateTimeToHttpDate(dt: TDateTime; const tz: RawUtf8 = 'GMT'): RawUtf8; overload;
/// convert some "HTTP-date" format as defined by RFC 7231 into date/time
// - wrapper around TSynSystemTime.FromHttpDate() conversion algorithm
function HttpDateToDateTime(const httpdate: RawUtf8; var datetime: TDateTime;
tolocaltime: boolean = false): boolean; overload;
/// convert some "HTTP-date" format as defined by RFC 7231 into date/time
function HttpDateToDateTime(const httpdate: RawUtf8;
tolocaltime: boolean = false): TDateTime; overload;
type
THttpDateNowUtc = string[37];
/// returns the current UTC timestamp as the full 'Date' HTTP header line
// - e.g. 'Date: Tue, 15 Nov 1994 12:45:26 GMT'#13#10
// - returns as a shortstring to avoid a memory allocation by caller
// - use an internal cache for every second refresh
function HttpDateNowUtc: THttpDateNowUtc;
/// convert some TDateTime to a small text layout, perfect e.g. for naming a local file
// - use 'YYMMDDHHMMSS' format so year is truncated to last 2 digits, expecting
// a date > 1999 (a current date would be fine)
function DateTimeToFileShort(const DateTime: TDateTime): TShort16; overload;
{$ifdef FPC_OR_UNICODE} inline;{$endif} // Delphi 2007 is buggy as hell
/// convert some TDateTime to a small text layout, perfect e.g. for naming a local file
// - use 'YYMMDDHHMMSS' format so year is truncated to last 2 digits, expecting
// a date > 1999 (a current date would be fine)
procedure DateTimeToFileShort(const DateTime: TDateTime; out result: TShort16); overload;
/// get the current time a small text layout, perfect e.g. for naming a file
// - use 'YYMMDDHHMMSS' format so year is truncated to last 2 digits
function NowToFileShort(localtime: boolean = false): TShort16;
/// retrieve the current Time (whithout Date), in the ISO 8601 layout
// - useful for direct on screen logging e.g.
function TimeToString: RawUtf8;
const
/// used e.g. by DateTimeMSToString and TJsonWriter.AddDateTimeMS
DTMS_FMT: array[boolean] of RawUtf8 = (
'%%%%%%%%%',
'%-%-%%%:%:%.%%');
{ ************ TUnixTime / TUnixMSTime POSIX Epoch Compatible 64-bit date/time }
const
/// a contemporary, but elapsed, TUnixTime second-based value
// - corresponds to Thu, 08 Dec 2016 08:50:20 GMT
// - may be used to check for a valid just-generated Unix timestamp value
// - or used to store a timestamp without any 32-bit "Year 2038" overflow
UNIXTIME_MINIMAL = 1481187020;
/// returns UnixTimeUtc - UNIXTIME_MINIMAL so has no "Year 2038" overflow issue
function UnixTimeMinimalUtc: cardinal;
{$ifdef HASINLINE}inline;{$endif}
/// convert a second-based c-encoded time as TDateTime
// - i.e. number of seconds elapsed since Unix epoch 1/1/1970 into TDateTime
function UnixTimeToDateTime(const UnixTime: TUnixTime): TDateTime;
{$ifdef HASINLINE}inline;{$endif}
/// convert a TDateTime into a second-based c-encoded time
// - i.e. TDateTime into number of seconds elapsed since Unix epoch 1/1/1970
function DateTimeToUnixTime(const AValue: TDateTime): TUnixTime;
{$ifdef HASINLINE}inline;{$endif}
/// convert some second-based c-encoded time (from Unix epoch 1/1/1970) to
// the ISO 8601 text layout
// - use 'YYYYMMDDThhmmss' format if not Expanded
// - use 'YYYY-MM-DDThh:mm:ss' format if Expanded
function UnixTimeToString(const UnixTime: TUnixTime; Expanded: boolean = true;
FirstTimeChar: AnsiChar = 'T'): RawUtf8;
/// convert some second-based c-encoded time (from Unix epoch 1/1/1970) to
// a small text layout, perfect e.g. for naming a local file
// - use 'YYMMDDHHMMSS' format so year is truncated to last 2 digits, expecting
// a date > 1999 (a current date would be fine)
procedure UnixTimeToFileShort(const UnixTime: TUnixTime; out result: TShort16); overload;
/// convert some second-based c-encoded time (from Unix epoch 1/1/1970) to
// a small text layout, perfect e.g. for naming a local file
// - use 'YYMMDDHHMMSS' format so year is truncated to last 2 digits, expecting
// a date > 1999 (a current date would be fine)
function UnixTimeToFileShort(const UnixTime: TUnixTime): TShort16; overload;
{$ifdef FPC_OR_UNICODE} inline;{$endif} // Delphi 2007 is buggy as hell
/// convert some second-based c-encoded time to the ISO 8601 text layout, either
// as time or date elapsed period
// - this function won't add the Unix epoch 1/1/1970 offset to the timestamp
// - returns 'Thh:mm:ss' or 'YYYY-MM-DD' format, depending on the supplied value
function UnixTimePeriodToString(const UnixTime: TUnixTime;
FirstTimeChar: AnsiChar = 'T'): RawUtf8;
/// convert a millisecond-based c-encoded time (from Unix epoch 1/1/1970) as TDateTime
function UnixMSTimeToDateTime(const UnixMSTime: TUnixMSTime): TDateTime;
{$ifdef HASINLINE}inline;{$endif}
/// convert a TDateTime into a millisecond-based c-encoded time (from Unix epoch 1/1/1970)
// - if AValue is 0, will return 0 (since is likely to be an error constant)
function DateTimeToUnixMSTime(const AValue: TDateTime): TUnixMSTime;
{$ifdef HASINLINE}inline;{$endif}
/// convert some millisecond-based c-encoded time (from Unix epoch 1/1/1970) to
// the ISO 8601 text layout, including milliseconds
// - i.e. 'YYYY-MM-DDThh:mm:ss.sssZ' or 'YYYYMMDDThhmmss.sssZ' format
// - TZD is the ending time zone designator ('', 'Z' or '+hh:mm' or '-hh:mm')
function UnixMSTimeToString(const UnixMSTime: TUnixMSTime; Expanded: boolean = true;
FirstTimeChar: AnsiChar = 'T'; const TZD: RawUtf8 = ''): RawUtf8;
/// convert some milllisecond-based c-encoded time (from Unix epoch 1/1/1970) to
// a small text layout, trimming to the second resolution, perfect e.g. for
// naming a local file
// - use 'YYMMDDHHMMSS' format so year is truncated to last 2 digits, expecting
// a date > 1999 (a current date would be fine)
function UnixMSTimeToFileShort(const UnixMSTime: TUnixMSTime): TShort16;
{$ifdef FPC_OR_UNICODE} inline;{$endif} // Delphi 2007 is buggy as hell
/// convert some millisecond-based c-encoded time to the ISO 8601 text layout,
// as time or date elapsed period
// - this function won't add the Unix epoch 1/1/1970 offset to the timestamp
// - returns 'Thh:mm:ss' or 'YYYY-MM-DD' format, depending on the supplied value
function UnixMSTimePeriodToString(const UnixMSTime: TUnixMSTime;
FirstTimeChar: AnsiChar = 'T'): RawUtf8;
{ ************ TTimeLog efficient 64-bit custom date/time encoding }
type
/// pointer to a memory structure for direct access to a TTimeLog type value
PTimeLogBits = ^TTimeLogBits;
/// internal memory structure for direct access to a TTimeLog type value
// - most of the time, you should not use this object, but higher level
// TimeLogFromDateTime/TimeLogToDateTime/TimeLogNow/Iso8601ToTimeLog functions
// - since TTimeLogBits.Value is bit-oriented, you can't just add or substract
// two TTimeLog values when doing date/time computation: use a TDateTime
// temporary conversion in such case
// - TTimeLogBits.Value needs up to 40-bit precision, so features exact
// representation as JavaScript numbers (stored in a 52-bit mantissa)
TTimeLogBits = object
public
/// the bit-encoded value itself, which follows an abstract "year" of 16
// months of 32 days of 32 hours of 64 minutes of 64 seconds
// - bits 0..5 = Seconds (0..59)
// - bits 6..11 = Minutes (0..59)
// - bits 12..16 = Hours (0..23)
// - bits 17..21 = Day-1 (0..31)
// - bits 22..25 = Month-1 (0..11)
// - bits 26..40 = Year (0..9999)
Value: Int64;
/// extract the date and time content in Value into individual values
procedure Expand(out Date: TSynSystemTime);
/// convert to Iso-8601 encoded text, truncated to date/time only if needed
function Text(Expanded: boolean; FirstTimeChar: AnsiChar = 'T'): RawUtf8; overload;
/// convert to Iso-8601 encoded text, truncated to date/time only if needed
function Text(Dest: PUtf8Char; Expanded: boolean;
FirstTimeChar: AnsiChar = 'T'; QuoteChar: AnsiChar = #0): PUtf8Char; overload;
/// convert to Iso-8601 encoded text with date and time part
// - never truncate to date/time nor return '' as Text() does
function FullText(Expanded: boolean; FirstTimeChar: AnsiChar = 'T';
QuotedChar: AnsiChar = #0): RawUtf8; overload;
{$ifdef FPC}inline;{$endif} // URW1111 on Delphi 2010 and URW1136 on XE
/// convert to Iso-8601 encoded text with date and time part
// - never truncate to date/time or return '' as Text() does
function FullText(Dest: PUtf8Char; Expanded: boolean;
FirstTimeChar: AnsiChar = 'T'; QuotedChar: AnsiChar = #0): PUtf8Char; overload;
/// convert to ready-to-be displayed text
// - using i18nDateText global event, if set (e.g. by mORMoti18n.pas)
function i18nText: string;
/// extract the Time value of this date/time as floating-point TTime
function ToTime: TTime;
/// extract the Date value of this date/time as floating-point TDate
// - will return 0 if the stored value is not a valid date
function ToDate: TDate;
/// convert to a floating-point TDateTime
// - will return 0 if the stored value is not a valid date
function ToDateTime: TDateTime;
/// convert to a second-based c-encoded time (from Unix epoch 1/1/1970)
function ToUnixTime: TUnixTime;
/// convert to a millisecond-based c-encoded time (from Unix epoch 1/1/1970)
// - of course, milliseconds will be 0 due to TTimeLog second resolution
function ToUnixMSTime: TUnixMSTime;
/// fill Value from specified Date and Time
procedure From(Y, M, D, HH, MM, SS: cardinal); overload;
/// fill Value from specified TDateTime
procedure From(DateTime: TDateTime; DateOnly: boolean = false); overload;
/// fill Value from specified low-level system-specific FileAge() integer
// - i.e. 32-bit Windows bitmask local time, or 64-bit Unix UTC time
procedure FromFileDate(const FileDate: TFileAge);
/// fill Value from Iso-8601 encoded text
procedure From(P: PUtf8Char; L: integer); overload;
/// fill Value from Iso-8601 encoded text
procedure From(const S: RawUtf8); overload;
/// fill Value from specified Date/Time individual fields
procedure From(Time: PSynSystemTime); overload;
/// fill Value from second-based c-encoded time (from Unix epoch 1/1/1970)
procedure FromUnixTime(const UnixTime: TUnixTime);
/// fill Value from millisecond-based c-encoded time (from Unix epoch 1/1/1970)
// - of course, millisecond resolution will be lost during conversion
procedure FromUnixMSTime(const UnixMSTime: TUnixMSTime);
/// fill Value from current local system Date and Time
procedure FromNow;
/// fill Value from current UTC system Date and Time
// - FromNow uses local time: this function retrieves the system time
// expressed in Coordinated Universal Time (UTC)
procedure FromUtcTime;
/// get the year (e.g. 2015) of the TTimeLog value
function Year: integer;
{$ifdef HASINLINE}inline;{$endif}
/// get the month (1..12) of the TTimeLog value
function Month: integer;
{$ifdef HASINLINE}inline;{$endif}
/// get the day (1..31) of the TTimeLog value
function Day: integer;
{$ifdef HASINLINE}inline;{$endif}
/// get the hour (0..23) of the TTimeLog value
function Hour: integer;
{$ifdef HASINLINE}inline;{$endif}
/// get the minute (0..59) of the TTimeLog value
function Minute: integer;
{$ifdef HASINLINE}inline;{$endif}
/// get the second (0..59) of the TTimeLog value
function Second: integer;
{$ifdef HASINLINE}inline;{$endif}
end;
/// get TTimeLog value from current local system date and time
// - handle TTimeLog bit-encoded Int64 format
function TimeLogNow: TTimeLog;
{$ifdef HASINLINE}inline;{$endif}
/// get TTimeLog value from current UTC system Date and Time
// - handle TTimeLog bit-encoded Int64 format
function TimeLogNowUtc: TTimeLog;
{$ifdef HASINLINE}inline;{$endif}
/// get TTimeLog value from a file date and time
// - handle TTimeLog bit-encoded Int64 format
function TimeLogFromFile(const FileName: TFileName): TTimeLog;
/// get TTimeLog value from a given floating-point TDateTime
// - handle TTimeLog bit-encoded Int64 format
// - just a wrapper around PTimeLogBits(@aTime)^.From()
// - we defined such a function since TTimeLogBits(aTimeLog).From() won't change
// the aTimeLog variable content
function TimeLogFromDateTime(const DateTime: TDateTime): TTimeLog;
{$ifdef HASINLINE}inline;{$endif}
/// get TTimeLog value from a given Unix seconds since epoch timestamp
// - handle TTimeLog bit-encoded Int64 format
// - just a wrapper around PTimeLogBits(@aTime)^.FromUnixTime()
function TimeLogFromUnixTime(const UnixTime: TUnixTime): TTimeLog;
{$ifdef HASINLINE}inline;{$endif}
/// Date/Time conversion from a TTimeLog value
// - handle TTimeLog bit-encoded Int64 format
// - just a wrapper around PTimeLogBits(@Timestamp)^.ToDateTime
// - we defined such a function since TTimeLogBits(aTimeLog).ToDateTime gives an
// internall compiler error on some Delphi IDE versions (e.g. Delphi 6)
function TimeLogToDateTime(const Timestamp: TTimeLog): TDateTime;
{$ifdef HASINLINE}inline;{$endif}
/// Unix seconds since epoch timestamp conversion from a TTimeLog value
// - handle TTimeLog bit-encoded Int64 format
// - just a wrapper around PTimeLogBits(@Timestamp)^.ToUnixTime
function TimeLogToUnixTime(const Timestamp: TTimeLog): TUnixTime;
{$ifdef HASINLINE}inline;{$endif}
/// convert a Iso8601 encoded string into a TTimeLog value
// - handle TTimeLog bit-encoded Int64 format
// - use this function only for fast comparison between two Iso8601 date/time
// - conversion is faster than Iso8601ToDateTime: use only binary integer math
// - ContainsNoTime optional pointer can be set to a boolean, which will be
// set according to the layout in P (e.g. TRUE for '2012-05-26')
// - returns 0 in case of invalid input string
function Iso8601ToTimeLogPUtf8Char(P: PUtf8Char; L: integer;
ContainsNoTime: PBoolean = nil): TTimeLog;
/// convert a Iso8601 encoded string into a TTimeLog value
// - handle TTimeLog bit-encoded Int64 format
// - use this function only for fast comparison between two Iso8601 date/time
// - conversion is faster than Iso8601ToDateTime: use only binary integer math
function Iso8601ToTimeLog(const S: RawByteString): TTimeLog;
{$ifdef HASINLINE}inline;{$endif}
{ ******************* TTextDateWriter supporting date/time ISO-8601 serialization }
type
/// enhanced TTextWriter inherited class
// - in addition to TTextWriter, will handle date/time ISO-8601 serialization
TTextDateWriter = class(TTextWriter)
public
/// append a TTimeLog value, expanded as Iso-8601 encoded text
procedure AddTimeLog(Value: PInt64; QuoteChar: AnsiChar = #0);
/// append a TUnixTime value, expanded as Iso-8601 encoded text
procedure AddUnixTime(Value: PInt64; QuoteChar: AnsiChar = #0);
/// append a TUnixMSTime value, expanded as Iso-8601 encoded text
procedure AddUnixMSTime(Value: PInt64; WithMS: boolean = false;
QuoteChar: AnsiChar = #0);
/// append a TDateTime value, expanded as Iso-8601 encoded text
// - use 'YYYY-MM-DDThh:mm:ss' format (with FirstChar='T')
// - if twoDateTimeWithZ CustomOption is set, will append an ending 'Z'
// - if WithMS is TRUE, will append '.sss' for milliseconds resolution
// - if QuoteChar is not #0, it will be written before and after the date
procedure AddDateTime(Value: PDateTime; FirstChar: AnsiChar = 'T';
QuoteChar: AnsiChar = #0; WithMS: boolean = false;
AlwaysDateAndTime: boolean = false); overload;
/// append a TDateTime value, expanded as Iso-8601 encoded text
// - use 'YYYY-MM-DDThh:mm:ss' format
// - if twoDateTimeWithZ CustomOption is set, will append an ending 'Z'
// - append nothing if Value=0
// - if WithMS is TRUE, will append '.sss' for milliseconds resolution
procedure AddDateTime(const Value: TDateTime; WithMS: boolean = false); overload;
/// append a TDateTime value, expanded as Iso-8601 text with milliseconds
// and Time Zone designator
// - i.e. 'YYYY-MM-DDThh:mm:ss.sssZ' format
// - twoDateTimeWithZ CustomOption is ignored in favor of TZD parameter
// - TZD is the ending time zone designator ('', 'Z' or '+hh:mm' or '-hh:mm')
procedure AddDateTimeMS(const Value: TDateTime; Expanded: boolean = true;
FirstTimeChar: AnsiChar = 'T'; const TZD: RawUtf8 = 'Z');
/// append the current UTC date and time, in our log-friendly format
// - e.g. append '20110325 19241502' - with no trailing space nor tab
// - you may set LocalTime=TRUE to write the local date and time instead
// - this method is very fast, and avoid most calculation or API calls
procedure AddCurrentLogTime(LocalTime: boolean);
/// append the current UTC date and time, in our log-friendly format
// - e.g. append '19/Feb/2019:06:18:55 ' - including a trailing space
// - you may set LocalTime=TRUE to write the local date and time instead
// - this method is very fast, and avoid most calculation or API calls
procedure AddCurrentNCSALogTime(LocalTime: boolean);
end;
implementation
{ ************ ISO-8601 Compatible Date/Time Text Encoding }
function Iso8601ToDateTimePUtf8Char(P: PUtf8Char; L: integer): TDateTime;
var
tmp: TDateTime; // circumvent FPC limitation
begin
Iso8601ToDateTimePUtf8CharVar(P, L, tmp);
result := tmp;
end;
function Iso8601ToDateTime(const S: RawByteString): TDateTime;
var
tmp: TDateTime; // circumvent FPC limitation
begin
Iso8601ToDateTimePUtf8CharVar(pointer(S), length(S), tmp);
result := tmp;
end;
procedure Iso8601ToDateTimePUtf8CharVar(P: PUtf8Char; L: integer;
var result: TDateTime);
var
B: cardinal;
Y, M, D, H, MI, SS, MS: cardinal;
d100: TDiv100Rec;
{$ifdef CPUX86NOTPIC}
tab: TNormTableByte absolute ConvertHexToBin;
{$else}
tab: PByteArray; // faster on PIC, ARM and x86_64
{$endif CPUX86NOTPIC}
// expect 'YYYYMMDDThhmmss[.sss]' format but handle also 'YYYY-MM-DDThh:mm:ss[.sss]'
begin
unaligned(result) := 0;
if P = nil then
exit;
if L = 0 then
L := StrLen(P);
if L < 4 then
exit; // we need 'YYYY' at least
if (P[0] = '''') and
(P[L - 1] = '''') then
begin
// in-place unquote of input - typical from SQL values
inc(P);
dec(L, 2);
if L < 4 then
exit;
end;
if P[0] = 'T' then
begin
dec(P, 8);
inc(L, 8);
end
else
begin
{$ifndef CPUX86NOTPIC}
tab := @ConvertHexToBin;
{$endif CPUX86NOTPIC}
B := tab[ord(P[0])]; // first digit
if B > 9 then
exit
else
Y := B; // fast check '0'..'9'
B := tab[ord(P[1])];
if B > 9 then
exit
else
Y := Y * 10 + B;
B := tab[ord(P[2])];
if B > 9 then
exit
else
Y := Y * 10 + B;
B := tab[ord(P[3])];
if B > 9 then
exit
else
Y := Y * 10 + B;
if P[4] in ['-', '/'] then
begin
inc(P);
dec(L);
end; // allow YYYY-MM-DD
D := 1;
if L >= 6 then
begin
// YYYYMM
M := ord(P[4]) * 10 + ord(P[5]) - (48 + 480);
if (M = 0) or
(M > 12) then
exit;
if P[6] in ['-', '/'] then
begin
inc(P);
dec(L);
end; // allow YYYY-MM-DD
if L >= 8 then
begin
// YYYYMMDD
if (L > 8) and
not (P[8] in [#0, ' ', 'T']) then
exit; // invalid date format
D := ord(P[6]) * 10 + ord(P[7]) - (48 + 480);
if (D = 0) or
(D > MonthDays[true][M]) then
exit; // worse day number to allow is for leapyear=true
end;
end
else
M := 1;
if M > 2 then // inlined EncodeDate(Y,M,D)
dec(M, 3)
else if M > 0 then
begin
inc(M, 9);
dec(Y);
end;
if Y > 9999 then
exit; // avoid integer overflow e.g. if '0000' is an invalid date
Div100(Y, d100{%H-});