(*
BSD 2-Clause License
Copyright (c) 2019, Anton Krotov
All rights reserved.
*)
MODULE DateTime;
IMPORT WINAPI;
CONST
ERR* = -7.0E5;
VAR
DateTable: ARRAY 120000, 3 OF INTEGER;
MonthsTable: ARRAY 13, 4 OF INTEGER;
PROCEDURE Encode* (Year, Month, Day, Hour, Min, Sec, MSec: INTEGER): REAL;
VAR
d, bis: INTEGER;
res: REAL;
BEGIN
res := ERR;
IF (Year >= 1) & (Year <= 9999) & (Month >= 1) & (Month <= 12) &
(Day >= 1) & (Day <= 31) & (Hour >= 0) & (Hour <= 23) &
(Min >= 0) & (Min <= 59) & (Sec >= 0) & (Sec <= 59) &
(MSec >= 0) & (MSec <= 999) THEN
bis := ORD((Year MOD 4 = 0) & (Year MOD 100 # 0) OR (Year MOD 400 = 0));
IF Day <= MonthsTable[Month][2 + bis] THEN
DEC(Year);
d := Year * 365 + (Year DIV 4) - (Year DIV 100) + (Year DIV 400) +
MonthsTable[Month][bis] + Day - 693594;
res := FLT(d) + FLT(Hour * 3600000 + Min * 60000 + Sec * 1000 + MSec) / 86400000.0
END
END
RETURN res
END Encode;
PROCEDURE Decode* (Date: REAL; VAR Year, Month, Day, Hour, Min, Sec, MSec: INTEGER): BOOLEAN;
VAR
res: BOOLEAN;
d, t: INTEGER;
L, R, M: INTEGER;
BEGIN
res := (Date >= -693593.0) & (Date < 2958466.0);
IF res THEN
d := FLOOR(Date);
t := FLOOR((Date - FLT(d)) * 86400000.0);
INC(d, 693593);
L := 0;
R := LEN(DateTable) - 1;
M := (L + R) DIV 2;
WHILE R - L > 1 DO
IF d > DateTable[M][0] THEN
L := M;
M := (L + R) DIV 2
ELSIF d < DateTable[M][0] THEN
R := M;
M := (L + R) DIV 2
ELSE
L := M;
R := M
END
END;
Year := DateTable[L][1];
Month := DateTable[L][2];
Day := d - DateTable[L][0] + 1;
Hour := t DIV 3600000; t := t MOD 3600000;
Min := t DIV 60000; t := t MOD 60000;
Sec := t DIV 1000;
MSec := t MOD 1000
END
RETURN res
END Decode;
PROCEDURE Now* (VAR Year, Month, Day, Hour, Min, Sec, MSec: INTEGER);
VAR
T: WINAPI.TSystemTime;
BEGIN
WINAPI.GetLocalTime(T);
Year := ORD(T.Year);
Month := ORD(T.Month);
Day := ORD(T.Day);
Hour := ORD(T.Hour);
Min := ORD(T.Min);
Sec := ORD(T.Sec);
MSec := ORD(T.MSec)
END Now;
PROCEDURE NowEncode* (): REAL;
VAR
Year, Month, Day, Hour, Min, Sec, MSec: INTEGER;
BEGIN
Now(Year, Month, Day, Hour, Min, Sec, MSec)
RETURN Encode(Year, Month, Day, Hour, Min, Sec, MSec)
END NowEncode;
PROCEDURE init;
VAR
day, year, month, i: INTEGER;
Months: ARRAY 13 OF INTEGER;
BEGIN
Months[1] := 31; Months[2] := 28; Months[3] := 31; Months[4] := 30;
Months[5] := 31; Months[6] := 30; Months[7] := 31; Months[8] := 31;
Months[9] := 30; Months[10] := 31; Months[11] := 30; Months[12] := 31;
day := 0;
year := 1;
month := 1;
i := 0;
WHILE year <= 10000 DO
DateTable[i][0] := day;
DateTable[i][1] := year;
DateTable[i][2] := month;
INC(day, Months[month]);
IF (month = 2) & ((year MOD 4 = 0) & (year MOD 100 # 0) OR (year MOD 400 = 0)) THEN
INC(day)
END;
INC(month);
IF month > 12 THEN
month := 1;
INC(year)
END;
INC(i)
END;
MonthsTable[1][0] := 0;
FOR i := 2 TO 12 DO
MonthsTable[i][0] := MonthsTable[i - 1][0] + Months[i - 1]
END;
FOR i := 1 TO 12 DO
MonthsTable[i][2] := Months[i]
END;
Months[2] := 29;
MonthsTable[1][1] := 0;
FOR i := 2 TO 12 DO
MonthsTable[i][1] := MonthsTable[i - 1][1] + Months[i - 1]
END;
FOR i := 1 TO 12 DO
MonthsTable[i][3] := Months[i]
END
END init;
BEGIN
init
END DateTime.