ruberon/lib/Windows/DateTime.ob07

(*
    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.