Subversion Repositories Kolibri OS

(*

    BSD 2-Clause License

    Copyright (c) 2019-2020, Anton Krotov

    All rights reserved.

*)

MODULE DateTime;

IMPORT WINAPI, SYSTEM;

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 NowUnixTime* (): INTEGER;

    RETURN WINAPI.time(0)

END NowUnixTime;

PROCEDURE UnixTime* (Year, Month, Day, Hour, Min, Sec: INTEGER): INTEGER;

VAR

    t: WINAPI.tm;

BEGIN

    DEC(Year, 1900);

    DEC(Month);

    SYSTEM.GET(SYSTEM.ADR(Sec),   t.sec);

    SYSTEM.GET(SYSTEM.ADR(Min),   t.min);

    SYSTEM.GET(SYSTEM.ADR(Hour),  t.hour);

    SYSTEM.GET(SYSTEM.ADR(Day),   t.mday);

    SYSTEM.GET(SYSTEM.ADR(Month), t.mon);

    SYSTEM.GET(SYSTEM.ADR(Year),  t.year);

    RETURN WINAPI.mktime(t)

END UnixTime;

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.