Delphi/delphimvcframework
1
0
Fork 0
mirror of https://github.com/danieleteti/delphimvcframework.git synced 2024-11-17 16:55:54 +01:00
Code Issues Actions 1 Packages Projects Releases Wiki Activity
9b414b8665
delphimvcframework/lib/dmustache/mormot.core.datetime.pas

3653 lines
116 KiB
ObjectPascal
Raw Normal View History

Updated dmustache to version 2
2024-04-29 15:40:45 +02:00
/// 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
- TValuePUtf8Char text value wrapper record
*****************************************************************************
}
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 RawUtf8
procedure DateTimeToIso8601Var(D: TDateTime; Expanded, WithMS: boolean;
FirstChar, QuotedChar: AnsiChar; var Result: RawUtf8);
/// raw basic Date/Time conversion into ISO-8601 shortstring
function DateTimeToIso8601Short(D: TDateTime; Expanded: boolean = true;
WithMS: boolean = false; FirstChar: AnsiChar = 'T';
QuotedChar: AnsiChar = #0): TShort31;
/// 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(const 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 happened
// - 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
/// the Year value of this timestamp
Year: word;
/// the Month value of this timstamp, in range 1..12
Month: word;
/// which day of week this Date happened
// - 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
DayOfWeek: word;
/// the Day value of this timestamp, in range 1..31
Day: word;
/// the Hour value of this timestamp, in range 0..59
Hour: word;
/// the Minute value of this timestamp, in range 0..59
Minute: word;
/// the Second value of this timestamp, in range 0..59
Second: word;
/// the MilliSecond value of this timestamp, in range 0..999
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 and time fields)
function IsDateEqual(const date: TSynDate): boolean;
/// internal method 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;
{$ifdef HASINLINE}inline;{$endif}
/// fill fields with the current Local time, using a 8-16ms thread-safe cache
procedure FromNowLocal;
{$ifdef HASINLINE}inline;{$endif}
/// fill fields with the current UTC or local time, using a 8-16ms thread-safe cache
procedure FromNow(localtime: boolean);
{$ifdef HASINLINE}inline;{$endif}
/// 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 fields from the given value - but not DayOfWeek
procedure FromUnixTime(ut: TUnixTime);
/// fill fields from the given value - but not DayOfWeek
procedure FromUnixMsTime(ut: TUnixMsTime);
/// 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
// - defined e.g. by https://datatracker.ietf.org/doc/html/rfc7231#section-7.1.1
// $ 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;
/// fill Year/Month/Day and Hour/Minute/Second fields from HTTP-date PUtf8Char
function FromHttpDateBuffer(P: PUtf8Char; tolocaltime: boolean): 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 a value, expanded as Iso-8601 encoded date text
// - use 'YYYY-MM-DD' format
procedure AddIsoDate(WR: TTextWriter);
/// append a value, expanded as Iso-8601 encoded text
// - use 'YYYY-MM-DDThh:mm:ss' format with '.sss' optional milliseconds
procedure AddIsoDateTime(WR: TTextWriter; WithMS: boolean;
FirstTimeChar: AnsiChar = 'T'; const TZD: 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; const TZD: RawUtf8 = '');
/// append the stored date and time, in HTTP-like format, to a TJsonWriter
// - e.g. append '19/Feb/2019:06:18:55 ' - including a trailing space
procedure AddHttpDate(WR: TTextWriter; const TZD: RawUtf8 = 'GMT');
/// append the stored date and time, in apache-like format, to a memory buffer
// - e.g. "Tue, 15 Nov 1994 12:45:26 GMT" to be used as a value of
// - 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 apache-like format
procedure ToNcsaShort(var text: shortstring; const tz: RawUtf8 = 'GMT');
/// 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 ToIsoDateTimeShort(var text: shortstring; FirstTimeChar: AnsiChar = 'T');
/// convert the stored date and time into its Iso-8601 text, with no Milliseconds
procedure ToIsoDateTime(out text: RawUtf8; 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; FirstTimeChar: RawUtf8 = 'T');
/// convert the stored time into a TDateTime
function ToDateTime: TDateTime;
/// convert the stored time into a TUnixTime in seconds since UNIX Epoch
function ToUnixTime: TUnixTime;
/// 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}
/// compute how many days there are in the current month
function DaysInMonth: cardinal;
/// 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);
/// compute all fields so that they are in their natural range
// - set e.g. Second := 60 to force the next minute, or Hour := 24 so that
// it will be normalized to the next day
procedure Normalize;
/// change the system date/time with the value stored in this instance
// - i.e. call SetSystemTime/fpsettimeofday API with the stored date/time
// - will also flush the FromNowLocal/FromNowUtc cached timestamps
function ChangeOperatingSystemTime: boolean;
end;
/// pointer to our cross-platform and cross-compiler TSystemTime 128-bit structure
PSynSystemTime = ^TSynSystemTime;
{$A+}
/// internal low-level function to retrieve the cached current decoded date/time
procedure FromGlobalTime(out NewTime: TSynSystemTime; LocalTime: boolean;
tix64: Int64 = 0);
/// 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;
/// compute how many days there are in a given month
function DaysInMonth(Year, Month: cardinal): cardinal; overload;
/// compute how many days there are in the month of a given date
function DaysInMonth(Date: TDateTime): cardinal; overload;
/// retrieve the current local Date, in the ISO 8601 layout, but expanded and
// ready to be displayed
function NowToString(Expanded: boolean = true; FirstTimeChar: AnsiChar = ' ';
UtcDate: boolean = false): 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;
{$ifdef HASINLINE} inline; {$endif}
/// 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;
/// convert some "HTTP-date" format as defined by RFC 7231 into date/time
// - wrapper around TSynSystemTime.FromHttpDate() conversion algorithm
function HttpDateToDateTimeBuffer(httpdate: PUtf8Char; var datetime: TDateTime;
tolocaltime: boolean = false): boolean;
/// convert some "HTTP-date" format as defined by RFC 7231 into UTC date/time
function HttpDateToUnixTime(const httpdate: RawUtf8): TUnixTime;
/// convert some "HTTP-date" format as defined by RFC 7231 into UTC date/time
function HttpDateToUnixTimeBuffer(httpdate: PUtf8Char): TUnixTime;
type
THttpDateNowUtc = string[39];
/// returns the current UTC timestamp as the full 'Date' HTTP header line
// - e.g. as 'Date: Tue, 15 Nov 1994 12:45:26 GMT'#13#10
// - returns as a 40-bytes shortstring to avoid a memory allocation by caller
// - use an internal cache for every second refresh
function HttpDateNowUtc: THttpDateNowUtc;
/// returns the a specified UTC timestamp in HTTP-like format
// - e.g. as 'Tue, 15 Nov 1994 12:45:26 GMT'
function UnixMSTimeUtcToHttpDate(UnixMSTime: TUnixMSTime): TShort31;
/// 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)
{$ifdef USERECORDWITHMETHODS}
TTimeLogBits = record
{$else}
TTimeLogBits = object
{$endif USERECORDWITHMETHODS}
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;
{$ifdef HASINLINE} inline; {$endif}
/// append a TDateTime value, expanded as Iso-8601 text with milliseconds
// and a specified 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, expanded as Iso-8601 encoded text
// - use 'YYYY-MM-DDThh:mm:ss' format with '.sss' optional milliseconds
// - you may set LocalTime=TRUE to write the local date and time instead
// - this method will add the supplied TZD and ignore twoDateTimeWithZ flag
procedure AddCurrentIsoDateTime(LocalTime, WithMS: boolean;
FirstTimeChar: AnsiChar = 'T'; const TZD: RawUtf8 = '');
/// append the current UTC date and time, in apache-like format
// - e.g. append '19/Feb/2019:06:18:55 +0000' - with a space before the TZD
// - you may set LocalTime=TRUE to write the local date and time instead
procedure AddCurrentNcsaLogTime(LocalTime: boolean; const TZD: RawUtf8 = '+0000');
/// append the current UTC date and time, in our HTTP format
// - e.g. append '19/Feb/2019:06:18:55 GMT' - with a space before the TZD
// - you may set LocalTime=TRUE to write the local date and time instead
procedure AddCurrentHttpTime(LocalTime: boolean; const TZD: RawUtf8 = 'GMT');
/// append the current UTC date and time, in our TSynLog human-friendly format
// - e.g. append '20110325 19241502' - with no trailing space nor TZD
// - you may set LocalTime=TRUE to write the local date and time instead
procedure AddCurrentLogTime(LocalTime: boolean);
/// append a time period as "seconds.milliseconds" content
procedure AddSeconds(MilliSeconds: QWord; Quote: AnsiChar = #0);
end;
{ ******************* TValuePUtf8Char text value wrapper record }
type
/// points to one value of raw UTF-8 content, decoded from a JSON buffer
// - used e.g. by JsonDecode() overloaded function to returns names/values
{$ifdef USERECORDWITHMETHODS}
TValuePUtf8Char = record
{$else}
TValuePUtf8Char = object
{$endif USERECORDWITHMETHODS}
public
/// a pointer to the actual UTF-8 text
Text: PUtf8Char;
/// how many UTF-8 bytes are stored in Value
Len: PtrInt;
/// convert the value into a UTF-8 string
procedure ToUtf8(var Value: RawUtf8); overload;
{$ifdef HASINLINE}inline;{$endif}
/// convert the value into a UTF-8 string
function ToUtf8: RawUtf8; overload;
{$ifdef HASINLINE}inline;{$endif}
/// convert the value into a RTL string
function ToString: string;
{$ifdef HASINLINE}inline;{$endif}
/// convert the value into a signed integer
function ToInteger: PtrInt;
{$ifdef HASINLINE}inline;{$endif}
/// convert the value into an unsigned integer
function ToCardinal: PtrUInt; overload;
{$ifdef HASINLINE}inline;{$endif}
/// convert the value into an unsigned integer
function ToCardinal(Def: PtrUInt): PtrUInt; overload;
{$ifdef HASINLINE}inline;{$endif}
/// convert the value into a 64-bit signed integer
function ToInt64: Int64;
{$ifdef HASINLINE}inline;{$endif}
/// returns true if Value is either '1' or 'true'
function ToBoolean: boolean;
/// convert the value into a floating point number
function ToDouble: double;
{$ifdef HASINLINE}inline;{$endif}
/// convert the ISO-8601 text value as TDateTime
// - could have been written e.g. by DateTimeToIso8601Text()
function Iso8601ToDateTime: TDateTime;
{$ifdef HASINLINE}inline;{$endif}
/// will call IdemPropNameU() over the stored text Value
function Idem(const Value: RawUtf8): boolean;
{$ifdef HASSAFEINLINE}inline;{$endif}
end;
PValuePUtf8Char = ^TValuePUtf8Char;
/// used e.g. by JsonDecode() overloaded function to returns values
TValuePUtf8CharArray =
array[0 .. maxInt div SizeOf(TValuePUtf8Char) - 1] of TValuePUtf8Char;
PValuePUtf8CharArray = ^TValuePUtf8CharArray;
TValuePUtf8CharDynArray = array of TValuePUtf8Char;
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-});
unaligned(result) := (146097 * d100.d) shr 2 + (1461 * d100.m) shr 2 +
(153 * M + 2) div 5 + D;
unaligned(result) := unaligned(result) - 693900; // avoid sign issue
if L < 15 then
exit; // not enough space to retrieve the time
end;
H := ord(P[9]) * 10 + ord(P[10]) - (48 + 480);
if P[11] = ':' then
begin
inc(P);
dec(L);
end; // allow hh:mm:ss
MI := ord(P[11]) * 10 + ord(P[12]) - (48 + 480);
if P[13] = ':' then
begin
inc(P);
dec(L);
end; // allow hh:mm:ss
SS := ord(P[13]) * 10 + ord(P[14]) - (48 + 480);
if (L > 16) and
(P[15] = '.') then
begin
// one or more digits representing a decimal fraction of a second
MS := ord(P[16]) * 100 - 4800;
if L > 17 then
MS := MS {%H-}+ byte(P[17]) * 10 - 480;
if L > 18 then
MS := MS + byte(P[18]) - 48;
if MS > 1000 then
MS := 0;
end
else
MS := 0;
if (H < 24) and
(MI < 60) and
(SS < 60) then // inlined EncodeTime()
result := result + (H * (MinsPerHour * SecsPerMin * MSecsPerSec) +
MI * (SecsPerMin * MSecsPerSec) + SS * MSecsPerSec + MS) / MSecsPerDay;
end;
function Iso8601CheckAndDecode(P: PUtf8Char; L: integer;
var Value: TDateTime): boolean;
// handle 'YYYY-MM-DDThh:mm:ss[.sss]' or 'YYYY-MM-DD' or 'Thh:mm:ss[.sss]'
begin
if P = nil then
result := false
else if (((L = 9) or (L = 13)) and
(P[0] = 'T') and (P[3] = ':')) or // 'Thh:mm:ss[.sss]'
((L = 10) and
(P[4] = '-') and (P[7] = '-')) or // 'YYYY-MM-DD'
(((L = 19) or (L = 23)) and
(P[4] = '-') and (P[10] = 'T')) then
begin
Iso8601ToDateTimePUtf8CharVar(P, L, Value);
result := PInt64(@Value)^ <> 0;
end
else
result := false;
end;
function IsIso8601(P: PUtf8Char; L: integer): boolean;
begin
result := Iso8601ToTimeLogPUtf8Char(P, L) <> 0;
end;
function Iso8601ToTimePUtf8Char(P: PUtf8Char; L: integer): TDateTime;
begin
Iso8601ToTimePUtf8CharVar(P, L, result);
end;
procedure Iso8601ToTimePUtf8CharVar(P: PUtf8Char; L: integer;
var result: TDateTime);
var
H, MI, SS, MS: cardinal;
begin
if Iso8601ToTimePUtf8Char(P, L, H, MI, SS, MS) then
result := (H * (MinsPerHour * SecsPerMin * MSecsPerSec) +
MI * (SecsPerMin * MSecsPerSec) + SS * MSecsPerSec + MS) / MSecsPerDay
else
result := 0;
end;
function Iso8601ToTimePUtf8Char(P: PUtf8Char; L: integer;
var H, M, S, MS: cardinal): boolean;
begin
result := false; // error
if P = nil then
exit;
if L = 0 then
L := StrLen(P);
if L < 6 then
exit; // we need 'hhmmss' at least
H := ord(P[0]) * 10 + ord(P[1]) - (48 + 480);
if P[2] = ':' then
begin
inc(P);
dec(L);
end; // allow hh:mm:ss
M := ord(P[2]) * 10 + ord(P[3]) - (48 + 480);
if P[4] = ':' then
begin
inc(P);
dec(L);
end; // allow hh:mm:ss
S := ord(P[4]) * 10 + ord(P[5]) - (48 + 480);
if (L > 6) and
(P[6] = '.') then
begin
// one or more digits representing a decimal fraction of a second
MS := ord(P[7]) * 100 - 4800;
if L > 7 then
MS := MS {%H-}+ ord(P[8]) * 10 - 480;
if L > 8 then
MS := MS + ord(P[9]) - 48;
end
else
MS := 0;
if (H < 24) and
(M < 60) and
(S < 60) and
(MS < 1000) then
result := true;
end;
function Iso8601ToDatePUtf8Char(P: PUtf8Char; L: integer;
var Y, M, D: cardinal): boolean;
begin
result := false; // error
if P = nil then
exit;
if L = 0 then
L := StrLen(P);
if (L < 8) or
not (P[0] in ['0'..'9']) or
not (P[1] in ['0'..'9']) or
not (P[2] in ['0'..'9']) or
not (P[3] in ['0'..'9']) then
exit; // we need 'YYYYMMDD' at least
Y := ord(P[0]) * 1000 + ord(P[1]) * 100 + ord(P[2]) * 10 +
ord(P[3]) - (48 + 480 + 4800 + 48000);
if (Y < 1000) or
(Y > 2999) then
exit;
if P[4] in ['-', '/'] then
inc(P); // allow YYYY-MM-DD
M := ord(P[4]) * 10 + ord(P[5]) - (48 + 480);
if (M = 0) or
(M > 12) then
exit;
if P[6] in ['-', '/'] then
inc(P);
D := ord(P[6]) * 10 + ord(P[7]) - (48 + 480);
if (D <> 0) and
(D <= MonthDays[true][M]) then
// worse day number to allow is for leapyear=true
result := true;
end;
function IntervalTextToDateTime(Text: PUtf8Char): TDateTime;
begin
IntervalTextToDateTimeVar(Text, result);
end;
procedure IntervalTextToDateTimeVar(Text: PUtf8Char;
var result: TDateTime);
var
negative: boolean;
Time: TDateTime;
begin
// e.g. IntervalTextToDateTime('+0 06:03:20')
result := 0;
if Text = nil then
exit;
if Text^ in ['+', '-'] then
begin
negative := (Text^ = '-');
result := GetNextItemDouble(Text, ' ');
end
else
negative := false;
Iso8601ToTimePUtf8CharVar(Text, 0, Time);
if negative then
result := result - Time
else
result := result + Time;
end;
{$ifndef CPUX86NOTPIC}
procedure YearToPChar2(tab: PWordArray; Y: PtrUInt; P: PUtf8Char); inline;
var
d100: TDiv100Rec;
begin
Div100(Y, d100{%H-});
PWordArray(P)[0] := tab[d100.D];
PWordArray(P)[1] := tab[d100.M];
end;
{$endif CPUX86NOTPIC}
function DateToIso8601PChar(P: PUtf8Char; Expanded: boolean;
Y, M, D: PtrUInt): PUtf8Char;
// use 'YYYYMMDD' format if not Expanded, 'YYYY-MM-DD' format if Expanded
var
{$ifdef CPUX86NOTPIC}
tab: TWordArray absolute TwoDigitLookupW;
{$else}
tab: PWordArray;
{$endif CPUX86NOTPIC}
begin
{$ifdef CPUX86NOTPIC}
YearToPChar(Y, P);
{$else}
tab := @TwoDigitLookupW;
YearToPChar2(tab, Y, P);
{$endif CPUX86NOTPIC}
inc(P, 4);
if Expanded then
begin
P^ := '-';
inc(P);
end;
PWord(P)^ := tab[M];
inc(P, 2);
if Expanded then
begin
P^ := '-';
inc(P);
end;
PWord(P)^ := tab[D];
result := P + 2;
end;
function TimeToIso8601PChar(P: PUtf8Char; Expanded: boolean;
H, M, S, MS: PtrUInt; FirstChar: AnsiChar; WithMS: boolean): PUtf8Char;
var
{$ifdef CPUX86NOTPIC}
tab: TWordArray absolute TwoDigitLookupW;
{$else}
tab: PWordArray;
{$endif CPUX86NOTPIC}
begin
// use Thhmmss[.sss] format
if FirstChar <> #0 then
begin
P^ := FirstChar;
inc(P);
end;
{$ifndef CPUX86NOTPIC}
tab := @TwoDigitLookupW;
{$endif CPUX86NOTPIC}
PWord(P)^ := tab[H];
inc(P, 2);
if Expanded then
begin
P^ := ':';
inc(P);
end;
PWord(P)^ := tab[M];
inc(P, 2);
if Expanded then
begin
P^ := ':';
inc(P);
end;
PWord(P)^ := tab[S];
inc(P, 2);
if WithMS then
begin
{$ifdef CPUX86NOTPIC}
YearToPChar(MS, P);
{$else}
YearToPChar2(tab, MS, P);
{$endif CPUX86NOTPIC}
P^ := '.'; // override first digit
inc(P, 4);
end;
result := P;
end;
function DateToIso8601PChar(Date: TDateTime; P: PUtf8Char;
Expanded: boolean): PUtf8Char;
var
T: TSynSystemTime;
begin
// use YYYYMMDD / YYYY-MM-DD date format
T.FromDate(Date);
result := DateToIso8601PChar(P, Expanded, T.Year, T.Month, T.Day);
end;
function DateToIso8601Text(Date: TDateTime): RawUtf8;
begin
// into 'YYYY-MM-DD' date format
if Date = 0 then
result := ''
else
begin
FastSetString(result, 10);
DateToIso8601PChar(Date, pointer(result), True);
end;
end;
function TimeToIso8601PChar(Time: TDateTime; P: PUtf8Char; Expanded: boolean;
FirstChar: AnsiChar; WithMS: boolean): PUtf8Char;
var
T: TSynSystemTime;
begin
T.FromTime(Time);
result := TimeToIso8601PChar(P, Expanded, T.Hour, T.Minute, T.Second,
T.MilliSecond, FirstChar, WithMS);
end;
function DateTimeToIso8601(P: PUtf8Char; D: TDateTime; Expanded: boolean;
FirstChar: AnsiChar; WithMS: boolean; QuotedChar: AnsiChar): integer;
var
S: PUtf8Char;
begin
S := P;
if QuotedChar <> #0 then
begin
P^ := QuotedChar;
inc(P);
end;
P := DateToIso8601PChar(D, P, Expanded);
P := TimeToIso8601PChar(D, P, Expanded, FirstChar, WithMS);
if QuotedChar <> #0 then
begin
P^ := QuotedChar;
inc(P);
end;
result := P - S;
end;
function DateTimeToIso8601(D: TDateTime; Expanded: boolean;
FirstChar: AnsiChar; WithMS: boolean; QuotedChar: AnsiChar): RawUtf8;
begin
DateTimeToIso8601Var(D, Expanded, WithMS, FirstChar, QuotedChar, result);
end;
procedure DateTimeToIso8601Var(D: TDateTime; Expanded, WithMS: boolean;
FirstChar, QuotedChar: AnsiChar; var Result: RawUtf8);
var
tmp: array[0 .. 31] of AnsiChar;
begin
// D=0 is handled in DateTimeToIso8601Text()
FastSetString(result, @tmp,
DateTimeToIso8601(@tmp, D, Expanded, FirstChar, WithMS, QuotedChar));
end;
function DateTimeToIso8601Short(D: TDateTime; Expanded, WithMS: boolean;
FirstChar, QuotedChar: AnsiChar): TShort31;
begin
if D = 0 then
result[0] := #0
else
result[0] := AnsiChar(DateTimeToIso8601(
@result[1], D, Expanded, FirstChar, WithMS, QuotedChar));
end;
function DateToIso8601(Date: TDateTime; Expanded: boolean): RawUtf8;
// use YYYYMMDD / YYYY-MM-DD date format
begin
FastSetString(result, 8 + 2 * integer(Expanded));
DateToIso8601PChar(Date, pointer(result), Expanded);
end;
function DateToIso8601(Y, M, D: cardinal; Expanded: boolean): RawUtf8;
// use 'YYYYMMDD' format if not Expanded, 'YYYY-MM-DD' format if Expanded
begin
FastSetString(result, 8 + 2 * integer(Expanded));
DateToIso8601PChar(pointer(result), Expanded, Y, M, D);
end;
function TimeToIso8601(Time: TDateTime; Expanded: boolean;
FirstChar: AnsiChar; WithMS: boolean): RawUtf8;
// use Thhmmss[.sss] / Thh:mm:ss[.sss] format
begin
FastSetString(result, 7 + 2 * integer(Expanded) + 4 * integer(WithMS));
TimeToIso8601PChar(Time, pointer(result), Expanded, FirstChar, WithMS);
end;
function DaysToIso8601(Days: cardinal; Expanded: boolean): RawUtf8;
var
Y, M: cardinal;
begin
Y := 0;
while Days > 365 do
begin
dec(Days, 366);
inc(Y);
end;
M := 0;
if Days > 31 then
begin
inc(M); // years as increment, not absolute: always 365 days with no leap
while Days > MonthDays[false][M] do
begin
dec(Days, MonthDays[false][M]);
inc(M);
end;
end;
result := DateToIso8601(Y, M, Days, Expanded);
end;
function DateTimeToIso8601Text(DT: TDateTime; FirstChar: AnsiChar;
WithMS: boolean): RawUtf8;
begin
DateTimeToIso8601TextVar(DT, FirstChar, result, WithMS);
end;
procedure DateTimeToIso8601TextVar(DT: TDateTime; FirstChar: AnsiChar;
var result: RawUtf8; WithMS: boolean);
begin
if DT = 0 then
result := ''
else if frac(DT) = 0 then
result := DateToIso8601(DT, true)
else if trunc(DT) = 0 then
result := TimeToIso8601(DT, true, FirstChar, WithMS)
else
result := DateTimeToIso8601(DT, true, FirstChar, WithMS);
end;
procedure DateTimeToIso8601StringVar(DT: TDateTime; FirstChar: AnsiChar;
var result: string; WithMS: boolean);
var
tmp: RawUtf8;
begin
DateTimeToIso8601TextVar(DT, FirstChar, tmp, WithMS);
Ansi7ToString(Pointer(tmp), length(tmp), result);
end;
function DateTimeToIso8601ExpandedPChar(const Value: TDateTime; Dest: PUtf8Char;
FirstChar: AnsiChar; WithMS: boolean): PUtf8Char;
begin
if Value <> 0 then
begin
if trunc(Value) <> 0 then
Dest := DateToIso8601PChar(Value, Dest, true);
if frac(Value) <> 0 then
Dest := TimeToIso8601PChar(Value, Dest, true, FirstChar, WithMS);
end;
Dest^ := #0;
result := Dest;
end;
function VariantToDateTime2(const V: Variant; var Value: TDateTime): boolean;
var
tmp: RawUtf8; // sub-procedure to void hidden try..finally
begin
VariantToUtf8(V, tmp);
Iso8601ToDateTimePUtf8CharVar(pointer(tmp), length(tmp), Value);
result := Value <> 0;
end;
function VariantToDateTime(const V: Variant; var Value: TDateTime): boolean;
var
vd: TVarData;
vt: cardinal;
begin
vt := TVarData(V).VType;
if vt = varVariantByRef then
result := VariantToDateTime(PVariant(TVarData(V).VPointer)^, Value)
else
begin
result := true;
case vt of
varEmpty,
varNull:
Value := 0;
varDouble,
varDate:
Value := TVarData(V).VDouble;
varSingle:
Value := TVarData(V).VSingle;
varCurrency:
Value := TVarData(V).VCurrency;
{$ifdef OSWINDOWS}
varOleFileTime:
Value := FileTimeToDateTime(PFileTime(@TVarData(V).VInt64)^);
{$endif OSWINDOWS}
varString:
with TVarData(V) do
begin
Iso8601ToDateTimePUtf8CharVar(VString, length(RawUtf8(VString)), Value);
result := Value <> 0;
end;
else
if SetVariantUnRefSimpleValue(V, vd{%H-}) then
result := VariantToDateTime(variant(vd), Value)
else
result := VariantToDateTime2(V, Value);
end;
end;
end;
const
_TZs: PAnsiChar = // fast brute force search in L1 cache
#3'GMT'#4'NZDT'#1'M'#4'IDLE'#4'NZST'#3'NZT'#4'EADT'#3'GST'#3'JST'#3'CCT' +
#4'WADT'#4'WAST'#3'ZP6'#3'ZP5'#3'ZP4'#2'BT'#3'EET'#4'MEST'#4'MESZ'#3'SST' +
#3'FST'#4'CEST'#3'CET'#3'FWT'#3'MET'#4'MEWT'#3'SWT'#2'UT'#3'UTC'#1'Z' +
#3'WET'#1'A'#3'WAT'#3'BST'#2'AT'#3'ADT'#3'AST'#3'EDT'#3'EST' +
#3'CDT'#3'CST'#3'MDT'#3'MST'#3'PDT'#3'PST'#3'YDT'#3'YST'#3'HDT' +
#4'AHST'#3'CAT'#3'HST'#4'EAST'#2'NT'#4'IDLW'#1'Y';
_TZv: array[0..54] of ShortInt = (
0, 13, 12, 12, 12, 12, 11, 10, 9, 8,
8, 7, 6, 5, 4, 3, 2, 2, 2, 2,
2, 2, 1, 1, 1, 1, 1, 0, 0, 0,
0, -1, -1, -1, -2, -3, -4, -4, -5,
-5, -6, -6, -7, -7, -8, -8, -9, -9,
-10, -10, -10, -10, -11, -12, -12);
HTML_WEEK_DAYS: array[1..7] of string[3] = (
'Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat');
HTML_MONTH_NAMES: array[1..12] of string[3] = (
'Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun',
'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec');
HTML_MONTH_NAMES_32: array[0..11] of array[0..3] of AnsiChar = (
'JAN', 'FEB', 'MAR', 'APR', 'MAY', 'JUN',
'JUL', 'AUG', 'SEP', 'OCT', 'NOV', 'DEC');
function ParseTimeZone(var P: PUtf8Char; var Zone: integer): boolean;
var
z: integer;
S: PUtf8Char;
begin
result := false;
if P = nil then
exit;
P := GotoNextNotSpace(P);
S := P;
if PCardinal(S)^ and $ffffff = // most common case (always for HTTP dates)
ord('G') + ord('M') shl 8 + ord('T') shl 16 then
begin
P := GotoNextNotSpace(S + 3);
Zone := 0;
result := true;
end
else if (S^ = '+') or
(S^ = '-') then
begin
if not (S[1] in ['0'..'9']) or
not (S[2] in ['0'..'9']) or
not (S[3] in ['0'..'9']) or
not (S[4] in ['0'..'9']) then
exit;
if (S^ = '-') and
(PCardinal(S + 1)^ = $30303030) then // '-0000' for current local
Zone := TimeZoneLocalBias
else
begin
Zone := (ord(S[1]) * 10 + ord(S[2]) - (48 + 480)) * 60 +
(ord(S[3]) * 10 + ord(S[4]) - (48 + 480));
if P^ = '-' then
Zone := -Zone;
end;
P := GotoNextNotSpace(S + 5);
result := true;
end
else
begin
// TODO: enhance TSynTimeZone from mormot.core.search to parse timezones?
while (S^ in ['a'..'z', 'A'..'Z']) do
inc(S);
z := S - P;
if (z >= 1) and
(z <= 4) then
begin
z := FindShortStringListExact(@_TZs[0], high(_TZv), P, z);
if z >= 0 then
begin
Zone := integer(_TZv[z]) * 60;
P := GotoNextNotSpace(S);
result := true
end;
end;
end;
end;
function ParseTimeZone(const s: RawUtf8; var Zone: integer): boolean;
var
P: PUtf8Char;
begin
P := pointer(s);
result := ParseTimeZone(P, Zone) and
(GotoNextNotSpace(P)^ = #0);
end;
function ParseMonth(var P: PUtf8Char; var Month: word): boolean;
var
m: integer;
begin
result := false;
if P = nil then
exit;
P := GotoNextNotSpace(P);
m := PCardinal(P)^ and $dfdfdf;
if m and $00404040 <> $00404040 then // quick alphabetical guess
exit;
m := IntegerScanIndex(@HTML_MONTH_NAMES_32, 12, m);
if m < 0 then
exit;
Month := m + 1;
inc(P, 3);
if P^ = '-' then
inc(P) // e.g. '06-Nov-94'
else
P := GotoNextNotSpace(P);
result := true;
end;
function ParseMonth(const s: RawUtf8; var Month: word): boolean;
var
P: PUtf8Char;
begin
P := pointer(s);
result := ParseMonth(P, Month) and
(GotoNextNotSpace(P)^ = #0);
end;
var
AppendToTextFileSafe: TLightLock; // to make AppendToTextFile() thread-safe
function AppendToTextFile(const aLine: RawUtf8; const aFileName: TFileName;
aMaxSize: Int64; aUtcTimeStamp: boolean): boolean;
var
line: RawUtf8;
begin
result := false;
if (aFileName = '') or
(aLine = '') then
exit;
FormatUtf8(CRLF + '% %',
[NowToString(true, ' ', aUtcTimeStamp), TrimControlChars(aLine)], line);
AppendToTextFileSafe.Lock;
try
AppendToFile(line, aFileName, aMaxSize);
finally
AppendToTextFileSafe.UnLock;
end;
end;
var
LogToTextFileName: TFileName;
procedure LogToTextFile(Msg: RawUtf8);
begin
if Msg = '' then
begin
Msg := GetErrorText(GetLastError);
if Msg = '' then
exit;
end;
if LogToTextFileName = '' then
begin
AppendToTextFileSafe.Lock;
try
LogToTextFileName := ChangeFileExt(Executable.ProgramFileName, '.log');
if not IsDirectoryWritable(Executable.ProgramFilePath, [idwExcludeWinSys]) then
LogToTextFileName := GetSystemPath(spLog) + ExtractFileName(LogToTextFileName);
finally
AppendToTextFileSafe.UnLock;
end;
end;
AppendToTextFile(Msg, LogToTextFileName);
end;
{ ************ TSynDate / TSynDateTime / TSynSystemTime High-Level objects }
var
// GlobalTime[LocalTime] thread-safe cache
GlobalTime: array[boolean] of packed record
safe: TLightLock; // better than RCU
time: TSystemTime;
clock: cardinal; // avoid slower API call with 8-16ms loss of precision
_pad: array[1 .. 64 - SizeOf(TLightLock) - SizeOf(TSystemTime) - 4] of byte;
end;
procedure FromGlobalTime(out NewTime: TSynSystemTime; LocalTime: boolean;
tix64: Int64);
var
tix: cardinal;
newtimesys: TSystemTime absolute NewTime;
begin
if tix64 = 0 then
tix64 := GetTickCount64;
tix := tix64 shr 4;
with GlobalTime[LocalTime] do
if clock <> tix then // recompute every 16 ms
begin
clock := tix;
NewTime.Clear;
if LocalTime then
GetLocalTime(newtimesys)
else
GetSystemTime(newtimesys);
{$ifdef OSPOSIX}
// two TSystemTime fields are inverted in FPC datih.inc :(
tix := newtimesys.DayOfWeek;
NewTime.Day := newtimesys.Day;
NewTime.DayOfWeek := tix;
{$endif OSPOSIX}
safe.Lock;
time := newtimesys;
safe.UnLock;
end
else
begin
safe.Lock;
newtimesys := time;
safe.UnLock;
end;
end;
{ TSynDate }
procedure TSynDate.Clear;
begin
PInt64(@self)^ := 0;
end;
procedure TSynDate.SetMax;
begin
PInt64(@self)^ := $001F0000000C270F; // 9999 + 12 shl 16 + 31 shl 48
end;
function TSynDate.IsZero: boolean;
begin
result := PInt64(@self)^ = 0;
end;
function TSynDate.ParseFromText(var P: PUtf8Char): boolean;
var
L: PtrInt;
Y, M, D: cardinal;
begin
result := false;
if P = nil then
exit;
while P^ in [#9, ' '] do
inc(P);
L := 0;
while P[L] in ['0'..'9', '-', '/'] do
inc(L);
if not Iso8601ToDatePUtf8Char(P, L, Y, M, D) then
exit;
Year := Y;
Month := M;
DayOfWeek := 0;
Day := D;
inc(P, L); // move P^ just after the date
result := true;
end;
procedure TSynDate.FromNow(localtime: boolean);
var
dt: TSynSystemTime;
begin
FromGlobalTime(dt, localtime);
self := PSynDate(@dt)^; // 4 first fields of TSynSystemTime do match
end;
procedure TSynDate.FromDate(date: TDate);
var
dt: TSynSystemTime;
begin
dt.FromDate(date); // faster than RTL DecodeDate()
self := PSynDate(@dt)^;
end;
function TSynDate.IsEqual(const another: TSynDate): boolean;
begin
result := (PCardinal(@Year)^ = PCardinal(@TSynDate(another).Year)^) and
(Day = TSynDate(another).Day);
end;
function TSynDate.Compare(const another: TSynDate): integer;
begin
result := Year - TSynDate(another).Year;
if result = 0 then
begin
result := Month - TSynDate(another).Month;
if result = 0 then
result := Day - TSynDate(another).Day;
end;
end;
procedure TSynDate.ComputeDayOfWeek;
var
d: TDateTime;
i: PtrInt;
begin
if not mormot.core.datetime.TryEncodeDate(Year, Month, Day, d) then
begin
DayOfWeek := 0;
exit;
end;
i := ((trunc(d) - 1) mod 7) + 1; // sunday is day 1
if i <= 0 then
DayOfWeek := i + 7
else
DayOfWeek := i;
end;
function TSynDate.ToDate: TDate;
begin
if not mormot.core.datetime.TryEncodeDate(Year, Month, Day, PDateTime(@result)^) then
result := 0;
end;
function TSynDate.ToText(Expanded: boolean): RawUtf8;
begin
if PInt64(@self)^ = 0 then
result := ''
else
result := DateToIso8601(Year, Month, Day, Expanded);
end;
function IsLeapYear(Year: cardinal): boolean;
var
d100: TDiv100Rec;
begin
if Year and 3 = 0 then
begin
Div100(Year, d100{%H-});
result := ((d100.M <> 0) or // (Year mod 100 > 0)
(Year - ((d100.D shr 2) * 400) = 0)); // (Year mod 400 = 0))
end
else
result := false;
end;
function DaysInMonth(Year, Month: cardinal): cardinal;
begin
result := MonthDays[IsLeapYear(Year)][Month];
end;
function DaysInMonth(Date: TDateTime): cardinal;
var
dt: TSynSystemTime;
begin
dt.FromDate(Date); // faster than RTL DecodeDate()
result := dt.DaysInMonth;
end;
{ TSynSystemTime }
function TSynSystemTime.DaysInMonth: cardinal;
begin
result := MonthDays[IsLeapYear(Year)][Month];
end;
function TryEncodeDayOfWeekInMonth(
AYear, AMonth, ANthDayOfWeek, ADayOfWeek: integer;
out AValue: TDateTime): boolean;
var
LStartOfMonth, LDay: integer;
begin
// adapted from DateUtils
result := mormot.core.datetime.TryEncodeDate(AYear, AMonth, 1, AValue);
if not result then
exit;
LStartOfMonth := (DateTimeToTimestamp(AValue).date - 1) mod 7 + 1;
if LStartOfMonth <= ADayOfWeek then
dec(ANthDayOfWeek);
LDay := (ADayOfWeek - LStartOfMonth + 1) + 7 * ANthDayOfWeek;
result := mormot.core.datetime.TryEncodeDate(AYear, AMonth, LDay, AValue);
end;
function TSynSystemTime.EncodeForTimeChange(const aYear: word): TDateTime;
var
dow, d: word;
begin
if DayOfWeek = 0 then
dow := 7 // Delphi/FPC Sunday = 7
else
dow := DayOfWeek;
// Encoding the day of change
d := Day;
while not TryEncodeDayOfWeekInMonth(aYear, Month, d, dow, result) do
begin
// if Day = 5 then try it and if needed decrement to find the last
// Occurrence of the day in this month
if d = 0 then
begin
TryEncodeDayOfWeekInMonth(aYear, Month, 1, 7, result);
break;
end;
dec(d);
end;
// finally add the time when change is due
result := result + EncodeTime(Hour, Minute, Second, MilliSecond);
end;
procedure TSynSystemTime.Clear;
begin
PInt64Array(@self)[0] := 0;
PInt64Array(@self)[1] := 0;
end;
function TSynSystemTime.IsZero: boolean;
begin
result := (PInt64Array(@self)[0] = 0) and
(PInt64Array(@self)[1] = 0);
end;
function TSynSystemTime.IsEqual(const another: TSynSystemTime): boolean;
begin
result := (PInt64Array(@self)[0] = PInt64Array(@another)[0]) and
(PInt64Array(@self)[1] = PInt64Array(@another)[1]);
end;
function TSynSystemTime.IsDateEqual(const date: TSynDate): boolean;
begin
result := (PCardinal(@Year)^ = PCardinal(@TSynDate(date).Year)^) and // +Month
(Day = TSynDate(date).Day);
end;
procedure TSynSystemTime.FromNowUtc;
begin
FromGlobalTime(self, {local=}false);
end;
procedure TSynSystemTime.FromNowLocal;
begin
FromGlobalTime(self, {local=}true);
end;
procedure TSynSystemTime.FromNow(localtime: boolean);
begin
FromGlobalTime(self, localtime);
end;
procedure TSynSystemTime.FromDateTime(const dt: TDateTime);
begin
FromDate(dt);
FromTime(dt);
end;
procedure TSynSystemTime.FromUnixTime(ut: TUnixTime);
begin
FromDateTime(ut / SecsPerDay + UnixDateDelta); // via a temp TDateTime
end;
procedure TSynSystemTime.FromUnixMsTime(ut: TUnixMsTime);
begin
FromDateTime(ut / MSecsPerDay + UnixDateDelta); // via a temp TDateTime
end;
procedure TSynSystemTime.FromDate(const dt: TDateTime);
var
t, t2, t3: PtrUInt;
begin
t := Trunc(dt);
t := (t + 693900) * 4 - 1;
if PtrInt(t) >= 0 then
begin
t3 := t div 146097;
t2 := (t - t3 * 146097) and not 3;
t := PtrUInt(t2 + 3) div 1461; // PtrUInt() needed for FPC i386
Year := t3 * 100 + t;
t2 := ((t2 + 7 - t * 1461) shr 2) * 5;
t3 := PtrUInt(t2 - 3) div 153;
Day := PtrUInt(t2 + 2 - t3 * 153) div 5;
if t3 < 10 then
inc(t3, 3)
else
begin
dec(t3, 9);
inc(Year);
end;
Month := t3;
DayOfWeek := 0; // not set by default
end
else
PInt64(@Year)^ := 0;
end;
procedure TSynSystemTime.FromTime(const dt: TDateTime);
begin
FromMS(QWord(round(abs(dt) * MSecsPerDay)) mod MSecsPerDay);
end;
procedure TSynSystemTime.FromMS(ms: PtrUInt);
var
t: PtrUInt;
begin
t := ms div 3600000;
Hour := t;
dec(ms, t * 3600000);
t := ms div 60000;
Minute := t;
dec(ms, t * 60000);
t := ms div 1000;
Second := t;
dec(ms, t * 1000);
MilliSecond := ms;
end;
procedure TSynSystemTime.FromSec(s: PtrUInt);
var
t: PtrUInt;
begin
t := s div 3600;
Hour := t;
dec(s, t * 3600);
t := s div 60;
Minute := t;
dec(s, t * 60);
Second := s;
MilliSecond := 0;
end;
function TSynSystemTime.FromText(const iso: RawUtf8): boolean;
var
t: TTimeLogBits;
begin
t.From(iso);
if t.Value = 0 then
result := false
else
begin
t.Expand(self); // TTimeLogBits is faster than FromDateTime()
result := true;
end;
end;
function TSynSystemTime.FromHttpDateBuffer(
P: PUtf8Char; tolocaltime: boolean): boolean;
var
pnt: byte;
hasday: boolean;
S: PUtf8Char;
zone: integer;
v, H, MI, SS, MS: cardinal;
dt, t: TDateTime;
begin
// Sun, 06 Nov 1994 08:49:37 GMT ; RFC 822, updated by RFC 1123
// Sunday, 06-Nov-94 08:49:37 GMT ; RFC 850, obsoleted by RFC 1036
// Sun Nov 6 08:49:37 1994 ; ANSI C's asctime() Format
Clear;
hasday := false;
zone := maxInt; // invalid
result := false;
if P = nil then
exit;
repeat
P := GotoNextNotSpace(P);
case P^ of
'A'..'Z',
'a'..'z':
if (not hasday) or
(not ParseMonth(P, Month)) then
begin
hasday := true; // first alphabetic word is always the week day text
P := GotoNextSpace(P); // also ignore trailing '-'
end;
'0'..'9':
begin
// e.g. '1994' '08:49:37 GMT' or '6'
pnt := 0;
S := P;
repeat
inc(P);
case P^ of
'0'..'9':
;
':':
begin
inc(pnt);
if pnt = 0 then
exit;
end;
'.':
if pnt < 2 then
break;
else
break;
end;
until false;
case pnt of
0:
// e.g. '6', '94' or '2014'
begin
v := GetCardinal(S);
if v <> 0 then
begin
if (v < 32) and
(Day = 0) then
Day := v
else if (Year = 0) and
(v <= 9999) and
((v > 12) or
(Month > 0)) then
begin
if v < 32 then
inc(v, 2000)
else if v < 1000 then
inc(v, 1900);
Year := v;
end;
end;
end;
2:
// e.g. '08:49:37 GMT'
if Iso8601ToTimePUtf8Char(S, P - S, H, MI, SS, MS) then
begin
Hour := H;
Minute := MI;
Second := SS;
MilliSecond := MS;
zone := 0; // GMT by default
ParseTimeZone(P, zone);
end;
end;
if P^ = '-' then
inc(P); // e.g. '06-Nov-94'
end;
else
P := GotoNextSpace(P);
end;
until P^ in [#0, #10, #13]; // end of string or end of line (e.g. HTTP header)
if (Year = 0) or
(zone = maxInt) or
(Month = 0) then
exit;
if Day = 0 then
Day := 1 // assume first of the month if none supplied
else
begin
v := DaysInMonth;
if Day > v then
Day := v; // assume last of the month if too big supplied
end;
if tolocaltime or
(zone <> 0) then
begin
// need to apply some time zone shift
if tolocaltime then
dec(zone, TimeZoneLocalBias);
dt := ToDateTime - zone div MinsPerDay;
v := abs(zone mod MinsPerDay);
t := EncodeTime(v div 60, v mod 60, 0, 0);
if zone < 0 then
dt := dt + t
else
dt := dt - t;
FromDateTime(dt); // local TDateTime to compute time shift
end;
result := true;
end;
function TSynSystemTime.FromHttpDate(const httpdate: RawUtf8;
tolocaltime: boolean): boolean;
begin
result := (length(httpdate) >= 12) and
FromHttpDateBuffer(pointer(httpdate), tolocaltime);
end;
function TSynSystemTime.ToText(Expanded: boolean; FirstTimeChar: AnsiChar;
const TZD: RawUtf8): RawUtf8;
begin
result := DateTimeMSToString(Hour, Minute, Second, MilliSecond,
Year, Month, Day, Expanded, FirstTimeChar, TZD);
end;
procedure TSynSystemTime.AddIsoDate(WR: TTextWriter);
var
p: PUtf8Char;
begin
if WR.BEnd - WR.B <= 24 then
WR.FlushToStream;
p := WR.B + 1;
inc(WR.B, DateToIso8601PChar(p, {expanded=}true, Year, Month, Day) - p);
end;
procedure TSynSystemTime.AddIsoDateTime(WR: TTextWriter;
WithMS: boolean; FirstTimeChar: AnsiChar; const TZD: RawUtf8);
var
p: PUtf8Char;
begin
if WR.BEnd - WR.B <= 24 then
WR.FlushToStream;
p := WR.B + 1;
inc(WR.B, TimeToIso8601PChar(DateToIso8601PChar(p, true, Year, Month, Day),
true, Hour, Minute, Second, MilliSecond, FirstTimeChar, WithMS) - p);
if TZD <> '' then
WR.AddString(TZD);
end;
procedure TSynSystemTime.AddLogTime(WR: TTextWriter);
var
d100: TDiv100Rec;
p: PUtf8Char;
{$ifdef CPUX86NOTPIC}
tab: TWordArray absolute TwoDigitLookupW;
{$else}
tab: PWordArray;
{$endif CPUX86NOTPIC}
begin
if WR.BEnd - WR.B <= 18 then
WR.FlushToStream;
p := WR.B + 1;
{$ifndef CPUX86NOTPIC}
tab := @TwoDigitLookupW;
{$endif CPUX86NOTPIC}
Div100(Year, d100{%H-});
PWord(p)^ := tab[d100.D];
PWord(p + 2)^ := tab[d100.M];
PWord(p + 4)^ := tab[PtrUInt(Month)];
PWord(p + 6)^ := tab[PtrUInt(Day)];
p[8] := ' ';
PWord(p + 9)^ := tab[PtrUInt(Hour)];
PWord(p + 11)^ := tab[PtrUInt(Minute)];
PWord(p + 13)^ := tab[PtrUInt(Second)];
PWord(p + 15)^ := tab[PtrUInt(Millisecond) shr 4];
inc(WR.B, 17);
end;
procedure TSynSystemTime.AddNcsaText(WR: TTextWriter; const TZD: RawUtf8);
begin
if WR.BEnd - WR.B <= 21 then
WR.FlushToStream;
inc(WR.B, ToNcsaText(WR.B + 1));
if TZD <> '' then
WR.AddString(TZD);
end;
procedure TSynSystemTime.AddHttpDate(WR: TTextWriter; const TZD: RawUtf8);
var
tmp: shortstring;
begin
ToHttpDateShort(tmp, TZD);
WR.AddShort(tmp);
end;
function TSynSystemTime.ToNcsaText(P: PUtf8Char): PtrInt;
var
y, d100: PtrUInt;
{$ifdef CPUX86NOTPIC}
tab: TWordArray absolute TwoDigitLookupW;
{$else}
tab: PWordArray;
{$endif CPUX86NOTPIC}
begin
{$ifndef CPUX86NOTPIC}
tab := @TwoDigitLookupW;
{$endif CPUX86NOTPIC}
PWord(P)^ := tab[Day];
PCardinal(P + 2)^ := PCardinal(@HTML_MONTH_NAMES[Month])^;
P[2] := '/'; // overwrite HTML_MONTH_NAMES[][0]
P[6] := '/';
y := Year;
d100 := y div 100;
PWord(P + 7)^ := tab[d100];
PWord(P + 9)^ := tab[y - (d100 * 100)];
P[11] := ':';
PWord(P + 12)^ := tab[Hour];
P[14] := ':';
PWord(P + 15)^ := tab[Minute];
P[17] := ':';
PWord(P + 18)^ := tab[Second];
P[20] := ' ';
result := 21;
end;
procedure TSynSystemTime.ToNcsaShort(var text: shortstring; const tz: RawUtf8);
begin
text[0] := AnsiChar(ToNcsaText(@text[1]));
AppendShortAnsi7String(tz, text);
end;
procedure TSynSystemTime.ToHttpDate(out text: RawUtf8; const tz, prefix: RawUtf8);
var
tmp: shortstring;
begin
ToHttpDateShort(tmp, tz, prefix);
FastSetString(text, @tmp[1], ord(tmp[0]));
end;
procedure TSynSystemTime.ToHttpDateShort(
var text: shortstring; const tz, prefix: RawUtf8);
begin
if DayOfWeek = 0 then
PSynDate(@self)^.ComputeDayOfWeek; // first 4 fields do match
FormatShort('%%, % % % %:%:% %', [
prefix,
HTML_WEEK_DAYS[DayOfWeek],
UInt2DigitsToShortFast(Day),
HTML_MONTH_NAMES[Month],
UInt4DigitsToShort(Year),
UInt2DigitsToShortFast(Hour),
UInt2DigitsToShortFast(Minute),
UInt2DigitsToShortFast(Second),
tz], text);
end;
procedure TSynSystemTime.ToIsoDateTime(out text: RawUtf8; FirstTimeChar: AnsiChar);
var
tmp: shortstring;
begin
ToIsoDateTimeShort(tmp, FirstTimeChar);
ShortStringToAnsi7String(tmp, text);
end;
procedure TSynSystemTime.ToIsoDateTimeShort(var text: shortstring;
FirstTimeChar: AnsiChar);
begin
FormatShort('%-%-%%%:%:%', [
UInt4DigitsToShort(Year),
UInt2DigitsToShortFast(Month),
UInt2DigitsToShortFast(Day),
FirstTimeChar,
UInt2DigitsToShortFast(Hour),
UInt2DigitsToShortFast(Minute),
UInt2DigitsToShortFast(Second)], text);
end;
procedure TSynSystemTime.ToIsoDate(out text: RawUtf8);
begin
FormatUtf8('%-%-%', [
UInt4DigitsToShort(Year),
UInt2DigitsToShortFast(Month),
UInt2DigitsToShortFast(Day)], text);
end;
procedure TSynSystemTime.ToIsoTime(out text: RawUtf8; FirstTimeChar: RawUtf8);
begin
FormatUtf8('%%:%:%', [
FirstTimeChar,
UInt2DigitsToShortFast(Hour),
UInt2DigitsToShortFast(Minute),
UInt2DigitsToShortFast(Second)], text);
end;
function TSynSystemTime.ToDateTime: TDateTime;
var
time: TDateTime;
begin
if mormot.core.datetime.TryEncodeDate(Year, Month, Day, result) then
if TryEncodeTime(Hour, Minute, Second, MilliSecond, time) then
result := result + time
else
result := 0
else
result := 0;
end;
function TSynSystemTime.ToUnixTime: TUnixTime;
var
dt: TDateTime;
begin
dt := ToDateTime;
if dt = 0 then
result := 0
else
result := DateTimeToUnixTime(dt);
end;
procedure TSynSystemTime.ToSynDate(out date: TSynDate);
begin
date := PSynDate(@self)^; // first 4 fields do match
end;
procedure TSynSystemTime.ToFileShort(out result: TShort16);
var
{$ifdef CPUX86NOTPIC}
tab: TWordArray absolute TwoDigitLookupW;
{$else}
tab: PWordArray;
{$endif CPUX86NOTPIC}
begin
if IsZero then
begin
PWord(@result[0])^ := 1 + ord('0') shl 8;
exit;
end;
if Year > 1999 then
if Year < 2100 then
dec(Year, 2000)
else
Year := 99
else
Year := 0;
{$ifndef CPUX86NOTPIC}
tab := @TwoDigitLookupW;
{$endif CPUX86NOTPIC}
result[0] := #12;
PWord(@result[1])^ := tab[Year];
PWord(@result[3])^ := tab[Month];
PWord(@result[5])^ := tab[Day];
PWord(@result[7])^ := tab[Hour];
PWord(@result[9])^ := tab[Minute];
PWord(@result[11])^ := tab[Second];
end;
procedure TSynSystemTime.ComputeDayOfWeek;
begin
PSynDate(@self)^.ComputeDayOfWeek; // first 4 fields do match
end;
procedure TSynSystemTime.IncrementMS(ms: integer);
begin
inc(MilliSecond, ms);
Normalize;
end;
procedure TSynSystemTime.Normalize;
procedure NormalizeMonth;
var
thismonth: cardinal;
begin
repeat
thismonth := DaysInMonth;
if Day <= thismonth then
break;
dec(Day, thismonth);
inc(Month);
if Month > 12 then
begin
dec(Month, 12);
inc(Year);
end;
until false;
end;
begin
DayOfWeek := 0;
while MilliSecond >= 1000 do
begin
dec(MilliSecond, 1000);
inc(Second);
end;
while Second >= 60 do
begin
dec(Second, 60);
inc(Minute);
end;
while Minute >= 60 do
begin
dec(Minute, 60);
inc(Hour);
end;
while Hour >= 24 do
begin
dec(Hour, 24);
inc(Day);
end;
NormalizeMonth;
while Month > 12 do
begin
dec(Month, 12);
inc(Year);
NormalizeMonth;
end;
end;
function TSynSystemTime.ChangeOperatingSystemTime: boolean;
begin
{$ifdef OSPOSIX}
result := SetSystemTime(ToUnixTime); // fpsettimeofday
{$else}
result := SetSystemTime(PSystemTime(@self)^); // set privilege + API + notify
{$endif OSPOSIX}
FillCharFast(GlobalTime, SizeOf(GlobalTime), 0); // reset cache
end;
function TryEncodeDate(Year, Month, Day: cardinal;
out Date: TDateTime): boolean;
var
d100: TDiv100Rec;
begin
result := false;
if (Month = 0) or
(Month > 12) or
(Day = 0) or
(Year = 0) or
(Year > 10000) or
(Day > MonthDays[IsLeapYear(Year)][Month]) then
exit;
if Month > 2 then
dec(Month, 3)
else if Month > 0 then
begin
inc(Month, 9);
dec(Year);
end;
Div100(Year, d100{%H-});
Date := (146097 * d100.D) shr 2 + (1461 * d100.M) shr 2 +
(153 * Month + 2) div 5 + Day;
Date := Date - 693900; // separated to avoid sign issue
result := true;
end;
function NowToString(Expanded: boolean; FirstTimeChar: AnsiChar;
UtcDate: boolean): RawUtf8;
var
I: TTimeLogBits;
begin
if UtcDate then
I.FromUtcTime
else
I.FromNow;
result := I.Text(Expanded, FirstTimeChar);
end;
function NowUtcToString(Expanded: boolean; FirstTimeChar: AnsiChar): RawUtf8;
begin
result := NowToString(Expanded, FirstTimeChar, {UTC=}true);
end;
function DateTimeMSToString(DateTime: TDateTime; Expanded: boolean;
FirstTimeChar: AnsiChar; const TZD: RawUtf8): RawUtf8;
var
T: TSynSystemTime;
begin
// 'YYYY-MM-DD hh:mm:ss.sssZ' or 'YYYYMMDD hhmmss.sssZ' format
if DateTime = 0 then
result := ''
else
begin
T.FromDateTime(DateTime);
result := DateTimeMSToString(T.Hour, T.Minute, T.Second, T.MilliSecond,
T.Year, T.Month, T.Day, Expanded, FirstTimeChar, TZD);
end;
end;
function DateTimeMSToString(HH, MM, SS, MS, Y, M, D: cardinal; Expanded: boolean;
FirstTimeChar: AnsiChar; const TZD: RawUtf8): RawUtf8;
begin
// 'YYYY-MM-DD hh:mm:ss.sssZ' or 'YYYYMMDD hhmmss.sssZ' format
FormatUtf8(DTMS_FMT[Expanded], [
UInt4DigitsToShort(Y),
UInt2DigitsToShortFast(M),
UInt2DigitsToShortFast(D),
FirstTimeChar,
UInt2DigitsToShortFast(HH),
UInt2DigitsToShortFast(MM),
UInt2DigitsToShortFast(SS),
UInt3DigitsToShort(MS),
TZD], result);
end;
function DateTimeToHttpDate(dt: TDateTime; const tz: RawUtf8): RawUtf8;
var
T: TSynSystemTime;
begin
if dt = 0 then
result := ''
else
begin
T.FromDateTime(dt);
T.ToHttpDate(result, tz);
end;
end;
function HttpDateToDateTime(const httpdate: RawUtf8; var datetime: TDateTime;
tolocaltime: boolean): boolean; overload;
var
T: TSynSystemTime;
begin
PInt64(@datetime)^ := 0;
result := (httpdate <> '') and
T.FromHttpDate(httpdate, tolocaltime);
if result then
datetime := T.ToDateTime;
end;
function HttpDateToDateTime(const httpdate: RawUtf8;
tolocaltime: boolean): TDateTime;
begin
if not HttpDateToDateTime(httpdate, result, tolocaltime) then
result := 0;
end;
function HttpDateToDateTimeBuffer(httpdate: PUtf8Char; var datetime: TDateTime;
tolocaltime: boolean): boolean;
var
T: TSynSystemTime;
begin
PInt64(@datetime)^ := 0;
result := (httpdate <> '') and
T.FromHttpDateBuffer(httpdate, tolocaltime);
if result then
datetime := T.ToDateTime;
end;
function HttpDateToUnixTime(const httpdate: RawUtf8): TUnixTime;
var
dt: TDateTime;
begin
result := 0;
if HttpDateToDateTime(httpdate, dt, {tolocaltime=}false) then
result := DateTimeToUnixTime(dt);
end;
function HttpDateToUnixTimeBuffer(httpdate: PUtf8Char): TUnixTime;
var
dt: TDateTime;
begin
result := 0;
if HttpDateToDateTimeBuffer(httpdate, dt, {tolocaltime=}false) then
result := DateTimeToUnixTime(dt);
end;
var
_HttpDateNowUtc: record
Safe: TLightLock;
Tix: cardinal; // = GetTickCount64 div 1024 (every second)
Value: THttpDateNowUtc;
end;
function HttpDateNowUtc: THttpDateNowUtc;
var
c: cardinal;
T: TSynSystemTime;
now: shortstring; // use a temp variable for _HttpDateNowUtc atomic set
begin
c := GetTickCount64 shr 10;
with _HttpDateNowUtc do
begin
Safe.Lock;
if c <> Tix then
begin
Tix := c; // let this single thread update the Value
Safe.UnLock;
T.FromNowUtc;
T.ToHttpDateShort(now, 'GMT'#13#10, 'Date: ');
Safe.Lock;
Value := now;
end;
MoveFast(Value[0], result[0], ord(Value[0]) + 1);
Safe.UnLock;
end;
end;
function UnixMSTimeUtcToHttpDate(UnixMSTime: TUnixMSTime): TShort31;
var
T: TSynSystemTime;
begin
if UnixMSTime <= 0 then
result[0] := #0
else
begin
T.FromUnixMsTime(UnixMSTime);
T.ToHttpDateShort(result);
end;
end;
function TimeToString: RawUtf8;
var
I: TTimeLogBits;
begin
I.FromNow;
I.Value := I.Value and (1 shl (6 + 6 + 5) - 1); // keep only time
result := I.Text(true, ' ');
end;
function DateTimeToFileShort(const DateTime: TDateTime): TShort16;
begin
DateTimeToFileShort(DateTime, result);
end;
procedure DateTimeToFileShort(const DateTime: TDateTime; out result: TShort16);
var
T: TSynSystemTime;
begin
// use 'YYMMDDHHMMSS' format
if DateTime <= 0 then
PWord(@result[0])^ := 1 + ord('0') shl 8
else
begin
T.FromDate(DateTime);
T.FromTime(DateTime);
T.ToFileShort(result);
end;
end;
function NowToFileShort(localtime: boolean): TShort16;
var
T: TSynSystemTime;
begin
T.FromNow(localtime);
T.ToFileShort(result);
end;
{ ************ TUnixTime / TUnixMSTime POSIX Epoch Compatible 64-bit date/time }
function UnixTimeMinimalUtc: cardinal;
begin
result := UnixTimeUtc - UNIXTIME_MINIMAL;
end;
function UnixTimeToDateTime(const UnixTime: TUnixTime): TDateTime;
begin
result := UnixTime / SecsPerDay + UnixDateDelta;
end;
function DateTimeToUnixTime(const AValue: TDateTime): TUnixTime;
begin
result := Round((AValue - UnixDateDelta) * SecsPerDay);
end;
function UnixTimeToString(const UnixTime: TUnixTime; Expanded: boolean;
FirstTimeChar: AnsiChar): RawUtf8;
begin
// inlined UnixTimeToDateTime() + DateTimeToIso8601()
DateTimeToIso8601Var(UnixTime / SecsPerDay + UnixDateDelta,
Expanded, false, FirstTimeChar, #0, result);
end;
procedure UnixTimeToFileShort(const UnixTime: TUnixTime; out result: TShort16);
begin
// use 'YYMMDDHHMMSS' format
if UnixTime <= 0 then
PWord(@result[0])^ := 1 + ord('0') shl 8
else
DateTimeToFileShort(UnixTime / SecsPerDay + UnixDateDelta, result);
end;
function UnixTimeToFileShort(const UnixTime: TUnixTime): TShort16;
begin
UnixTimeToFileShort(UnixTime, result);
end;
function UnixMSTimeToFileShort(const UnixMSTime: TUnixMSTime): TShort16;
begin
UnixTimeToFileShort(UnixMSTime div MSecsPerSec, result);
end;
function UnixTimePeriodToString(const UnixTime: TUnixTime;
FirstTimeChar: AnsiChar): RawUtf8;
begin
if UnixTime < SecsPerDay then
result := TimeToIso8601(UnixTime / SecsPerDay, true, FirstTimeChar)
else
result := DaysToIso8601(UnixTime div SecsPerDay, true);
end;
function UnixMSTimeToDateTime(const UnixMSTime: TUnixMSTime): TDateTime;
begin
result := UnixMSTime / MSecsPerDay + UnixDateDelta;
end;
function UnixMSTimePeriodToString(const UnixMSTime: TUnixMSTime;
FirstTimeChar: AnsiChar): RawUtf8;
begin
if UnixMSTime < MSecsPerDay then
result := TimeToIso8601(UnixMSTime / MSecsPerDay, true,
FirstTimeChar, UnixMSTime < 1000)
else
result := DaysToIso8601(UnixMSTime div MSecsPerDay, true);
end;
function DateTimeToUnixMSTime(const AValue: TDateTime): TUnixMSTime;
begin
if AValue = 0 then
result := 0
else
result := Round((AValue - UnixDateDelta) * MSecsPerDay);
end;
function UnixMSTimeToString(const UnixMSTime: TUnixMSTime; Expanded: boolean;
FirstTimeChar: AnsiChar; const TZD: RawUtf8): RawUtf8;
begin
// inlined UnixMSTimeToDateTime()
if UnixMSTime <= 0 then
result := ''
else
result := DateTimeMSToString(UnixMSTime / MSecsPerDay + UnixDateDelta,
Expanded, FirstTimeChar, TZD);
end;
{ ************ TTimeLog efficient 64-bit custom date/time encoding }
// bits: S=0..5 M=6..11 H=12..16 D=17..21 M=22..25 Y=26..40
// size: S=6 M=6 H=5 D=5 M=4 Y=12
// i.e. S<64 M<64 H<32 D<32 M<16 Y<=9999: power of 2 -> use fast shl/shr
{ TTimeLogBits }
procedure TTimeLogBits.From(Y, M, D, HH, MM, SS: cardinal);
begin
inc(HH, D shl 5 + M shl 10 + Y shl 14 - (1 shl 5 + 1 shl 10));
Value := SS + MM shl 6 + Int64(HH) shl 12;
end;
procedure TTimeLogBits.From(P: PUtf8Char; L: integer);
begin
Value := Iso8601ToTimeLogPUtf8Char(P, L);
end;
procedure TTimeLogBits.Expand(out Date: TSynSystemTime);
var
V: PtrUInt;
begin
V := PPtrUint(@Value)^;
{$ifdef CPU32}
Date.Year := Value shr (6 + 6 + 5 + 5 + 4);
{$else}
Date.Year := V shr (6 + 6 + 5 + 5 + 4);
{$endif CPU32}
Date.Month := 1 + (V shr (6 + 6 + 5 + 5)) and 15;
Date.DayOfWeek := 0;
Date.Day := 1 + (V shr (6 + 6 + 5)) and 31;
Date.Hour := (V shr (6 + 6)) and 31;
Date.Minute := (V shr 6) and 63;
Date.Second := V and 63;
Date.MilliSecond := 0;
end;
procedure TTimeLogBits.From(const S: RawUtf8);
begin
Value := Iso8601ToTimeLogPUtf8Char(pointer(S), length(S));
end;
procedure TTimeLogBits.FromFileDate(const FileDate: TFileAge);
begin
{$ifdef OSWINDOWS} // already local time
with PLongRec(@FileDate)^ do
From(Hi shr 9 + 1980, Hi shr 5 and 15, Hi and 31, Lo shr 11,
Lo shr 5 and 63, Lo and 31 shl 1);
{$else}
From(mormot.core.os.FileDateToDateTime(FileDate)); // convert UTC to local
{$endif OSWINDOWS}
end;
procedure TTimeLogBits.From(DateTime: TDateTime; DateOnly: boolean);
var
T: TSynSystemTime;
V: PtrInt;
begin
T.FromDate(DateTime);
if DateOnly then
T.Hour := 0
else
T.FromTime(DateTime);
V := T.Day shl 5 + T.Month shl 10 + T.Year shl 14 - (1 shl 5 + 1 shl 10);
Value := V; // circumvent C1093 error on oldest Delphi
Value := Value shl 12;
if not DateOnly then
begin
V := T.Second + T.Minute shl 6 + T.Hour shl 12;
Value := Value + V;
end;
end;
procedure TTimeLogBits.FromUnixTime(const UnixTime: TUnixTime);
begin
From(UnixTimeToDateTime(UnixTime));
end;
procedure TTimeLogBits.FromUnixMSTime(const UnixMSTime: TUnixMSTime);
begin
From(UnixMSTimeToDateTime(UnixMSTime));
end;
procedure TTimeLogBits.From(Time: PSynSystemTime);
var
V: PtrInt;
begin
V := Time^.Hour + Time^.Day shl 5 + Time^.Month shl 10 +
Time^.Year shl 14 - (1 shl 5 + 1 shl 10);
Value := V; // circumvent C1093 error on Delphi 5
V := Time^.Second + Time^.Minute shl 6;
Value := (Value shl 12) + V;
end;
procedure TTimeLogBits.FromUtcTime;
var
now: TSynSystemTime;
begin
FromGlobalTime(now, {local=}false);
From(@now);
end;
procedure TTimeLogBits.FromNow;
var
now: TSynSystemTime;
begin
FromGlobalTime(now, {local=}true);
From(@now);
end;
function TTimeLogBits.ToTime: TTime;
var
lo: PtrUInt;
begin
{$ifdef CPU64}
lo := Value;
{$else}
lo := PCardinal(@Value)^;
{$endif CPU64}
if lo and (1 shl (6 + 6 + 5) - 1) = 0 then
result := 0
else
result := EncodeTime((lo shr (6 + 6)) and 31,
(lo shr 6) and 63,
lo and 63, 0);
end;
function TTimeLogBits.ToDate: TDate;
var
Y, lo: PtrUInt;
begin
{$ifdef CPU64}
lo := Value;
Y := lo shr (6 + 6 + 5 + 5 + 4);
{$else}
Y := Value shr (6 + 6 + 5 + 5 + 4);
lo := PCardinal(@Value)^;
{$endif CPU64}
if (Y = 0) or
not TryEncodeDate(Y,
1 + (lo shr (6 + 6 + 5 + 5)) and 15,
1 + (lo shr (6 + 6 + 5)) and 31,
TDateTime(result)) then
result := 0;
end;
function TTimeLogBits.ToDateTime: TDateTime;
var
Y, lo: PtrUInt;
Time: TDateTime;
begin
{$ifdef CPU64}
lo := Value;
Y := lo shr (6 + 6 + 5 + 5 + 4);
{$else}
Y := Value shr (6 + 6 + 5 + 5 + 4);
lo := PCardinal(@Value)^;
{$endif CPU64}
if (Y = 0) or
not TryEncodeDate(Y,
1 + (lo shr (6 + 6 + 5 + 5)) and 15,
1 + (lo shr (6 + 6 + 5)) and 31,
result) then
result := 0;
if (lo and (1 shl (6 + 6 + 5) - 1) <> 0) and
TryEncodeTime((lo shr (6 + 6)) and 31,
(lo shr 6) and 63,
lo and 63,
0,
Time) then
result := result + Time;
end;
function TTimeLogBits.Year: integer;
begin
result := Value shr (6 + 6 + 5 + 5 + 4);
end;
function TTimeLogBits.Month: integer;
begin
result := 1 + (PCardinal(@Value)^ shr (6 + 6 + 5 + 5)) and 15;
end;
function TTimeLogBits.Day: integer;
begin
result := 1 + (PCardinal(@Value)^ shr (6 + 6 + 5)) and 31;
end;
function TTimeLogBits.Hour: integer;
begin
result := (PCardinal(@Value)^ shr (6 + 6)) and 31;
end;
function TTimeLogBits.Minute: integer;
begin
result := (PCardinal(@Value)^ shr 6) and 63;
end;
function TTimeLogBits.Second: integer;
begin
result := PCardinal(@Value)^ and 63;
end;
function TTimeLogBits.ToUnixTime: TUnixTime;
var
dt: TDateTime;
begin
dt := ToDateTime;
if dt = 0 then
result := 0
else
result := DateTimeToUnixTime(dt);
end;
function TTimeLogBits.ToUnixMSTime: TUnixMSTime;
begin
result := ToUnixTime * MSecsPerSec;
end;
function TTimeLogBits.Text(Dest: PUtf8Char; Expanded: boolean;
FirstTimeChar, QuoteChar: AnsiChar): PUtf8Char;
var
lo: PtrUInt;
begin
if QuoteChar <> #0 then
begin
Dest^ := QuoteChar;
inc(Dest);
end;
if Value <> 0 then
begin
{$ifdef CPU64}
lo := Value;
{$else}
lo := PCardinal(@Value)^;
{$endif CPU64}
if lo and (1 shl (6 + 6 + 5) - 1) = 0 then
// no Time: just convert date
Dest := DateToIso8601PChar(Dest, Expanded,
{$ifdef CPU64} lo {$else} Value {$endif} shr (6 + 6 + 5 + 5 + 4),
1 + (lo shr (6 + 6 + 5 + 5)) and 15,
1 + (lo shr (6 + 6 + 5)) and 31)
else
{$ifdef CPU64}
if lo shr (6 + 6 + 5) = 0 then
{$else}
if Value shr (6 + 6 + 5) = 0 then
{$endif CPU64}
// no Date: just convert time
Dest := TimeToIso8601PChar(Dest, Expanded,
(lo shr (6 + 6)) and 31,
(lo shr 6) and 63,
lo and 63, 0, FirstTimeChar)
else
begin
// convert time and date
Dest := DateToIso8601PChar(Dest, Expanded,
{$ifdef CPU64} lo {$else} Value {$endif} shr (6+6+5+5+4),
1 + (lo shr (6 + 6 + 5 + 5)) and 15,
1 + (lo shr (6 + 6 + 5)) and 31);
Dest := TimeToIso8601PChar(Dest, Expanded,
(lo shr (6 + 6)) and 31,
(lo shr 6) and 63,
lo and 63, 0, FirstTimeChar);
end;
end;
if QuoteChar <> #0 then
begin
Dest^ := QuoteChar;
inc(Dest);
end;
result := Dest;
end;
function TTimeLogBits.Text(Expanded: boolean; FirstTimeChar: AnsiChar): RawUtf8;
var
tmp: array[0..31] of AnsiChar;
begin
if Value = 0 then
result := ''
else
FastSetString(result, @tmp,
Text(@tmp, Expanded, FirstTimeChar) - PUtf8Char(@tmp));
end;
function TTimeLogBits.FullText(Dest: PUtf8Char; Expanded: boolean;
FirstTimeChar, QuotedChar: AnsiChar): PUtf8Char;
var
lo: PtrUInt;
begin
// convert full time and date
if QuotedChar <> #0 then
begin
Dest^ := QuotedChar;
inc(Dest);
end;
lo := {$ifdef CPU64}Value{$else}PCardinal(@Value)^{$endif};
Dest := DateToIso8601PChar(Dest, Expanded,
{$ifdef CPU64}lo{$else}Value{$endif} shr (6 + 6 + 5 + 5 + 4),
1 + (lo shr (6 + 6 + 5 + 5)) and 15,
1 + (lo shr (6 + 6 + 5)) and 31);
Dest := TimeToIso8601PChar(Dest, Expanded,
(lo shr (6 + 6)) and 31,
(lo shr 6) and 63,
lo and 63, 0, FirstTimeChar);
if QuotedChar <> #0 then
begin
Dest^ := QuotedChar;
inc(Dest);
end;
result := Dest;
end;
function TTimeLogBits.FullText(Expanded: boolean;
FirstTimeChar, QuotedChar: AnsiChar): RawUtf8;
var
tmp: array[0..31] of AnsiChar;
begin
FastSetString(result, @tmp,
FullText(tmp{%H-}, Expanded, FirstTimeChar, QuotedChar) - PUtf8Char(@tmp));
end;
function TTimeLogBits.i18nText: string;
begin
if Assigned(i18nDateText) then
result := i18nDateText(Value)
else
result := {$ifdef UNICODE}Ansi7ToString{$endif}(Text(true, ' '));
end;
function TimeLogNow: TTimeLog;
begin
PTimeLogBits(@result)^.FromNow;
end;
function TimeLogNowUtc: TTimeLog;
begin
PTimeLogBits(@result)^.FromUtcTime;
end;
function TimeLogFromFile(const FileName: TFileName): TTimeLog;
var
Date: TDateTime;
begin
Date := FileAgeToDateTime(FileName);
if Date = 0 then
result := 0
else
PTimeLogBits(@result)^.From(Date);
end;
function TimeLogFromDateTime(const DateTime: TDateTime): TTimeLog;
begin
PTimeLogBits(@result)^.From(DateTime);
end;
function TimeLogFromUnixTime(const UnixTime: TUnixTime): TTimeLog;
begin
PTimeLogBits(@result)^.FromUnixTime(UnixTime);
end;
function TimeLogToDateTime(const Timestamp: TTimeLog): TDateTime;
begin
result := PTimeLogBits(@Timestamp)^.ToDateTime;
end;
function TimeLogToUnixTime(const Timestamp: TTimeLog): TUnixTime;
begin
result := PTimeLogBits(@Timestamp)^.ToUnixTime;
end;
function Iso8601ToTimeLogPUtf8Char(P: PUtf8Char; L: integer;
ContainsNoTime: PBoolean): TTimeLog;
// bits: S=0..5 M=6..11 H=12..16 D=17..21 M=22..25 Y=26..40
// i.e. S<64 M<64 H<32 D<32 M<16 Y<9999: power of 2 -> use fast shl/shr
var
V, B: PtrUInt;
{$ifdef CPUX86NOTPIC}
tab: TNormTableByte absolute ConvertHexToBin;
{$else}
tab: PByteArray; // faster on PIC/x86_64/ARM
{$endif CPUX86NOTPIC}
begin
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] = 'T' then
dec(P, 8)
else
begin
// 'YYYY' -> year decode
{$ifndef CPUX86NOTPIC}
tab := @ConvertHexToBin;
{$endif CPUX86NOTPIC}
V := tab[ord(P[0])];
if V > 9 then
exit;
B := tab[ord(P[1])];
if B > 9 then
exit
else
V := V * 10 + B;
B := tab[ord(P[2])];
if B > 9 then
exit
else
V := V * 10 + B;
B := tab[ord(P[3])];
if B > 9 then
exit
else
V := V * 10 + B;
result := Int64(V) shl 26; // store YYYY
if P[4] in ['-', '/'] then
begin
inc(P);
dec(L);
end; // allow YYYY-MM-DD
if L >= 6 then
begin
// YYYYMM
V := ord(P[4]) * 10 + ord(P[5]) - (48 + 480 + 1); // Month 1..12 -> 0..11
if V <= 11 then
inc(result, V shl 22)
else
begin
result := 0;
exit;
end;
if P[6] in ['-', '/'] then
begin
inc(P);
dec(L);
end; // allow YYYY-MM-DD
if L >= 8 then
begin
// YYYYMMDD
V := ord(P[6]) * 10 + ord(P[7]) - (48 + 480 + 1); // Day 1..31 -> 0..30
if (V <= 30) and
((L = 8) or
(L = 14) or
(P[8] in [#0, ' ', 'T'])) then
inc(result, V shl 17)
else
begin
result := 0;
exit;
end;
end;
end;
if L = 14 then
dec(P) // no 'T' or ' ' separator for YYYYMMDDhhmmss
else if L < 14 then
begin
// not enough place to retrieve a time
if ContainsNoTime <> nil then
ContainsNoTime^ := true;
exit;
end;
end;
if ContainsNoTime <> nil then
ContainsNoTime^ := false;
B := ord(P[9]) * 10 + ord(P[10]) - (48 + 480);
if B <= 23 then
V := B shl 12
else
exit;
if P[11] = ':' then
inc(P); // allow hh:mm:ss
B := ord(P[11]) * 10 + ord(P[12]) - (48 + 480);
if B <= 59 then
inc(V, B shl 6)
else
exit;
if P[13] = ':' then
inc(P); // allow hh:mm:ss
B := ord(P[13]) * 10 + ord(P[14]) - (48 + 480);
if B <= 59 then
inc(result, PtrUInt(V + B));
end;
function Iso8601ToTimeLog(const S: RawByteString): TTimeLog;
begin
result := Iso8601ToTimeLogPUtf8Char(pointer(S), length(S));
end;
{ ******************* TTextDateWriter supporting date/time ISO-8601 serialization }
{ TTextDateWriter }
procedure TTextDateWriter.AddTimeLog(Value: PInt64; QuoteChar: AnsiChar);
begin
if BEnd - B <= 31 then
FlushToStream;
B := PTimeLogBits(Value)^.Text(B + 1, true, 'T', QuoteChar) - 1;
end;
procedure TTextDateWriter.AddUnixTime(Value: PInt64; QuoteChar: AnsiChar);
var
DT: TDateTime;
begin
// inlined UnixTimeToDateTime()
DT := Value^ / SecsPerDay + UnixDateDelta;
AddDateTime(@DT, 'T', QuoteChar, {withms=}false, {dateandtime=}true);
end;
procedure TTextDateWriter.AddUnixMSTime(Value: PInt64; WithMS: boolean;
QuoteChar: AnsiChar);
var
DT: TDateTime;
begin
// inlined UnixMSTimeToDateTime()
DT := Value^ / MSecsPerDay + UnixDateDelta;
AddDateTime(@DT, 'T', QuoteChar, WithMS, {dateandtime=}true);
end;
procedure TTextDateWriter.AddDateTime(Value: PDateTime; FirstChar: AnsiChar;
QuoteChar: AnsiChar; WithMS: boolean; AlwaysDateAndTime: boolean);
var
T: TSynSystemTime;
begin
if (PInt64(Value)^ = 0) and
(QuoteChar = #0) then
exit;
if BEnd - B <= 26 then
FlushToStream;
inc(B);
if QuoteChar <> #0 then
B^ := QuoteChar
else
dec(B);
if PInt64(Value)^ <> 0 then
begin
inc(B);
if AlwaysDateAndTime or
(trunc(Value^) <> 0) then
begin
T.FromDate(Value^);
B := DateToIso8601PChar(B, true, T.Year, T.Month, T.Day);
end;
if AlwaysDateAndTime or
(frac(Value^) <> 0) then
begin
T.FromTime(Value^);
B := TimeToIso8601PChar(B, true, T.Hour, T.Minute, T.Second,
T.MilliSecond, FirstChar, WithMS);
end;
dec(B);
end;
if twoDateTimeWithZ in fCustomOptions then
begin
inc(B);
B^ := 'Z';
end;
if QuoteChar <> #0 then
begin
inc(B);
B^ := QuoteChar;
end;
end;
procedure TTextDateWriter.AddDateTime(const Value: TDateTime; WithMS: boolean);
begin
AddDateTime(@Value, 'T', {quotechar=}#0, WithMS, {always=}false);
end;
procedure TTextDateWriter.AddDateTimeMS(const Value: TDateTime; Expanded: boolean;
FirstTimeChar: AnsiChar; const TZD: RawUtf8);
var
T: TSynSystemTime;
begin
if Value = 0 then
exit;
T.FromDateTime(Value);
Add(DTMS_FMT[Expanded], [UInt4DigitsToShort(T.Year),
UInt2DigitsToShortFast(T.Month), UInt2DigitsToShortFast(T.Day),
FirstTimeChar, UInt2DigitsToShortFast(T.Hour),
UInt2DigitsToShortFast(T.Minute), UInt2DigitsToShortFast(T.Second),
UInt3DigitsToShort(T.MilliSecond), TZD]);
end;
procedure TTextDateWriter.AddCurrentIsoDateTime(
LocalTime, WithMS: boolean; FirstTimeChar: AnsiChar; const TZD: RawUtf8);
var
time: TSynSystemTime;
begin
time.FromNow(LocalTime);
time.AddIsoDateTime(self, WithMS, FirstTimeChar, TZD);
end;
procedure TTextDateWriter.AddCurrentLogTime(LocalTime: boolean);
var
time: TSynSystemTime;
begin
time.FromNow(LocalTime);
time.AddLogTime(self);
end;
procedure TTextDateWriter.AddCurrentNcsaLogTime(
LocalTime: boolean; const TZD: RawUtf8);
var
time: TSynSystemTime;
begin
time.FromNow(LocalTime);
time.AddNcsaText(self, TZD);
end;
procedure TTextDateWriter.AddCurrentHttpTime(LocalTime: boolean;
const TZD: RawUtf8);
var
time: TSynSystemTime;
begin
time.FromNow(LocalTime);
time.AddHttpDate(self, TZD);
end;
procedure TTextDateWriter.AddSeconds(MilliSeconds: QWord; Quote: AnsiChar);
begin
if Quote <> #0 then
Add(Quote);
MilliSeconds := MilliSeconds * 10; // convert a.bcd to a.bcd0 currency/Curr64
AddCurr64(@MilliSeconds); // fast output
if Quote <> #0 then
Add(Quote);
end;
{ ******************* TValuePUtf8Char text value wrapper record }
{ TValuePUtf8Char }
procedure TValuePUtf8Char.ToUtf8(var Value: RawUtf8);
begin
FastSetString(Value, Text, Len);
end;
function TValuePUtf8Char.ToUtf8: RawUtf8;
begin
FastSetString(result, Text, Len);
end;
function TValuePUtf8Char.ToString: string;
begin
Utf8DecodeToString(Text, Len, result);
end;
function TValuePUtf8Char.ToInteger: PtrInt;
begin
result := GetInteger(Text);
end;
function TValuePUtf8Char.ToCardinal: PtrUInt;
begin
result := GetCardinal(Text);
end;
function TValuePUtf8Char.ToCardinal(Def: PtrUInt): PtrUInt;
begin
result := GetCardinalDef(Text, Def);
end;
function TValuePUtf8Char.ToInt64: Int64;
begin
SetInt64(Text, result{%H-});
end;
function TValuePUtf8Char.ToDouble: double;
begin
result := GetExtended(Text);
end;
function TValuePUtf8Char.Iso8601ToDateTime: TDateTime;
begin
result := Iso8601ToDateTimePUtf8Char(Text, Len);
end;
function TValuePUtf8Char.Idem(const Value: RawUtf8): boolean;
begin
result := (length(Value) = Len) and
((Len = 0) or
IdemPropNameUSameLenNotNull(pointer(Value), Text, Len));
end;
function TValuePUtf8Char.ToBoolean: boolean;
begin
result := (Text <> nil) and
((PWord(Text)^ = ord('1')) or
(GetTrue(Text) = 1));
end;
procedure InitializeUnit;
begin
// as expected by ParseMonth() to call FindShortStringListExact()
assert(PtrUInt(@HTML_MONTH_NAMES[3]) - PtrUInt(@HTML_MONTH_NAMES[1]) = 8);
assert(SizeOf(GlobalTime) = 128);
// some mormot.core.text wrappers are implemented by this unit
_VariantToUtf8DateTimeToIso8601 := DateTimeToIso8601TextVar;
_Iso8601ToDateTime := Iso8601ToDateTime;
end;
procedure FinalizeUnit;
begin
end;
initialization
InitializeUnit;
finalization
FinalizeUnit;
end.
Reference in New Issue Copy Permalink