{************************************************}
{                                                }
{   Turbo Pascal 6.0                             }
{   Turbo Vision Demo                            }
{   Copyright (c) 1990 by Borland International  }
{                                                }
{************************************************}
unit dateu;{in log}
{$I define.pas}
{ $I nodebug.pas}

{$F+,O+,X+}

interface

uses
  TVType, MyType, Stru, MyLib, LogType,
  Msgu
{$IFDEF RTKERNEL}
  ,RTClock
{$ENDIF}
{$IFNDEF WINDOWS}
  ,dos
{$ELSE}
  ,SysUtils, Classes
{$ENDIF}
  {datetype};

const
  dowStyle:word = dowMo;  {variable that defines what style will have
                          the calender: Mo->Su, or  Su->Sa}

var
   MonthStr: array[1..12] of string[10];
{     ('January   ',
      'February  ',
      'March     ',
      'April     ',
      'May       ',
      'June      ',
      'July      ',
      'August    ',
      'September ',
      'October   ',
      'November  ',
      'December  ');
}

type
  {PDateTimeObject = ^TDateTimeObject;}
  TDateTimeObject = class(TObject)
    Year, Month, Day, Hour, Minute, Second, Sec100:word;
    constructor Create;{zeroes all above vars}
    procedure GetSystemTime;{sets its time to current system time}
    {$IFDEF RTKERNEL}
    procedure GetRTClockTime;
    {$ENDIF}
    procedure IncDate(incUnit, increment:integer);{increments its date in units:
      incDay, incWeek, incMonth, incYear}
    function ToTheEndOfYearInSeconds:longint;
    function UpTodayThisYearInSeconds:longint;
    function YearInSeconds:Longint;
    function MonthInSeconds:Longint;
    function TodayInSeconds:longint;

    procedure IncTime(incUnit:integer; increment:Longint);{incSecond, incMinute, incHour}
    procedure SetDate(AYear, AMonth, ADay:Word);
    procedure SetDateString(ADateString:TDateString);{YYYYMMDD}
    procedure SetShortDateString(ADateString:TDateString);{YYMMDD}
    procedure SetTimeString(ATimeString:TDateString);{HHMMSS}
    procedure SetDateTimeString(ADateTimeString:TDateTimeString);{YYYYMMDDHHMMSS}
    procedure SetShortDateTimeString(ADateTimeString:TDateTimeString);{YYMMDD[HH[MM[SS]]]}

    procedure SetDay(ADay:longint);
    procedure SetYear(AYear:longint);
    procedure SetMonth(AMonth:longint);

    procedure SetPackedDate(L:LongInt);{sets a packed data/time info in l to itself}
    procedure GetFileTime(AFileName:PathStr);{assigns the File's date to itself}
    procedure SetFileTime(AFileName:PathStr);{sets its date/time to the File}
    function GetPackedDate:Longint;{returns its date/time info in the packed form}
    function DOW:word;{returns day of week of its date, Mo = 0,...}

    function DDOW:word;{returns day of week in two weeks range:
      0..6 odd week's Mo-Su, 7-13 even week's Mo-Su}
    function DayNumber:Integer;{in the year}
    function WeekNumber:Integer;{in the year}
    function WeekIsEven:boolean;
    function WeekNumberInMonth:integer;

    function DayString:TDayString;{DD}
    function DD:TDayString;{the same}
    function MonthString:TMonthString;{MM}
    function YYYYMM:TDateString;
    function YYMM:TDateString;
    function YYMMDD:TDateString;
    function YYYYMMDD:TDateString;
    function MMDD:TDateString;
{    function GetLogTime:TDateTimeString;}
    procedure SetTime(AHour, AMinute, ASecond:word);
    function DateString:TDateString;{YYYYMMDD}
    function TimeString:TTimeString;{HHMMSS}
    function YearString:TYearString;{YYYY}
    function MI:TTimeString;
    function HH:TTimeString;
    function HHMM:TTimeString;
    function DaysInMonth:integer;
    function SecondsInDay:LongInt;
    function DayMonthString:TDateString;{DD.MM.}
    function GetDatum:TDateTimeString;{DD.MM.YYYY}
    function GetShortDatum:TDateTimeString;{[D]D.[M]M.YY}
    function MonthYearDatum:TDateString;{MM/YYYY}
    function GetCas:TDateTimeString;{HH:MM:SS}
    function DateTimeString:TDateTimeString;{YYYYMMDDHHMMSS}
    function MonthYearString:TDateString;{MM.YYYY}
    function Compare(ADT:TDateTimeObject; Start,Len:integer):integer;
    function CompareDates(ADT:TDateTimeObject):integer;
    function CompareTimes(ADT:TDateTimeObject):Integer;
    function IsValid:boolean;{existing date?, does NOT check time}
    function IsValidDate:boolean;{the same as the above, just clearer name}
    function IsValidTime:boolean;
    function IsFuture:boolean;{today or later?}
    procedure Clear;

{made in windows:}
{    function IsValidTime:boolean;}
    function SFDateString:TDateString;{YYYY-MM-DD}
    function SFTimeString:TTimeString;{HH:MM}
    procedure SetSFDateString(ADate:TDateString);{YYYY-MM-DD}
    procedure SetSFTimeString(ATime:TTimeString);{HH:MM}

  end;

  TDTO = TDateTimeObject;
  PDTO = TDTO;

function GetIntervalInMinutes(Time1, Time2:TDateTimeObject):longint;
function GetIntervalInSeconds(Time1, Time2:TDateTimeObject):longint;

function GetDateString(Year, Month, Day: integer): TDateString;{returns YYYYMMDD}
function GetTodayDateString: TDateString;
function GetTimeString(hour, minute, second: integer): TDateString;{returns HHMM}
function GetMonthStr(AYear, AMonth:word):TDateString;

function DaysInMonth(Year, Month: Integer) : Integer;
function DayOfWeek(Year, Month, Day: Integer) : Integer;
{returns 0 for Su, if dowStyle = dowSunday, 0 for Mo, if dowStyle = dowMonday}

function RemDOWToDOW(dow:integer):integer;{converts reminder 2 style
day of week numbering (i.e. 1 for Su, etc.) to current (dowStyle dependent) dow numbering}

function AbsDayOfWeek(Year, Month, Day: Integer) : Integer;
{returns 1 for Su.. 7 for Sa, regardles of anything, used for Reminder 2}

procedure GetXthDayOfWeekInMonth(year, month, wom, dow:Integer; var day:integer);
{gets Xth(womi) day of week (dow, 1 for sunday) in the month (e.g. first sunday in march)}

{function WeekOfYear(Year, Month, Day:Integer): Integer;}
{retuns the number of the week, this date is in, in the year}

{from FAQPAS:}
function FirstThursday(Year: Integer) : Integer;
function DayNumber(Day, Month, Year : Integer):Integer;
function WeekNumber(Day, Month, Year : Integer):Integer;
{END FAQPAS}

procedure GetPeriodDate(Year, Month, Day, Period : Integer;
          var NewYear, NewMonth, NewDay: Integer); {counts the date that
            will be from the day, month, year after Period days}
function GetPeriodInDays(Year1, Month1, Day1, Year2, Month2, Day2: Integer): Integer;
         {counts number of days between two dates, 2 must be later then 1}
function GetIntervalInDays(Date1, Date2:TDateTimeObject):longint;{as the above but for objects}
function DaysInYear(Year:Integer): Integer;
function DaysToEndOfYear(Year, Month, Day: Integer): Integer;
function DaysFromBegOfYear(Year, Month, Day: Integer): Integer;
function GetPackedSystemDate:Longint;

const

  {constants for determining what incUnit to use in the IncDate proc.}
  incDay = 0;
  incWeek = 1;
  incMonth = 2;
  incYear = 3;

procedure IncDate(var year, month, day: Integer; incUnit, Increment: Integer);
{increments date by given amount of units }
{logtype
const
  incSecond = 5;
  incMinute = 6;
  incHour = 7;
}

function DTInit:PDTO;{date/time object}{$IFDEF PMODE}export;{$ENDIF}
function DTDone(ADTO:PDTO):DTResult;{$IFDEF PMODE}export;{$ENDIF}
function DTSet(ADTO:PDTO; AProperty:Integer; AValue:Longint):DTResult;{$IFDEF PMODE}export;{$ENDIF}
function DTGet(ADTO:PDTO; AProperty:Integer):Longint;{$IFDEF PMODE}export;{$ENDIF}
function DTDo(ADTO:PDTO; AAction:integer; AInfo:Longint):DTResult;{$IFDEF PMODE}export;{$ENDIF}
function DTGetStr(ADTO:PDTO; AProperty:integer):String;{$IFDEF PMODE}export;{$ENDIF}
function DTSetStr(ADTO:PDTO; AProperty:integer; AValue:string):DTResult;{$IFDEF PMODE}export;{$ENDIF}
function DTAssign(ADTO:PDTO; ADTO2:PDTO):DTResult;{$IFDEF PMODE}export;{$ENDIF}
function DTNow:PDTO;{$IFDEF PMODE}export;{$ENDIF}
{$IFDEF WINDOWS}
{$IFNDEF WIN32}

{
type
  DateTime = record
    Year,Month,Day,Hour,Min,Sec: Word;
  end;

  TFileRec = record
    Handle: Word;
    Mode: Word;
    RecSize: Word;
    Private: array[1..26] of Byte;
    UserData: array[1..16] of Byte;
    Name: array[0..79] of Char;
  end;

  PTextBuf = ^TTextBuf;
  TTextBuf = array[0..127] of Char;
  TTextRec = record
    Handle: Word;
    Mode: Word;
    BufSize: Word;
    Private: Word;
    BufPos: Word;
    BufEnd: Word;
    BufPtr: PTextBuf;
    OpenFunc: Pointer;
    InOutFunc: Pointer;
    FlushFunc: Pointer;
    CloseFunc: Pointer;
    UserData: array[1..16] of Byte;
    Name: array[0..79] of Char;
    Buffer: TTextBuf;
  end;
}
procedure GetFTime(var F; var Time: Longint);
procedure SetFTime(var F; Time: Longint);
procedure PackTime(var T: DateTime; var Time: Longint);
procedure UnpackTime(Time: Longint; var DT: DateTime);
procedure GetDate(var Year, Month, Day, DayOfWeek:word);
procedure GetTime(var Hour, Minute, Second, Sec100: Word);
{$ENDIF}
{$ENDIF}

implementation
{$IFDEF WINDOWS}
{uses logu;}
{$ENDIF}
var
  Now:TDTO;
{$IFDEF WINDOWS}

procedure GetFTime(var F; var Time: Longint);
begin
  Time := SysUtils.FileGetDate(TFileRec(F).Handle)
end;

procedure SetFTime(var F; Time: Longint);
begin
  SysUtils.FileSetDate(TFileRec(F).Handle, Time);
end;

procedure PackTime(var T: DateTime; var Time: Longint);
var DT: System.TDateTime;
begin
  DT := SysUtils.EncodeDate(T.Year, T.Month, T.Day)
    + SysUtils.EncodeTime(T.Hour, T.Min, T.Sec, 0);
  Time := SysUtils.DateTimeToFileDate(DT);
end;


procedure UnpackTime(Time: Longint; var DT: DateTime);
var T: System.TDateTime; ms:word;
begin
  T := FileDateToDateTime(Time);
  DecodeTime(T, DT.Hour, DT.Min, DT.Sec, ms);
  DecodeDate(T, DT.Year, DT.Month, DT.Day);
end;

procedure GetDate(var Year, Month, Day, DayOfWeek:word);
var T:System.TDateTime;
begin
  T := SysUtils.Date;
  DecodeDate(T, Year, Month, Day);
  DayOfWeek := SysUtils.DayOfWeek(T) - 1;
end;

procedure GetTime(var Hour, Minute, Second, Sec100: Word);
var T:System.TDateTime;
begin
  T := SysUtils.Time;
  DecodeTime(T, Hour, Minute, Second, Sec100);
  Sec100 := Sec100 div 10;
end;

{$ENDIF}

function GetDateString(Year, Month, Day: integer): TDateString;
var st, s: TDateString;
begin
  str(Year, s);
  st := lzero(s,4);
  str(Month, s);
  st := st + lzero(s, 2);
  str(Day, s);
  st := st + lzero(s, 2);
  GetDateString := st;
end;

function GetTodayDateString: TDateString;
var y,m,d,dow:word;
begin
  GetDate(y,m,d,dow);
  GetTodayDateString := GetDateString(y,m,d);
end;

function GetTimeString(hour, minute, second: integer): TDateString;
var st, s: TDateString;
begin
  str(hour, s);
  st := lzero(s,2);
  str(minute, s);
  st := st + lzero(s, 2);
  str(second, s);
  st := st + lzero(s, 2);
  GetTimeString := st;
end;


function GetMonthStr(AYear, AMonth:word):TDateString;
begin
  GetMonthStr := system.copy(GetDateString(AYear, AMonth, 1), 3, 4);
end;


function DaysInMonth(Year, Month: Integer) : Integer;
const  DaysInMonthArr: array[1..12] of Byte =
     (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
begin
  DaysInMonth := DaysInMonthArr[Month] + Byte((Year mod 4 = 0) and (Month = 2));
end;

function DayOfWeek(Year, Month, Day: Integer) : Integer;
var
  century, yr, dw: Integer;
begin
  if Month < 3 then
  begin
    Inc(Month, 10);
    Dec(Year);
  end
  else
     Dec(Month, 2);
  century := Year div 100;
  yr := year mod 100;
  dw := (((26 * month - 2) div 10) + day + yr + (yr div 4) +
    (century div 4) - (2 * century)) mod 7;

  if dowStyle = dowMo then
    dec(dw);
  if dw < 0 then dw := dw + 7;
  DayOfWeek := dw;
end;

function RemDOWToDOW(dow:integer):integer;{converts reminder 2 style
day of week numbering (i.e. 1 for Su, etc.) to current (dowStyle dependent) dow numbering}
begin
  dec(dow);
  if dowStyle = dowMo then
    dec(dow);
  if dow < 0 then
    inc(dow, 7);
  RemDOWToDOW := dow;
end;

function AbsDayOfWeek(Year, Month, Day: Integer) : Integer;
{returns 1 for Su, etc., regardles of dowStyle variable, see above}
var dw:integer;
begin
  dw := DayOfWeek(year, month, day);
  if dowStyle = dowMo then
    inc(dw);
  if dw > 6 then dw := dw - 7;
  inc(dw);
  AbsDayOfWeek := dw;
end;

procedure GetXthDayOfWeekInMonth(year, month, wom, dow:Integer; var day:integer);
var om:integer;
begin
  day := 1;
  if dow < 1 then dow := 1;
  if dow > 7 then dow := 1;
  while dow <> AbsDayOfWeek(year, month, day) do
    IncDate(year, month, day, incDay, 1);
  om := month;
  while (wom > 1) and (om = month) do begin
    IncDate(year, month, day, incWeek, 1);
    dec(wom);
  end;
end;

(*
function WeekOfYear(Year, Month, Day:Integer): Integer;
{retuns the number of the week, this date is in, in the year}
var d, w, dow, m: integer;
begin
{asi je to uplne blbe, ale nak mi to nemysli}
  d := DaysFromBegOfYear(year, month, day);
  w := d div 7;
  m := d mod 7;
  dow := 7 - AbsDayOfWeek(year, 1, 1); {pocet dnu na zacatku roku,
             ktere jsou v tydnu zacinajicim loni}
  if dow < 3 then {kdyz je mensi nez nejake cislo, pocitaji se k lonsku}
    m := m - dow;
  if m > 0  then inc(w);
  WeekOfYear := w;
end;
*)

{from FAQPAS4:}
function FirstThursday (Year: Integer) : Integer;
begin
  FirstThursday := 7 - (1 + (Year-1600) + (Year-1597) div 4
  - (Year-1501) div 100 + (Year-1201) div 400) mod 7;
end;

function DayNumber (Day, Month, Year : Integer) : Integer;
const
  DaysBeforeMonth : array [1..12] of Integer =
  (0,31,59,90,120,151,181,212,243,273,304,334);
begin
  DayNumber := DaysBeforeMonth[Month] + Day + Ord( (Month > 2) and
    (Year mod 4 = 0) and ((Year mod 100 <> 0) or (Year mod 400 = 0)) ) ;
end;

function WeekNumber (Day, Month, Year : Integer ) : Integer;
var
  w,n:integer;
begin
  w := DayNumber(Day, Month, Year);
  n := (w - 1 + DaysInWeek) div DaysInWeek;
  w := (w - 1) mod DaysInWeek;
  if w > DayOfWeek(Year, Month, Day){DOW} then
    inc(n);
  WeekNumber := n;

{
  if (Month = 1) and (Day < FirstThursday(Year)-3) then
    WeekNumber := WeekNumber(31,12,Pred(Year))
  else
    if (Month = 12) and (Day > FirstThursday(Succ(Year))+27) then
    WeekNumber := 1
  else
    WeekNumber := (DayNumber(Day,Month,Year)-FirstThursday(Year)+10) div 7;
}
end;
{END FAQPAS4}

procedure GetPeriodDate(Year, Month, Day, Period : Integer;
          var NewYear, NewMonth, NewDay: Integer); {counts the date that
            will be from the day, month, year after Period days,
            Period can be < 0}
var dim : integer;
begin
{$IFDEF DEBUG}
  if Year < 1980 then
    Year := 1980
  else if Year > 2099 then
    Year := 2099;

  if Month > 12 then
    Month := 12
  else if Month < 1 then
    Month := 1;

  if Day < 1 then
    Day := 1
  else if Day > DaysInMonth(Year, Month) then
    Day := DaysInMonth(Year, Month);
{$ENDIF}

  NewDay := Day;
  NewMonth := Month;
  NewYear := Year;
  if Period > 0 then begin
    while Period > 0 do begin
      dim := DaysInMonth(NewYear, NewMonth);
      if NewDay + Period > dim then begin
        Period := Period - (dim - NewDay) - 1;
        NewDay := 1;
        inc(NewMonth);
        if NewMonth > 12 then begin
          inc(NewYear);
          NewMonth := 1;
        end;
      end else begin
        NewDay := NewDay + Period;
        Period := 0;
      end;
    end;
  end else begin
    Period := - Period;
    dim := NewDay;
    while Period > 0 do begin
      if NewDay - Period > 0 then begin
        NewDay := NewDay - Period;
        Period := 0;
      end else begin
        Period := Period - dim;
        dec(NewMonth);
        if NewMonth = 0 then begin
          NewMonth := 12;
          dec(NewYear);
        end;
        dim := DaysInMonth(NewYear, NewMonth);
        NewDay := dim;
      end;
    end;
  end;
end;

function GetPeriodInDays(Year1, Month1, Day1, Year2, Month2, Day2: Integer): Integer;
         {counts number of days between two dates, 2 must be later then 1}
var period:integer;
begin
  if year1 < year2 then begin
    period := DaysToEndOfYear(Year1, Month1, Day1);
    inc(year1);
    while (year1 < year2) do begin
      inc(period, DaysInYear(year1));
      inc(year1);
    end;
    inc(period, DaysFromBegOfYear(Year2, Month2, Day2));
  end else
    period := DaysFromBegOfYear(Year2, Month2, Day2) - DaysFromBegOfYear(Year1, Month1, Day1);
  GetPeriodInDays := period;
end;

function GetIntervalInDays(Date1, Date2:TDateTimeObject):longint;{as the above but for objects}
begin
  GetIntervalInDays := GetPeriodInDays(Date1.Year, Date1.Month, Date1.Day,
    Date2.Year, Date2.Month, Date2.Day);
end;


procedure IncDate(var year, month, day: Integer; incUnit, Increment: Integer);
var Decrement:Integer;
begin
  if Increment > 0 then begin
    case incUnit of
      incYear: inc(year, Increment);
      incMonth: begin
        inc(month, Increment);
        while month > 12 do begin
          dec(month, 12);
          inc(year);
        end;
        if day > DaysInMonth(year, month) then
          day := DaysInMonth(year, month);
      end;
      incDay: begin
        GetPeriodDate(Year, Month, Day, Increment, Year, Month, Day);
      end;
      incWeek: begin
        GetPeriodDate(Year, Month, Day, Increment * 7, Year, Month, Day);
      end;
    end;
  end else begin
    Decrement := - Increment;
    case incUnit of
      incYear: dec(year, Decrement);
      incMonth: begin
        while Decrement > 12 do begin
          dec(year);
          dec(Decrement, 12);
        end;
        dec(month, Decrement);
        if month <= 0 then begin
          dec(year);
          inc(month, 12);
        end;
        if day > DaysInMonth(year, month) then
          day := DaysInMonth(year, month);
      end;
      incDay: begin
        GetPeriodDate(Year, Month, Day, Increment, Year, Month, Day);
      end;
      incWeek: begin
        GetPeriodDate(Year, Month, Day, Increment * 7, Year, Month, Day);
      end;
    end;
  end;
end;

function DaysInYear(Year:Integer): Integer;
begin
  DaysInYear := 365 + Byte(Year mod 4 = 0);
end;

function DaysToEndOfYear(Year, Month, Day: Integer): Integer;
var i, d: Integer;
begin
  d := DaysInMonth(Year, Month) - Day;
  for i := succ(Month) to 12 do
    d := d + DaysInMonth(Year, i);
  DaysToEndOfYear := d;
end;

function DaysFromBegOfYear(Year, Month, Day: Integer): Integer;
var i, d: Integer;
begin
  d := Day;
  for i := 1 to pred(Month) do
    d := d + DaysInMonth(Year, i);
  DaysFromBegOfYear := d;
end;

function GetPackedSystemDate:Longint;
var t:TDateTimeObject;
begin
  t := TDTO.Create;
  t.GetSystemTime;
  GetPackedSystemDate := t.GetPackedDate;
  t.Free;
end;

constructor TDateTimeObject.Create;
begin
  {inherited Create;}
  Year := 0;
  Month := 0;
  Day := 0;
  Hour := 0;
  Minute := 0;
  Second := 0;
  Sec100 := 0;
{  GetSytemTime;}
end;

procedure TDateTimeObject.GetSystemTime;
var d:word;
begin
  {$IFNDEF WINDOWS}Dos.{$ENDIF}GetDate(Year, Month, Day, D);
  {$IFNDEF WINDOWS}Dos.{$ENDIF}GetTime(Hour, Minute, Second, Sec100);
end;

{$IFDEF RTKERNEL}
procedure TDateTimeObject.GetRTClockTime;
begin
  RTClock.GetDate(Year, Month, Day);
  RTClock.GetTime(Hour, Minute, Second);
end;
{$ENDIF}

procedure TDateTimeObject.IncDate(incUnit, increment:integer);
var y,m,d:integer;
begin
  y:=year;m:=month;d:=day;
  dateu.incdate(y,m,d,incUnit,increment);
  year := y; month:=m; day := d;
end;



function TDateTimeObject.ToTheEndOfYearInSeconds:longint;
var i, l:longint;
begin
  l := 0;
  if Month > 0 then{i.e. using only time part of the object}
    for i := (Month + 1) to 12 do
      inc(l, dateu.DaysInMonth(Year, i) * DayInSeconds);
  if Day > 0 then
    inc(l, (DaysInMonth - Day) * DayInSeconds);
  ToTheEndOfYearInSeconds := l + longint(24 - Hour) * HourInSeconds + longint(60 - Minute) * MinuteInSeconds + (60 - Second);
end;

function TDateTimeObject.UpTodayThisYearInSeconds:longint;
var i, l:longint;
begin
  l := 0;
  if Month > 0 then{i.e. using only time part of the object}
    for i := 1 to pred(Month) do
      inc(l, dateu.DaysInMonth(Year, i) * DayInSeconds);
  if Day > 0 then
    inc(l, pred(Day) * DayInSeconds);
  UpTodayThisYearInSeconds := l + longint(Hour) * HourInSeconds + longint(Minute) * MinuteInSeconds + Second;
end;

function TDateTimeObject.YearInSeconds:Longint;
var l:longint;
begin
  l := 365 * DayInSeconds;
  if dateu.DaysInMonth(year, 2) = 29 then
    inc(l, DayInSeconds);
  YearInSeconds := l;
end;

function TDateTimeObject.MonthInSeconds:Longint;
begin
  MonthInSeconds := longint(DaysInMonth) * DayInSeconds;
end;


function TDateTimeObject.TodayInSeconds:longint;
begin
  TodayInSeconds := longint(Hour) * HourInSeconds + longint(Minute) * MinuteInSeconds + longint(Second);
end;

procedure TDateTimeObject.IncTime(incUnit:integer; increment:Longint);
{var y,m,d:integer;}
var l:Longint;
begin
  if increment = 0 then
    exit;
  case incUnit of
    incSecond : begin
      if increment < 0 then begin
        increment := - increment;
        l := UpTodayThisYearInSeconds;
        month := 1;
        day := 1;
        hour := 0;
        minute := 0;
        second := 0;
        while increment > l do begin
          dec(increment, l);
          incDate(incYear, -1);
          l := YearInSeconds;
        end;
        incTime(incSecond, l - increment);
      end else begin
        l := ToTheEndOfYearInSeconds;
        while l < increment do begin
          inc(increment, -l);
          incDate(incYear, 1);
          month := 1;
          day := 1;
          hour := 0;
          minute := 0;
          second := 0;
          l := YearInSeconds;
        end;

        l := MonthInSeconds;
        while l < increment do begin
          inc(increment, -l);
          incDate(incMonth, 1);
          l := MonthInSeconds;
        end;

        increment := increment + TodayInSeconds;
        l := increment div DayInSeconds;
        if l <> 0 then begin
          incDate(incDay, l);
          increment := increment mod DayInSeconds;
        end;

        Hour := increment div HourInSeconds;
        increment := increment mod HourInSeconds;

        Minute := increment div MinuteInSeconds;
        Second := increment mod MinuteInSeconds;
      end;{increment > 0}
    end;{incSecond}
    incMinute: begin
      incTime(incSecond, increment * MinuteInSeconds);
    end;
    incHour : begin
      incTime(incSecond, increment * HourInSeconds);
    end;
  end;
{
  y:=year;m:=month;d:=day;
  dates.incdate(y,m,d,incUnit,increment);
  year := y; month:=m; day := d;
}
end;



procedure TDateTimeObject.SetShortDateString(ADateString:TDateString);{YYMMDD}
begin
  if system.copy(ADateString,1,2) < '80' then
    SetDateString('20'+ADateString)
  else
    SetDateString('19'+ADateString);
end;

procedure TDateTimeObject.SetDateString(ADateString:TDateString);
var
 code:integer;
begin
  val(system.copy(ADateString, 1, 4), year, code);
  val(system.copy(ADateString, 5, 2), month, code);
  val(system.copy(ADateString, 7, 2), day, code);
end;

procedure TDateTimeObject.SetTimeString(ATimeString:TDateString);
var
  code:integer;
  p:byte;
  i:integer;
begin
  repeat
    p := pos(':', ATimeString);
    if p > 0 then
      system.delete(ATimeString, p, 1);
  until p = 0;
  val(system.copy(ATimeString, 1, 2), hour, code);
  val(system.copy(ATimeString, 3, 2), minute, code);
  val(system.copy(ATimeString, 5, 2), i, code);
{$IFDEF DEBUG}
  second := abs(i);
{$ELSE}
  second := i;
{$ENDIF}
end;

procedure TDateTimeObject.SetDateTimeString(ADateTimeString:TDateTimeString);
begin
  SetDateString(ADateTimeString);
  SetTimeString(system.copy(ADateTimeString,9,6));
end;

procedure TDateTimeObject.SetShortDateTimeString(ADateTimeString:TDateTimeString);
{YYMMDD[HH[MM[SS]]]}
begin
  SetShortDateString(ADateTimeString);
  SetTimeString(system.copy(ADateTimeString, 7, 6));
end;

procedure TDateTimeObject.SetDate(AYear, AMonth, ADay:Word);
begin
  year := ayear;
  month := amonth;
  day := aday;
end;

procedure TDateTimeObject.SetDay(ADay:Longint);
begin
{$IFDEF CHECKRANGE}
  if (ADay < 0) or (ADay > 31) then begin
    SysError('Dates.SetDay OOR ' + IntToStr(ADay));
    exit;
  end;
{$ENDIF}
  day := ADay;
end;

procedure TDateTimeObject.SetYear(AYear:longint);
begin
{$IFDEF CHECKRANGE}
  if (AYear < 0) or (AYear > 2200) then begin
    SysError('Dates.SetYear OOR ' + IntToStr(AYear));
    exit;
  end;
{$ENDIF}
  Year := AYear;
end;

procedure TDateTimeObject.SetMonth(AMonth:longint);
begin
{$IFDEF CHECKRANGE}
  if (AMonth < 0) or (AMonth > 12) then begin
    SysError('Dates.SetMonth OOR ' + IntToStr(AMonth));
    exit;
  end;
{$ENDIF}
  Month := AMonth;
end;

procedure TDateTimeObject.SetPackedDate(L:LongInt);
var dt:datetime;{time}
begin
  UnpackTime(l, dt);
  Year := dt.year;
  Month := dt.month;
  Day := dt.day;
  Hour := dt.Hour;
  Minute := dt.min;
  Second := dt.sec;
end;

procedure TDateTimeObject.GetFileTime(AFileName:PathStr);
var
  l:longint;
  f:file;
begin
  l := 0;
  assign(f, AFileName);
  {$I-}
  reset(f);
  if ioresult = 0 then begin
    GetFTime(f, l);
    close(f);
  end;
  if l > 0 then
    SetPackedDate(l);
end;

procedure TDateTimeObject.SetFileTime(AFileName:PathStr);
var
{  l:longint;}
  f:file;
begin
{  l := 0;}
  assign(f, AFileName);
  {$I-}
  reset(f);
  if ioresult = 0 then begin
    SetFTime(f, GetPackedDate);
    close(f);
  end;
end;

function TDateTimeObject.GetPackedDate:Longint;
var dt:datetime;l:longint;
begin
  dt.year := year;
  dt.month := month;
  dt.day := day;
  dt.hour := hour;
  dt.min := minute;
  dt.sec := second;
  PackTime(dt, l);
  GetPackedDate := l;
end;
procedure TDateTimeObject.SetTime(AHour, AMinute, ASecond:word);
begin
  hour := ahour;
  minute := aminute;
  second := asecond;
end;

function TDateTimeObject.YearString:TYearString;
var
  s:TYearString;
begin
  str(Year, s);
  s := lzero(s,4);
  YearString := s;
end;



function TDateTimeObject.YYYYMMDD:TDateString;
begin
  YYYYMMDD := DateString;
end;


function TDateTimeObject.YYMMDD:TDateString;
begin
  YYMMDD := system.copy(DateString, 3, 255);
end;

function TDateTimeObject.YYMM:TDateString;
begin
  YYMM := system.copy(DateString, 3, 4);
end;

function TDateTimeObject.YYYYMM:TDateString;
begin
  YYYYMM := YearString + MonthString;
end;

function TDateTimeObject.MMDD:TDateString;
begin
  MMDD := system.copy(YYYYMMDD, 5, 4);
end;

{
function TDateTimeObject.GetLogTime:TDateTimeString;
begin
  GetSystemTime;
  GetLogTime := TimeString + '.' + right(lzero(inttostr(mstime),3),3)
end;
}
{mylib}

function TDateTimeObject.DateString:TDateString;
begin
  DateString := GetDateString(Year, Month, Day);
end;

function TDateTimeObject.TimeString:TTimeString;
begin
  TimeString := GetTimeString(Hour, Minute, Second);
end;

function TDateTimeObject.MI:TTimeString;
begin
  MI := system.copy(HHMM, 3, 2);
end;

function TDateTimeObject.HH:TTimeString;
begin
  HH := system.copy(HHMM, 1, 2);
end;

function TDateTimeObject.HHMM:TTimeString;
begin
  HHMM := copy(GetTimeString(hour, minute, second), 1, 4);
end;

function TDateTimeObject.DateTimeString:TDateTimeString;
begin
  DateTimeString := DateString + TimeString;
end;

function TDateTimeObject.DOW:word;
var d:integer;
begin
  D := AbsDayOfWeek(Year, Month, Day);{returns 1 for Su, 2 Mo etc}
  dec(d,2); {convert to 0 for Mo, 1 for Tu ...}
  if d < 0 then
    inc(d,7);
  DOW := d;
end;

function TDateTimeObject.DDOW:word;{returns day of week in two weeks range:
      0..6 odd week's Mo-Su, 7-13 even week's Mo-Su}
var d:byte;
begin
  d := DOW;
  if WeekIsEven then
    d := d + DaysInWeek;
  DDOW := d;
end;

function TDateTimeObject.DayNumber:Integer;{in the year}
begin
  DayNumber := dateu.DayNumber(Day, Month, Year);
end;

function TDateTimeObject.WeekNumber:Integer;{in the year}
begin
  WeekNumber := dateu.WeekNumber(Day, Month, Year);
end;

function TDateTimeObject.WeekNumberInMonth:integer;
var i,w:integer;
begin
  w := (Day - 1 + DaysInWeek) div DaysInWeek;{last this month sunday or previous month}
  i := (Day - 1) mod DaysInWeek;
  if i > DOW then
    inc(w);
  WeekNumberInMonth := w;
end;

function TDateTimeObject.WeekIsEven:boolean;
begin
  WeekIsEven := (WeekNumber mod 2) = 0;
end;

function TDateTimeObject.CompareDates(ADT:TDateTimeObject):integer;
begin
  CompareDates := Compare(ADT, 1, 8);
end;

function TDateTimeObject.MonthString:TMonthString;
var s:TMonthString;
begin
  str(Month, s);
  s := lzero(s,2);
  MonthString := s;
end;

function TDateTimeObject.DayString:TDayString;
var s:TDayString;
begin
  str(Day, s);
  s := lzero(s,2);
  DayString := s;
end;

function TDateTimeObject.DD:TDayString;{the same}
begin
  DD := DayString;
end;

function TDateTimeObject.DayMonthString:TDateString;
begin
  DayMonthString := DayString + '.' + MonthString + '.';
end;

function TDateTimeObject.MonthYearString:TDateString;{MM.YYYY}
begin
  MonthYearString := MonthString + '.' + YearString;
end;

function TDateTimeObject.MonthYearDatum:TDateString;{MM/YYYY}
begin
  MonthYearDatum := MonthString + '/' + YearString;
end;

function TDateTimeObject.GetShortDatum:TDateTimeString;{[D]D.[M]M.YY}
begin
  GetShortDatum := IntToStr(Day) + '.' + IntToStr(Month) + '.' + copy(YearString, 3, 4);
end;

function TDateTimeObject.GetDatum:TDateTimeString;{DD.MM.YYYY}
begin
  GetDatum := DayMonthString + YearString;
end;

function TDateTimeObject.GetCas:TDateTimeString;{HH:MM:SS}
begin
  GetCas := lzero(IntToStr(Hour),2) + ':' + lzero(IntToStr(Minute),2) + ':' +
    lzero(IntToStr(Second),2);
end;

function TDateTimeObject.DaysInMonth:integer;
begin
  DaysInMonth := dateu.daysinmonth(Year, Month);
end;

function TDateTimeObject.SecondsInDay:LongInt;
begin
  SecondsInDay := LongInt(Hour) * 3600 + LongInt(Minute) * 60 + LongInt(Second);
end;

function TDateTimeObject.CompareTimes(ADT:TDateTimeObject):Integer;
begin
  CompareTimes := Compare(ADT, 9, 6);
end;

function TDateTimeObject.Compare(ADT:TDateTimeObject; Start,Len:integer):integer;
var s, ast:TDateTimeString;
begin
  Compare := -2;
  if ADT = nil then
    exit;
  if (start = 0) or (len = 0) then begin
    start := 1;
    len := pred(sizeof(TDateTimeString));
  end;
  s := system.copy(DateTimeString, start, len);
  ast := system.copy(ADT.DateTimeString, start, len);
  if s > ast then
    Compare := 1
  else if s < ast then
    Compare := -1
  else
    Compare := 0;
end;


function TDateTimeObject.IsValid:boolean;
begin
  isvalid := false;
  if (year < 1980) or (year > 2107) then
    exit;
  if (month < 1) or (month > 12) then
    exit;
  if (day < 1) or (day > DaysInMonth) then
    exit;
  IsValid := true;
end;

function TDateTimeObject.IsValidDate:boolean;
begin
  IsValidDate := IsValid;
end;

function TDateTimeObject.IsValidTime:boolean;
begin
  IsValidTime := false;
  if (Hour > 23) or (Minute > 59) or (Second > 59) then
    exit;
  IsValidTime := true;
end;

function TDateTimeObject.IsFuture:boolean;
var ADate:TDateTimeObject;
begin
  isFuture := false;
  if not IsValid then
    exit;
  ADate := TDTO.Create;
  ADate.GetSystemTime;
  if YYYYMMDD >= ADate.YYYYMMDD then
    IsFuture := true;
end;

procedure TDateTimeObject.Clear;
begin
  Year := 0;
  Month := 0;
  Day := 0;
  Hour := 0;
  Minute := 0;
  Second := 0;
  Sec100 :=0;
end;

function TDateTimeObject.SFDateString:TDateString;{YYYY-MM-DD}
var s:TDateString;
begin
  s := DateString;
  system.insert('-',s, 5);
  system.insert('-',s, 8);
  SFDateString := s;
end;

function TDateTimeObject.SFTimeString:TTimeString;{HH:MM}
var s:TTimeString;
begin
  s := system.copy(TimeString,1 ,4);
  system.insert(':', s, 3);
  SFTimeString := s;
end;

procedure TDateTimeObject.SetSFDateString(ADate:TDateString);{YYYY-MM-DD}
var
  c:integer;
begin
  val(system.copy(ADate, 1, 4), year, c);
  val(system.copy(ADate, 6, 2), month, c);
  val(system.copy(ADate, 9, 2), day, c);
end;

procedure TDateTimeObject.SetSFTimeString(ATime:TTimeString);{HH:MM}
var
  c:integer;
begin
  val(system.copy(ATime, 1, 4), year, c);
  val(system.copy(ATime, 6, 2), month, c);
  val(system.copy(ATime, 9, 2), day, c);
end;


function GetIntervalInMinutes(Time1, Time2:TDateTimeObject):longint;
begin
  GetIntervalInMinutes := GetIntervalInSeconds(Time1, Time2) div 60;
end;

function GetIntervalInSeconds(Time1, Time2:TDateTimeObject):longint;
var
  l, l1, l2:longint;
  t:TDateTimeObject;
  negative:boolean;
begin
  negative := false;
  if Time1.DateTimeString > Time2.DateTimeString then begin
    negative := true;
    t := Time1;
    Time1 := Time2;
    Time2 := t;
  end;
  l1 := Time1.UpTodayThisYearInSeconds;
  l2 := Time2.UpTodayThisYearInSeconds;
  l := 0;
  while Time1.Year < Time2.Year do begin
    inc(l, Time1.YearInSeconds - l1);
    l1 := 0;
    Time1.IncDate(incYear, 1);
  end;
  inc(l, l2 - l1);
  if negative then
    l := -l;
  GetIntervalInSeconds := l;
end;

{*********************************************************}
const
  DateTimes: TList = nil;
  DateTimeError:integer = dtOK;

function IsValid(ADTO:PDTO):boolean;
begin
  IsValid := false;
  if ADTO = nil then begin{logtype}
    SysError('dateu nil TDTO in IsValid');
    exit;
  end;
  if DateTimes = nil then begin
    SysError('dateu DateTimes nil in IsValid');
    exit;
  end;
  if DateTimes.IndexOf(ADTO) < 0 then begin
    SysError('dateu ADTO not registered in IsValid');
    exit;
  end;
  IsValid := true;
end;

function DTInit:PDTO;{date/time object}
var d:PDTO;
begin
  DTInit := nil;
  d := TDTO.Create;
  if DateTimes = nil then begin
    DateTimes := TList.Create;{New(PCollection, Create(20, 10));}
    DateTimes.Capacity := 20;
    if DateTimes = nil then begin
      SysError('Cant Create DateTimes');
      if d <> nil then begin
        D.Free;{Dispose(d, done);}
        {d := nil;}
      end;
      exit;
    end;
  end;
  DateTimes.Add(d);
  DTInit := d;
end;

function DTDone(ADTO:PDTO):DTResult;
begin
  DateTimeError := dtInvalidDTO;
  if IsValid(ADTO) then begin
    DateTimeError := dtOK;
    DateTimes.Remove(ADTO);
    ADTO.Free;
  end;
  DTDone := DateTimeError;
end;

function DTSet(ADTO:PDTO; AProperty:Integer; AValue:Longint):DTResult;
begin
  DateTimeError := dtInvalidDTO;
  if not IsValid(ADTO) then begin
    DTSet := DateTimeError;
    exit;
  end;
  case AProperty of {logtype}
    {dtDateString=}
    dtYYYYMMDD: ADTO.SetDateString(GetString(PString(AValue)));
    dtHHMMSS: ADTO.SetTimeString(GetString(PString(AValue)));
    dtDateTimeString: ADTO.SetDateTimeString(GetString(PString(AValue)));
    dtDay: ADTO.SetDay(AValue);
    dtMonth: ADTO.SetMonth(AValue);
    dtYear : ADTO.SetYear(AValue);
    dtPackedDate: ADTO.SetPackedDate(AValue);
    dtSecond : ADTO.Second := AValue;
    dtHour : ADTO.Hour := AValue;
    dtMinute: ADTO.Minute := AValue;
  else
    begin
      SysError('DTSetProperty unknown AProperty ' + IntToStr(AProperty));
      DateTimeError := dtUnknownSetProperty;
      DTSet := DateTimeError;
      exit;
    end;
  end;
  DTSet := dtOK;
end;

const
  DTString : array[0..1] of string = ('','');
  DTPos : byte = 0;

function DTGetStr(ADTO:PDTO; AProperty:integer):String;
begin
  DTGetStr := '';
  DateTimeError := dtInvalidDTO;
  if not IsValid(ADTO) then
    exit;
  if DTPos = 0 then
    DTPos := 1
  else
    DTPos := 0;
  DTString[DTPos] := '';
  case AProperty of
    dtYYYYMMDD: DTString[DTPos] := ADTO.DateString;
    dtHHMMSS: DTString[DTPos] := ADTO.TimeString;
    dtDateTimeString: DTString[DTPos] := ADTO.DateTimeString;
    dtYYYYMM : DTString[DTPos] := ADTO.YYYYMM;
    dtDatum : DTString[DTPos] := ADTO.GetDatum;
    dtCas : DTString[DTPos] := ADTO.GetCas;
    dtMonthYearDatum: DTString[DTPos] := ADTO.MonthYearDatum;
    dtDaystring: DTString[DTPos] := ADTO.DayString;
    dtShortDatum: DTString[DTPos] := ADTO.GetShortDatum;
    {dtDD : DTString[DTPos] := ADTO.DD; = dtDayString logtype}
    dtDayMonth: DTString[DTPos] := ADTO.DayMonthString;
    dtYYMMDD: DTString[DTPos] := ADTO.YYMMDD;
    dtHHMM : DTString[DTPos] := ADTO.HHMM;
    dtShortDateTime: DTString[DTPos] := ADTO.YYMMDD + ADTO.HHMM;
  else
    begin
      SysError('dateu.DTGetStr unknown property ' + IntToStr(AProperty));
      DateTimeError := dtUnknownGetStrProperty;
      exit;
    end;
  end;
  DTGetStr := DTString[DTPos];
  DateTimeError := dtOK;
end;

function DTSetStr(ADTO:PDTO; AProperty:integer; AValue:string):DTResult;
begin
  DTSetStr := dtInvalidDTO;
  DateTimeError := dtInvalidDTO;
  if not IsValid(ADTO) then
    exit;
  case AProperty of
    dtYYYYMMDD: ADTO.SetDateString(AValue);
    dtHHMMSS: ADTO.SetTimeString(AValue);
    dtDateTimeString: ADTO.SetDateTimeString(AValue);
    dtShortDateTime: ADTO.SetShortDateTimeString(AValue);{YYMMDD[HH[MM[SS]]]}
    dtShortDate{=dtYYMMDD}: ADTO.SetShortDateString(AValue);
    {dtYYYYMM : DTString[DTPos] := ADTO.YYYYMM;
    dtDatum : DTString[DTPos] := ADTO.GetDatum;}
  else
    begin
      SysError('dateu.DTSetStr unknown property ' + IntToStr(AProperty));
      DateTimeError := dtUnknownGetStrProperty;
      DTSetStr := DateTimeError;
      exit;
    end;
  end;
  DTSetStr := dtOK;
  DateTimeError := dtOK;
end;

function DTGet(ADTO:PDTO; AProperty:Integer):Longint;
var
  v:longint;
begin
  DTGet := dtInvalidDTO;
  DateTimeError := dtInvalidDTO;
  if not IsValid(ADTO) then begin
    {if (AProperty = dtIsValid)}
    exit;
  end;
  case AProperty of
    dtDay: v := ADTO.Day;
    dtMonth: v := ADTO.Month;
    dtYear: v := ADTO.Year;
    dtSecond : v := ADTO.Second;
    dtHour : v := ADTO.Hour;
    dtMinute : v := ADTO.Minute;{logtype}
    dtPackedDate: v := ADTO.GetPackedDate;
    dtIsValid: if ADTO.IsValid then v := dtOK else v := dtInvalidDate;
    dtIsValidTime: if ADTO.IsValidTime then v := dtOK else v := dtInvalidTime;
    dtDOW: v := ADTO.DOW;
    dtAbsDayOfWeek: v := AbsDayOfWeek(adto.year, adto.month, adto.day);
    dtTodayInSeconds : v := ADTO.TodayInSeconds;
    dtDDOW: v := ADTO.DDOW;
    dtDayInYear: v := ADTO.DayNumber;
    dtWeekInYear: v := ADTO.WeekNumber;
  else
    begin
      SysError('dateu.DTGetProperty unknown AProperty ' + IntToStr(AProperty));
      DateTimeError := dtUnknownGetProperty;
      exit;
    end;
  end;
  DTGet := v;
  DateTimeError := dtOK;
end;

function DTAssign(ADTO:PDTO; ADTO2:PDTO):DTResult;
begin
  DTAssign := DTDo(ADTO, dtCopyFrom, longint(ADTO2));
end;

function DTNow:PDTO;
begin
  Now.GetSystemTime;
  DTNow := @Now;
end;

function DTDo(ADTO:PDTO; AAction:integer; AInfo:Longint):DTResult;
begin
  DTDo := dtInvalidDTO;
  if not IsValid(ADTO) then
    exit;
  case AAction of
    dtIncDay: ADTO.IncDate(dtIncDay, AInfo);
    dtIncMonth: ADTO.IncDate(dtIncMonth, AInfo);
    dtIncYear : ADTO.IncDate(dtIncYear, AInfo);
    dtIncHour: ADTO.IncTime(dtIncHour, AInfo);
    dtIncMinute: ADTO.IncTime(dtIncMinute, AInfo);
    dtIncSecond: ADTO.IncTime(incSecond, AInfo);
    dtGetSystemTime: ADTO.GetSystemTime;
    {$IFDEF RTKERNEL}
    dtGetRTClockTime: ADTO.GetRTClockTime;
    {$ENDIF}
    dtCopyFrom: begin
      if IsValid(PDTO(AInfo)) then begin
        ADTO.SetDateTimeString(PDTO(AInfo).DateTimeString);
      end else begin
        DTDo := dtInvalidDoInfo;
        exit;
      end;
    end;
    dtClear : ADTO.Clear;
  else
    begin
      SysError('dateu.DTDo unknown AAction ' + IntToStr(AAction));
      DTDo := dtUnknownAction;
      exit;
    end;
  end;
  DTDo := dtOK;
end;

const
  OldExitProc:pointer = nil;

procedure ex;far;
begin
  ExitProc := OldExitProc;
  Now.Free;
  if DateTimes <> nil then begin
    if DateTimes.Count > 0 then begin
      SysError('dateu.ExitProc DateTimes.Count = ' + IntToStr(DateTimes.Count));
    end;
    if DateTimes <> nil then begin
      DateTimes.Free;
      {Dispose(DateTimes, Done);}
      DateTimes := nil;
    end;
  end;
end;

begin
  Now := TDTO.Create;
  OldExitProc := ExitProc;
  ExitProc := @Ex;
end.
