Слияние кода завершено, страница обновится автоматически
unit supertimezone;
interface
uses
Windows, Registry, SysUtils, Math, Generics.Collections,
supertypes;
type
TSuperTimeZone = class
private
const
TZ_TZI_KEY = '\SYSTEM\CurrentControlSet\Control\TimeZoneInformation'; { Vista and + }
TZ_KEY = '\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Time Zones\';
TZ_KEYNAME = 'TimeZoneKeyName';
private
FName: SOString;
function GetName: SOString;
{ Windows Internals }
function TzSpecificLocalTimeToSystemTime(
const lpTimeZoneInformation: PTimeZoneInformation;
var lpLocalTime, lpUniversalTime: TSystemTime): BOOL;
function SystemTimeToTzSpecificLocalTime(
const lpTimeZoneInformation: PTimeZoneInformation;
var lpUniversalTime, lpLocalTime: TSystemTime): BOOL;
function GetTimezoneBias(const pTZinfo: PTimeZoneInformation;
lpFileTime: PFileTime; islocal: Boolean; pBias: PLongint): Boolean;
function CompTimeZoneID(const pTZinfo: PTimeZoneInformation;
lpFileTime: PFileTime; IsLocal: Boolean): LongWord;
function DayLightCompareDate(const date: PSystemTime;
const compareDate: PSystemTime): Integer;
private
class constructor Init;
class destructor Finish;
class var FCacheCS: TRTLCriticalSection;
class var FCache: TObjectDictionary<string, TSuperTimeZone>;
class function GetSuperTimeZoneInstance(const Name: string): TSuperTimeZone; static;
class function GetLocalSuperTimeZoneInstance: TSuperTimeZone; static;
public
constructor Create(const TimeZoneName: SOString = '');
{ ISO8601 formatted date Parser }
class function ParseISO8601Date(const ISO8601Date: SOString;
var st: TSystemTime; var dayofyear: Integer; var week: Word; var bias: Integer;
var havetz, havedate: Boolean): Boolean;
{ Conversions }
function LocalToUTC(const DelphiDateTime: TDateTime): TDateTime;
function UTCToLocal(const DelphiDateTime: TDateTime): TDateTime;
function JavaToDelphi(const JavaDateTime: Int64): TDateTime;
function DelphiToJava(const DelphiDateTime: TDateTime): Int64;
function JavaToISO8601(JavaDateTime: Int64): SOString;
function DelphiToISO8601(DelphiDateTime: TDateTime): SOString;
function ISO8601ToJava(const ISO8601Date: SOString; var JavaDateTime: Int64): Boolean;
function ISO8601ToDelphi(const ISO8601Date: SOString; var DelphiDateTime: TDateTime): Boolean;
{ TZ Info }
class function GetCurrentTimeZone: SOString;
function GetTimeZoneInformation(Year: Word; var TZI: TTimeZoneInformation): Boolean;
function GetDaylightDisabled: Boolean;
property Name: SOString read GetName;
{ Builder }
class property Local: TSuperTimeZone read GetLocalSuperTimeZoneInstance;
class property Zone[const TimeZoneName: string]: TSuperTimeZone read GetSuperTimeZoneInstance;
end;
{$IFDEF MSWINDOWS}
{$WARN SYMBOL_PLATFORM OFF}
(* NOT DST Aware *)
{ Windows 2000+ }
function _SystemTimeToTzSpecificLocalTime(
lpTimeZoneInformation: PTimeZoneInformation;
var lpUniversalTime, lpLocalTime: TSystemTime): BOOL; stdcall; external kernel32 name 'SystemTimeToTzSpecificLocalTime' delayed;
{ Windows XP+ }
function _TzSpecificLocalTimeToSystemTime(
lpTimeZoneInformation: PTimeZoneInformation;
var lpLocalTime, lpUniversalTime: TSystemTime): BOOL; stdcall; external kernel32 name 'TzSpecificLocalTimeToSystemTime' delayed;
(* EXtended version - DST Aware *)
{ Windows 7+ }
function _TzSpecificLocalTimeToSystemTimeEx(
const lpTimeZoneInformation: PDynamicTimeZoneInformation;
const lpLocalTime: PSystemTime; var lpUniversalTime: TSystemTime): BOOL; stdcall; external kernel32 name 'TzSpecificLocalTimeToSystemTimeEx' delayed;
{ Windows 7+ }
function _SystemTimeToTzSpecificLocalTimeEx(
const lpTimeZoneInformation: PDynamicTimeZoneInformation;
const lpUniversalTime: PSystemTime; var lpLocalTime: TSystemTime): BOOL; stdcall; external kernel32 name 'SystemTimeToTzSpecificLocalTimeEx' delayed;
{ Convert Local <=> UTC for specific time-zones using the Windows API only. NOT Guaranteed to work }
function _ConvertLocalDateTimeToUTC(const TimeZoneName: SOString;
const Local: TDateTime; var UTC: TDateTime): Boolean;
function _ConvertUTCDateTimeToLocal(const TimeZoneName: SOString;
const UTC: TDateTime; var Local: TDateTime): Boolean;
{$WARN SYMBOL_PLATFORM ON}
{$ENDIF}
implementation
{$IFDEF MSWINDOWS}
{ Convert Local -> UTC for specific time-zones using the Windows API only. NOT Guaranteed to work }
function _ConvertLocalDateTimeToUTC(const TimeZoneName: SOString;
const Local: TDateTime; var UTC: TDateTime): Boolean;
var
DTZI: TDynamicTimeZoneInformation;
local_st, utc_st: TSystemTime;
begin
if not CheckWin32Version(6, 1) then
begin
Result := False;
Exit;
end;
{ We work with system times }
DateTimeToSystemTime(Local, local_st);
{ Get current Dynamic TimeZone Information }
FillChar(DTZI, SizeOf(TDynamicTimeZoneInformation), 0);
GetDynamicTimeZoneInformation(DTZI);
{ Replaces the TimeZoneKeyName member with specified TimeZoneName }
Move(TimeZoneName[1], DTZI.TimeZoneKeyName, (Length(TimeZoneName) + 1) * SizeOf(SOChar));
{ Retrieves the TimeZoneInformation structure and convert the local time to utc }
if _TzSpecificLocalTimeToSystemTimeEx(@DTZI, @local_st, utc_st) then
begin
{ We really want Delphi TDateTime }
UTC := SystemTimeToDateTime(utc_st);
Result := True;
end
else
Result := False;
end;
{ Convert UTC -> Local for specific time-zones using the Windows API only. NOT Guaranteed to work }
function _ConvertUTCDateTimeToLocal(const TimeZoneName: SOString;
const UTC: TDateTime; var Local: TDateTime): Boolean;
var
DTZI: TDynamicTimeZoneInformation;
utc_st, local_st: TSystemTime;
begin
if not CheckWin32Version(6, 1) then
begin
Result := False;
Exit;
end;
{ We work with system times }
DateTimeToSystemTime(UTC, utc_st);
{ Get current Dynamic TimeZone Information }
FillChar(DTZI, SizeOf(TDynamicTimeZoneInformation), 0);
GetDynamicTimeZoneInformation(DTZI);
{ Replaces the TimeZoneKeyName member with specified TimeZoneName }
Move(TimeZoneName[1], DTZI.TimeZoneKeyName[0], Length(TimeZoneName) * SizeOf(SOChar));
{ Retrieves the TimeZoneInformation structure and convert the local time to utc }
if _SystemTimeToTzSpecificLocalTimeEx(@DTZI, @utc_st, local_st) then
begin
{ We really want Delphi TDateTime }
Local := SystemTimeToDateTime(local_st);
Result := True;
end
else
Result := False;
end;
{$ENDIF}
{ TSuperDate }
class constructor TSuperTimeZone.Init;
begin
InitializeCriticalSection(FCacheCS);
FCache := TObjectDictionary<string, TSuperTimeZone>.Create([doOwnsValues]);
end;
class destructor TSuperTimeZone.Finish;
begin
FCache.Free;
DeleteCriticalSection(FCacheCS);
end;
class function TSuperTimeZone.GetSuperTimeZoneInstance(
const Name: string): TSuperTimeZone;
begin
EnterCriticalSection(FCacheCS);
try
if not FCache.TryGetValue(Name, Result) then
begin
Result := TSuperTimeZone.Create(Name);
FCache.Add(Name, Result);
end;
finally
LeaveCriticalSection(FCacheCS);
end;
end;
class function TSuperTimeZone.GetLocalSuperTimeZoneInstance: TSuperTimeZone;
begin
Result := TSuperTimeZone.GetSuperTimeZoneInstance('');
end;
constructor TSuperTimeZone.Create(const TimeZoneName: SOString);
begin
inherited Create;
FName := TimeZoneName;
end;
function TSuperTimeZone.LocalToUTC(const DelphiDateTime: TDateTime): TDateTime;
var
local, utc: TSystemTime;
tzi: TTimeZoneInformation;
begin
DateTimeToSystemTime(DelphiDateTime, local);
if GetTimeZoneInformation(local.wYear, tzi) and TzSpecificLocalTimeToSystemTime(@tzi, local, utc) then
Result := SystemTimeToDateTime(utc)
else
Result := DelphiDateTime;
end;
function TSuperTimeZone.UTCToLocal(const DelphiDateTime: TDateTime): TDateTime;
var
utc, local: TSystemTime;
tzi: TTimeZoneInformation;
begin
DateTimeToSystemTime(DelphiDateTime, utc);
if GetTimeZoneInformation(utc.wYear, tzi) and SystemTimeToTzSpecificLocalTime(@tzi, utc, local) then
Result := SystemTimeToDateTime(local)
else
Result := DelphiDateTime;
end;
function TSuperTimeZone.DelphiToJava(const DelphiDateTime: TDateTime): Int64;
var
local, utc, st: TSystemTime;
tzi: TTimeZoneInformation;
begin
DateTimeToSystemTime(DelphiDateTime, local);
if GetTimeZoneInformation(local.wYear, tzi) and TzSpecificLocalTimeToSystemTime(@tzi, local, utc) then
st := utc
else
st := local;
Result := Round((SystemTimeToDateTime(st) - 25569) * 86400000);
end;
function TSuperTimeZone.JavaToDelphi(const JavaDateTime: Int64): TDateTime;
var
utc, local: TSystemTime;
tzi: TTimeZoneInformation;
begin
DateTimeToSystemTime(25569 + (JavaDateTime / 86400000), utc);
if GetTimeZoneInformation(utc.wYear, tzi) and SystemTimeToTzSpecificLocalTime(@tzi, utc, local) then
Result := SystemTimeToDateTime(local)
else
Result := SystemTimeToDateTime(utc);
end;
function TSuperTimeZone.DelphiToISO8601(
DelphiDateTime: TDateTime): SOString;
const
ISO_Fmt = '%.4d-%.2d-%.2dT%.2d:%.2d:%.2d.%d';
TZ_Fmt = '%s%.2d:%.2d';
var
local, utc: TSystemTime;
tzi: TTimeZoneInformation;
bias: TDateTime;
h, m, d: Word;
iso: SOString;
begin
DateTimeToSystemTime(DelphiDateTime, local);
iso := Format(ISO_Fmt, [
local.wYear, local.wMonth, local.wDay,
local.wHour, local.wMinute, local.wSecond, local.wMilliseconds]);
if GetTimeZoneInformation(local.wYear, tzi) and TzSpecificLocalTimeToSystemTime(@tzi, local, utc) then
begin
bias := SystemTimeToDateTime(local) - SystemTimeToDateTime(utc);
DecodeTime(bias, h, m, d, d);
case Sign(bias) of
-1: Result := iso + Format(TZ_Fmt, [ '-', h, m ]);
0: Result := iso + 'Z';
+1: Result := iso + Format(TZ_Fmt, [ '+', h, m ]);
end;
end
else
Result := iso;
end;
function TSuperTimeZone.JavaToISO8601(JavaDateTime: Int64): SOString;
begin
Result := DelphiToISO8601(JavaToDelphi(JavaDateTime));
end;
function TSuperTimeZone.ISO8601ToDelphi(const ISO8601Date: SOString;
var DelphiDateTime: TDateTime): Boolean;
var
JavaDateTime: Int64;
begin
Result := ISO8601ToJava(ISO8601Date, JavaDateTime);
if Result then
DelphiDateTime := JavaToDelphi(JavaDateTime);
end;
function TSuperTimeZone.ISO8601ToJava(const ISO8601Date: SOString;
var JavaDateTime: Int64): Boolean;
var
st: TSystemTime;
dayofyear: Integer;
week: Word;
bias: Integer;
havetz, havedate: Boolean;
tzi: TTimeZoneInformation;
utc: TSystemTime;
m: Word;
DayTable: PDayTable;
begin
if ParseISO8601Date(ISO8601Date, st, dayofyear, week, bias, havetz, havedate) then
begin
if (not havetz) and GetTimeZoneInformation(st.wYear, tzi) and TzSpecificLocalTimeToSystemTime(@tzi, st, utc) then
bias := Trunc((SystemTimeToDateTime(st) - SystemTimeToDateTime(utc)) * MinsPerDay);
JavaDateTime := st.wMilliseconds + st.wSecond * 1000 + (st.wMinute + bias) * 60000 + st.wHour * 3600000;
if havedate then
begin
DayTable := @MonthDays[IsLeapYear(st.wYear)];
if st.wMonth <> 0 then
begin
if not (st.wMonth in [1..12]) or (DayTable^[st.wMonth] < st.wDay) then
begin
Result := False;
Exit;
end;
for m := 1 to st.wMonth - 1 do
Inc(JavaDateTime, Int64(DayTable^[m]) * 86400000);
end;
Dec(st.wYear);
Inc(JavaDateTime, Int64(
(st.wYear * 365) + (st.wYear div 4) - (st.wYear div 100) +
(st.wYear div 400) + st.wDay + dayofyear - 719163) * 86400000);
end;
Result := True;
end
else
Result := False;
end;
function TSuperTimeZone.GetName: SOString;
begin
if FName <> '' then
Result := FName
else
Result := GetCurrentTimeZone;
end;
class function TSuperTimeZone.GetCurrentTimeZone: SOString;
begin
with TRegistry.Create do
try
RootKey := HKEY_LOCAL_MACHINE;
if OpenKeyReadOnly(TZ_TZI_KEY) and ValueExists(TZ_KEYNAME) then
{ Windows Vista+ }
Result := Trim(ReadString(TZ_KEYNAME))
else
begin
{ Windows 2000/XP }
CloseKey;
RootKey := HKEY_CURRENT_USER;
if OpenKeyReadOnly(TZ_KEY) and ValueExists(TZ_KEYNAME) then
Result := Trim(ReadString(TZ_KEYNAME))
else
begin
CloseKey;
RootKey := HKEY_USERS;
if OpenKeyReadOnly('.DEFAULT\' + TZ_KEY) and ValueExists(TZ_KEYNAME) then
Result := Trim(ReadString(TZ_KEYNAME))
else
Result := '';
end;
end;
finally
CloseKey;
Free;
end;
end;
function TSuperTimeZone.GetDaylightDisabled: Boolean;
var
KeyName: SOString;
begin
Result := False;
KeyName := TZ_KEY + Name;
with TRegistry.Create do
try
RootKey := HKEY_LOCAL_MACHINE;
if OpenKeyReadOnly(KeyName) then
begin
if ValueExists('IsObsolete') then
Result := ReadBool('IsObsolete');
CloseKey;
end;
finally
Free;
end;
end;
function TSuperTimeZone.GetTimeZoneInformation(Year: Word;
var TZI: TTimeZoneInformation): Boolean;
type
TRegistryTZI = packed record
Bias: LongInt;
StandardBias: LongInt;
DaylightBias: LongInt;
StandardChangeTime: TSystemTime;
DaylightChangeTime: TSystemTime;
end;
var
RegTZI: TRegistryTZI;
KeyName: SOString;
FirstYear, LastYear, ChangeYear: Word;
Retry: Boolean;
begin
FillChar(TZI, SizeOf(TZI), 0);
KeyName := TZ_KEY + Name;
with TRegistry.Create do
try
RootKey := HKEY_LOCAL_MACHINE;
if not KeyExists(KeyName) then
begin
Result := False;
Exit;
end;
ChangeYear := 0;
if OpenKeyReadOnly(KeyName + '\Dynamic DST') then
try
FirstYear := ReadInteger('FirstEntry');
LastYear := ReadInteger('LastEntry');
if (Year >= FirstYear) and (Year <= LastYear) then
ChangeYear := Year
else
ChangeYear := 0;
Retry := False;
repeat
while (ChangeYear > 0) and (not ValueExists(IntToStr(ChangeYear))) do
begin
Dec(ChangeYear);
if ChangeYear < FirstYear then
ChangeYear := 0;
end;
if ChangeYear > 0 then
begin
ReadBinaryData(IntToStr(ChangeYear), RegTZI, SizeOf(TRegistryTZI));
if RegTZI.DaylightChangeTime.wMonth > RegTZI.StandardChangeTime.wMonth then
begin
Dec(ChangeYear);
Retry := not Retry;
end;
end;
until not Retry;
finally
CloseKey;
end;
if (ChangeYear = 0) and OpenKeyReadOnly(KeyName) then
try
ReadBinaryData('TZI', RegTZI, SizeOf(TRegistryTZI));
finally
CloseKey;
end;
TZI.Bias := RegTZI.Bias;
TZI.StandardDate := RegTZI.StandardChangeTime;
TZI.StandardBias := RegTZI.StandardBias;
TZI.DaylightDate := RegTZI.DaylightChangeTime;
TZI.DaylightBias := RegTZI.DaylightBias;
Result := True;
finally
Free;
end;
end;
function TSuperTimeZone.TzSpecificLocalTimeToSystemTime(
const lpTimeZoneInformation: PTimeZoneInformation;
var lpLocalTime, lpUniversalTime: TSystemTime): BOOL;
var
ft: TFileTime;
lBias: LongInt;
t: Int64;
begin
Assert(lpTimeZoneInformation <> nil);
if (not SystemTimeToFileTime(lpLocalTime, ft)) then
begin
Result := False;
Exit;
end;
t := PInt64(@ft)^;
if (not GetTimezoneBias(lpTimeZoneInformation, @ft, True, @lBias)) then
begin
Result := False;
Exit;
end;
(* convert minutes to 100-nanoseconds-ticks *)
Inc(t, Int64(lBias) * 600000000);
PInt64(@ft)^ := t;
Result := FileTimeToSystemTime(ft, lpUniversalTime);
end;
function TSuperTimeZone.GetTimezoneBias(const pTZinfo: PTimeZoneInformation;
lpFileTime: PFileTime; islocal: Boolean; pBias: PLongint): Boolean;
var
bias: LongInt;
tzid: LongWord;
begin
bias := pTZinfo^.Bias;
tzid := CompTimeZoneID(pTZinfo, lpFileTime, islocal);
if( tzid = TIME_ZONE_ID_INVALID) then
begin
Result := False;
Exit;
end;
if (tzid = TIME_ZONE_ID_DAYLIGHT) then
Inc(bias, pTZinfo^.DaylightBias)
else if (tzid = TIME_ZONE_ID_STANDARD) then
Inc(bias, pTZinfo^.StandardBias);
pBias^ := bias;
Result := True;
end;
function TSuperTimeZone.CompTimeZoneID(const pTZinfo: PTimeZoneInformation;
lpFileTime: PFileTime; IsLocal: Boolean): LongWord;
var
Ret: Integer;
BeforeStandardDate, AfterDaylightDate: Boolean;
llTime: Int64;
SysTime: TSystemTime;
ftTemp: TFileTime;
begin
llTime := 0;
if (not GetDaylightDisabled) and (pTZinfo^.DaylightDate.wMonth <> 0) then
begin
(* if year is 0 then date is in day-of-week format, otherwise
* it's absolute date.
*)
if ((pTZinfo^.StandardDate.wMonth = 0) or
((pTZinfo^.StandardDate.wYear = 0) and
((pTZinfo^.StandardDate.wDay < 1) or
(pTZinfo^.StandardDate.wDay > 5) or
(pTZinfo^.DaylightDate.wDay < 1) or
(pTZinfo^.DaylightDate.wDay > 5)))) then
begin
SetLastError(ERROR_INVALID_PARAMETER);
Result := TIME_ZONE_ID_INVALID;
Exit;
end;
if (not IsLocal) then
begin
llTime := PInt64(lpFileTime)^;
Dec(llTime, Int64(pTZinfo^.Bias + pTZinfo^.DaylightBias) * 600000000);
PInt64(@ftTemp)^ := llTime;
lpFileTime := @ftTemp;
end;
FileTimeToSystemTime(lpFileTime^, SysTime);
(* check for daylight savings *)
Ret := DayLightCompareDate(@SysTime, @pTZinfo^.StandardDate);
if (Ret = -2) then
begin
Result := TIME_ZONE_ID_INVALID;
Exit;
end;
BeforeStandardDate := Ret < 0;
if (not IsLocal) then
begin
Dec(llTime, Int64(pTZinfo^.StandardBias - pTZinfo^.DaylightBias) * 600000000);
PInt64(@ftTemp)^ := llTime;
FileTimeToSystemTime(lpFileTime^, SysTime);
end;
Ret := DayLightCompareDate(@SysTime, @pTZinfo^.DaylightDate);
if (Ret = -2) then
begin
Result := TIME_ZONE_ID_INVALID;
Exit;
end;
AfterDaylightDate := Ret >= 0;
Result := TIME_ZONE_ID_STANDARD;
if pTZinfo^.DaylightDate.wMonth < pTZinfo^.StandardDate.wMonth then
begin
(* Northern hemisphere *)
if BeforeStandardDate and AfterDaylightDate then
Result := TIME_ZONE_ID_DAYLIGHT;
end
else
begin
(* Down south *)
if BeforeStandardDate or AfterDaylightDate then
Result := TIME_ZONE_ID_DAYLIGHT;
end;
end
else
(* No transition date *)
Result := TIME_ZONE_ID_UNKNOWN;
end;
function TSuperTimeZone.DayLightCompareDate(const date, compareDate: PSystemTime): Integer;
var
limit_day, dayinsecs, weekofmonth: Integer;
First: Word;
begin
if (date^.wMonth < compareDate^.wMonth) then
begin
Result := -1; (* We are in a month before the date limit. *)
Exit;
end;
if (date^.wMonth > compareDate^.wMonth) then
begin
Result := 1; (* We are in a month after the date limit. *)
Exit;
end;
(* if year is 0 then date is in day-of-week format, otherwise
* it's absolute date.
*)
if (compareDate^.wYear = 0) then
begin
(* compareDate.wDay is interpreted as number of the week in the month
* 5 means: the last week in the month *)
weekofmonth := compareDate^.wDay;
(* calculate the day of the first DayOfWeek in the month *)
First := (6 + compareDate^.wDayOfWeek - date^.wDayOfWeek + date^.wDay) mod 7 + 1;
limit_day := First + 7 * (weekofmonth - 1);
(* check needed for the 5th weekday of the month *)
if (limit_day > MonthDays[(date^.wMonth=2) and IsLeapYear(date^.wYear)][date^.wMonth]) then
Dec(limit_day, 7);
end
else
limit_day := compareDate^.wDay;
(* convert to seconds *)
limit_day := ((limit_day * 24 + compareDate^.wHour) * 60 + compareDate^.wMinute ) * 60;
dayinsecs := ((date^.wDay * 24 + date^.wHour) * 60 + date^.wMinute ) * 60 + date^.wSecond;
(* and compare *)
if dayinsecs < limit_day then
Result := -1
else if dayinsecs > limit_day then
Result := 1
else
Result := 0; (* date is equal to the date limit. *)
end;
function TSuperTimeZone.SystemTimeToTzSpecificLocalTime(
const lpTimeZoneInformation: PTimeZoneInformation;
var lpUniversalTime, lpLocalTime: TSystemTime): BOOL;
var
ft: TFileTime;
lBias: LongInt;
llTime: Int64;
begin
Assert(lpTimeZoneInformation <> nil);
if (not SystemTimeToFileTime(lpUniversalTime, ft)) then
begin
Result := False;
Exit;
end;
llTime := PInt64(@ft)^;
if (not GetTimezoneBias(lpTimeZoneInformation, @ft, False, @lBias)) then
begin
Result := False;
Exit;
end;
(* convert minutes to 100-nanoseconds-ticks *)
Dec(llTime, Int64(lBias) * 600000000);
PInt64(@ft)^ := llTime;
Result := FileTimeToSystemTime(ft, lpLocalTime);
end;
class function TSuperTimeZone.ParseISO8601Date(const ISO8601Date: SOString;
var st: TSystemTime; var dayofyear: Integer; var week: Word;
var bias: Integer; var havetz, havedate: Boolean): Boolean;
function get(var v: Word; c: SOChar): Boolean; {$IFDEF HAVE_INLINE} inline; {$ENDIF}
begin
if (c < #256) and (AnsiChar(c) in ['0' .. '9']) then
begin
Result := True;
v := v * 10 + Ord(c) - Ord('0');
end
else
Result := False;
end;
type
TState = (stStart, stYear, stMonth, stWeek, stWeekDay, stDay, stDayOfYear,
stHour, stMin, stSec, stMs, stUTC, stGMTH, stGMTM, stGMTend, stEnd);
TPerhaps = (yes, no, perhaps);
var
p: PSOChar;
sep: TPerhaps;
state: TState;
pos, v: Word;
inctz: Boolean;
label
error;
begin
p := PSOChar(ISO8601Date);
sep := perhaps;
state := stStart;
pos := 0;
inctz := False;
FillChar(st, SizeOf(st), 0);
dayofyear := 0;
week := 0;
bias := 0;
havedate := True;
havetz := False;
while True do
case state of
stStart:
case p^ of
'0' .. '9':
state := stYear;
'T', 't':
begin
state := stHour;
pos := 0;
Inc(p);
havedate := False;
end;
else
goto error;
end;
stYear:
case pos of
0 .. 1, 3:
if get(st.wYear, p^) then
begin
Inc(pos);
Inc(p);
end
else
goto error;
2:
case p^ of
'0' .. '9':
begin
st.wYear := st.wYear * 10 + Ord(p^) - Ord('0');
Inc(pos);
Inc(p);
end;
':':
begin
havedate := False;
st.wHour := st.wYear;
st.wYear := 0;
Inc(p);
pos := 0;
state := stMin;
sep := yes;
end;
else
goto error;
end;
4:
case p^ of
'-':
begin
pos := 0;
Inc(p);
sep := yes;
state := stMonth;
end;
'0' .. '9':
begin
sep := no;
pos := 0;
state := stMonth;
end;
'W', 'w':
begin
pos := 0;
Inc(p);
state := stWeek;
end;
'T', 't', ' ':
begin
state := stHour;
pos := 0;
Inc(p);
st.wMonth := 1;
st.wDay := 1;
end;
#0:
begin
st.wMonth := 1;
st.wDay := 1;
state := stEnd;
end;
else
goto error;
end;
end;
stMonth:
case pos of
0:
case p^ of
'0' .. '9':
begin
st.wMonth := Ord(p^) - Ord('0');
Inc(pos);
Inc(p);
end;
'W', 'w':
begin
pos := 0;
Inc(p);
state := stWeek;
end;
else
goto error;
end;
1:
if get(st.wMonth, p^) then
begin
Inc(pos);
Inc(p);
end
else
goto error;
2:
case p^ of
'-':
if (sep in [yes, perhaps]) then
begin
pos := 0;
Inc(p);
state := stDay;
sep := yes;
end
else
goto error;
'0' .. '9':
if sep in [no, perhaps] then
begin
pos := 0;
state := stDay;
sep := no;
end
else
begin
dayofyear := st.wMonth * 10 + Ord(p^) - Ord('0');
st.wMonth := 0;
Inc(p);
pos := 3;
state := stDayOfYear;
end;
'T', 't', ' ':
begin
state := stHour;
pos := 0;
Inc(p);
st.wDay := 1;
end;
#0:
begin
st.wDay := 1;
state := stEnd;
end;
else
goto error;
end;
end;
stDay:
case pos of
0:
if get(st.wDay, p^) then
begin
Inc(pos);
Inc(p);
end
else
goto error;
1:
if get(st.wDay, p^) then
begin
Inc(pos);
Inc(p);
end
else if sep in [no, perhaps] then
begin
dayofyear := st.wMonth * 10 + st.wDay;
st.wDay := 0;
st.wMonth := 0;
state := stDayOfYear;
end
else
goto error;
2:
case p^ of
'T', 't', ' ':
begin
pos := 0;
Inc(p);
state := stHour;
end;
#0:
state := stEnd;
else
goto error;
end;
end;
stDayOfYear:
begin
if (dayofyear <= 0) then
goto error;
case p^ of
'T', 't', ' ':
begin
pos := 0;
Inc(p);
state := stHour;
end;
#0:
state := stEnd;
else
goto error;
end;
end;
stWeek:
begin
case pos of
0 .. 1:
if get(week, p^) then
begin
Inc(pos);
Inc(p);
end
else
goto error;
2:
case p^ of
'-':
if (sep in [yes, perhaps]) then
begin
Inc(p);
state := stWeekDay;
sep := yes;
end
else
goto error;
'1' .. '7':
if sep in [no, perhaps] then
begin
state := stWeekDay;
sep := no;
end
else
goto error;
else
goto error;
end;
end;
end;
stWeekDay:
begin
if (week > 0) and get(st.wDayOfWeek, p^) then
begin
Inc(p);
v := st.wYear - 1;
v := ((v * 365) + (v div 4) - (v div 100) + (v div 400)) mod 7 + 1;
dayofyear := (st.wDayOfWeek - v) + ((week) * 7) + 1;
if v <= 4 then
Dec(dayofyear, 7);
case p^ of
'T', 't', ' ':
begin
pos := 0;
Inc(p);
state := stHour;
end;
#0:
state := stEnd;
else
goto error;
end;
end
else
goto error;
end;
stHour:
case pos of
0:
case p^ of
'0' .. '9':
if get(st.wHour, p^) then
begin
Inc(pos);
Inc(p);
end
else
goto error;
'-':
begin
Inc(p);
state := stMin;
end;
else
goto error;
end;
1:
if get(st.wHour, p^) then
begin
Inc(pos);
Inc(p);
end
else
goto error;
2:
case p^ of
':':
if sep in [yes, perhaps] then
begin
sep := yes;
pos := 0;
Inc(p);
state := stMin;
end
else
goto error;
',', '.':
begin
Inc(p);
state := stMs;
end;
'+':
if havedate then
begin
state := stGMTH;
pos := 0;
v := 0;
Inc(p);
end
else
goto error;
'-':
if havedate then
begin
state := stGMTH;
pos := 0;
v := 0;
Inc(p);
inctz := True;
end
else
goto error;
'Z', 'z':
if havedate then
state := stUTC
else
goto error;
'0' .. '9':
if sep in [no, perhaps] then
begin
pos := 0;
state := stMin;
sep := no;
end
else
goto error;
#0:
state := stEnd;
else
goto error;
end;
end;
stMin:
case pos of
0:
case p^ of
'0' .. '9':
if get(st.wMinute, p^) then
begin
Inc(pos);
Inc(p);
end
else
goto error;
'-':
begin
Inc(p);
state := stSec;
end;
else
goto error;
end;
1:
if get(st.wMinute, p^) then
begin
Inc(pos);
Inc(p);
end
else
goto error;
2:
case p^ of
':':
if sep in [yes, perhaps] then
begin
pos := 0;
Inc(p);
state := stSec;
sep := yes;
end
else
goto error;
',', '.':
begin
Inc(p);
state := stMs;
end;
'+':
if havedate then
begin
state := stGMTH;
pos := 0;
v := 0;
Inc(p);
end
else
goto error;
'-':
if havedate then
begin
state := stGMTH;
pos := 0;
v := 0;
Inc(p);
inctz := True;
end
else
goto error;
'Z', 'z':
if havedate then
state := stUTC
else
goto error;
'0' .. '9':
if sep in [no, perhaps] then
begin
pos := 0;
state := stSec;
end
else
goto error;
#0:
state := stEnd;
else
goto error;
end;
end;
stSec:
case pos of
0 .. 1:
if get(st.wSecond, p^) then
begin
Inc(pos);
Inc(p);
end
else
goto error;
2:
case p^ of
',', '.':
begin
Inc(p);
state := stMs;
end;
'+':
if havedate then
begin
state := stGMTH;
pos := 0;
v := 0;
Inc(p);
end
else
goto error;
'-':
if havedate then
begin
state := stGMTH;
pos := 0;
v := 0;
Inc(p);
inctz := True;
end
else
goto error;
'Z', 'z':
if havedate then
state := stUTC
else
goto error;
#0:
state := stEnd;
else
goto error;
end;
end;
stMs:
case p^ of
'0' .. '9':
begin
st.wMilliseconds := st.wMilliseconds * 10 + Ord(p^) - Ord('0');
Inc(p);
end;
'+':
if havedate then
begin
state := stGMTH;
pos := 0;
v := 0;
Inc(p);
end
else
goto error;
'-':
if havedate then
begin
state := stGMTH;
pos := 0;
v := 0;
Inc(p);
inctz := True;
end
else
goto error;
'Z', 'z':
if havedate then
state := stUTC
else
goto error;
#0:
state := stEnd;
else
goto error;
end;
stUTC: // = GMT 0
begin
havetz := True;
Inc(p);
if p^ = #0 then
Break
else
goto error;
end;
stGMTH:
begin
havetz := True;
case pos of
0 .. 1:
if get(v, p^) then
begin
Inc(p);
Inc(pos);
end
else
goto error;
2:
begin
bias := v * 60;
case p^ of
':': // if sep in [yes, perhaps] then
begin
state := stGMTM;
Inc(p);
pos := 0;
v := 0;
sep := yes;
end; // else goto error;
'0' .. '9':
// if sep in [no, perhaps] then
begin
state := stGMTM;
pos := 1;
sep := no;
Inc(p);
v := Ord(p^) - Ord('0');
end; // else goto error;
#0:
state := stGMTend;
else
goto error;
end;
end;
end;
end;
stGMTM:
case pos of
0 .. 1:
if get(v, p^) then
begin
Inc(p);
Inc(pos);
end
else
goto error;
2:
case p^ of
#0:
begin
state := stGMTend;
Inc(bias, v);
end;
else
goto error;
end;
end;
stGMTend:
begin
if not inctz then
bias := -bias;
Break;
end;
stEnd:
begin
Break;
end;
end;
if (st.wHour >= 24) or (st.wMinute >= 60) or (st.wSecond >= 60) or
(st.wMilliseconds >= 1000) or (week > 53) then
goto error;
Result := True;
Exit;
error:
Result := False;
end;
end.
Вы можете оставить комментарий после Вход в систему
Неприемлемый контент может быть отображен здесь и не будет показан на странице. Вы можете проверить и изменить его с помощью соответствующей функции редактирования.
Если вы подтверждаете, что содержание не содержит непристойной лексики/перенаправления на рекламу/насилия/вульгарной порнографии/нарушений/пиратства/ложного/незначительного или незаконного контента, связанного с национальными законами и предписаниями, вы можете нажать «Отправить» для подачи апелляции, и мы обработаем ее как можно скорее.
Опубликовать ( 0 )