program test;
{$MODE OBJFPC}
uses
Math, SysUtils;
///////////////////////////////////////////////////////////////////////////////
const
HoursPerDay = 24;
MinsPerHour = 60;
SecsPerMin = 60;
MSecsPerSec = 1000;
MinsPerDay = HoursPerDay * MinsPerHour;
SecsPerDay = MinsPerDay * SecsPerMin;
MSecsPerDay = SecsPerDay * MSecsPerSec;
{TDateTime holds the date as the number of days since 30 Dec 1899, known as
Microsoft Excel epoch}
JulianEpoch = TDateTime(-2415018.5);
UnixEpoch = JulianEpoch + TDateTime(2440587.5);
const
TDateTimeEpsilon = 2.2204460493e-16;
{ TDateTime is not defined in the interval [-1.0..0.0[. Additionally, when
negative the time part must be treated using its absolute value (0.25 always
means "6 a.m.") -> skip the gap and convert the time part when crossing the
gap -- and take care of rounding errors }
Procedure MaybeSkipTimeWarp(OldDate: TDateTime; var NewDate: TDateTime);
begin
if (OldDate>=0) and (NewDate<-TDateTimeEpsilon) then
NewDate:=int(NewDate-1.0+TDateTimeEpsilon)-frac(1.0+frac(NewDate))
else if (OldDate<=-1.0) and (NewDate>-1.0+TDateTimeEpsilon) then
NewDate:=int(NewDate+1.0-TDateTimeEpsilon)+frac(1.0-abs(frac(1.0+NewDate)));
end;
function IncNegativeTime(AValue, Addend: TDateTime): TDateTime;
var
newtime: tdatetime;
begin
newtime:=-frac(Avalue)+frac(Addend);
{ handle rounding errors }
if SameValue(newtime,int(newtime)+1,TDateTimeEpsilon) then
newtime:=int(newtime)+1
else if SameValue(newtime,int(newtime),TDateTimeEpsilon) then
newtime:=int(newtime);
{ time underflow -> previous day }
if newtime<-TDateTimeEpsilon then
begin
newtime:=1.0+newtime;
avalue:=int(avalue)-1;
end
{ time overflow -> next day }
else if newtime>=1.0-TDateTimeEpsilon then
begin
newtime:=newtime-1.0;
avalue:=int(avalue)+1;
end;
Result:=int(AValue)+int(Addend)-newtime;
end;
Function DateTimeDiff(const ANow, AThen: TDateTime): TDateTime;
begin
Result:= ANow - AThen;
if (ANow>0) and (AThen<0) then
Result:=Result-0.5
else if (ANow<-1.0) and (AThen>-1.0) then
Result:=Result+0.5;
end;
Function IncSecond(const AValue: TDateTime; const ANumberOfSeconds: Int64): TDateTime;
begin
if AValue>=0 then
Result:=AValue+ANumberOfSeconds/SecsPerDay
else
Result:=IncNegativeTime(Avalue,ANumberOfSeconds/SecsPerDay);
MaybeSkipTimeWarp(AValue,Result);
end;
Function DateTimeToUnix(const AValue: TDateTime): Int64;
begin
Result:=Round(DateTimeDiff(AValue,UnixEpoch)*SecsPerDay);
end;
Function UnixToDateTime(const AValue: Int64): TDateTime;
begin
Result:=IncSecond(UnixEpoch, AValue);
end;
///////////////////////////////////////////////////////////////////////////////
procedure TestDate;
var
fec1: TDateTime;
fec2: TDateTime;
feca1: int64 absolute fec1;
feca2: int64 absolute fec2;
n: LongInt;
begin
fec1 := now;
n := DateTimeToUnix(fec1);
writeln(DateTimeToStr(fec1), ' = ', n, ' (',feca1,')');
fec2 := UnixToDateTime(n);
writeln(DateTimeToStr(fec2), ' = ', n, ' (',feca2,')');
writeln;
end;
var
i : Integer;
begin
for i := 1 to 10 do
begin
TestDate;
sleep(1000);
end;
end.
Recent
