freepascal.compiler/rtl/objpas/sysutils/dati.inc

{
    *********************************************************************
    Copyright (C) 1997, 1998 Gertjan Schouten

    See the file COPYING.FPC, included in this distribution,
    for details about the copyright.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

 **********************************************************************

    System Utilities For Free Pascal
}

{==============================================================================}
{   internal functions                                                         }
{==============================================================================}

Function DoEncodeDate(Year, Month, Day: Word): longint;

Var
  D : TDateTime;

begin
  If TryEncodeDate(Year,Month,Day,D) then
    Result:=Trunc(D)
  else
    Result:=0;
end;

function DoEncodeTime(Hour, Minute, Second, MilliSecond: word): TDateTime;

begin
  If not TryEncodeTime(Hour,Minute,Second,MilliSecond,Result) then
    Result:=0;
end;

{==============================================================================}
{   Public functions                                                           }
{==============================================================================}

{   ComposeDateTime converts a Date and a Time into one TDateTime   }
function ComposeDateTime(Date,Time : TDateTime) : TDateTime;

begin
  if Date < 0 then Result := trunc(Date) - Abs(frac(Time))
  else Result := trunc(Date) + Abs(frac(Time));
end;

{   DateTimeToTimeStamp converts DateTime to a TTimeStamp   }

function DateTimeToTimeStamp(DateTime: TDateTime): TTimeStamp;

Var
  D : Double;
begin
  D:=DateTime * Single(MSecsPerDay);
  if D<0 then
    D:=D-0.5
  else
    D:=D+0.5;
  result.Time := Abs(Trunc(D)) Mod MSecsPerDay;
  result.Date := DateDelta + Trunc(D) div MSecsPerDay;
end;

{   TimeStampToDateTime converts TimeStamp to a TDateTime value   }

function TimeStampToDateTime(const TimeStamp: TTimeStamp): TDateTime;
begin
  Result := ComposeDateTime(TimeStamp.Date - DateDelta,TimeStamp.Time / MSecsPerDay)
end;

{   MSecsToTimeStamp   }

function MSecsToTimeStamp(MSecs: comp): TTimeStamp;
begin
  result.Date := Trunc(msecs / msecsperday);
  msecs:= msecs-comp(result.date)*msecsperday;
  result.Time := Round(MSecs);
end ;

{   TimeStampToMSecs   }

function TimeStampToMSecs(const TimeStamp: TTimeStamp): comp;
begin
  result := TimeStamp.Time + comp(timestamp.date)*msecsperday;
end ;

Function TryEncodeDate(Year,Month,Day : Word; Out Date : TDateTime) : Boolean;

var
  c, ya: cardinal;
begin
  Result:=(Year>0) and (Year<10000) and
          (Month in [1..12]) and
          (Day>0) and (Day<=MonthDays[IsleapYear(Year),Month]);
 If Result then
   begin
     if month > 2 then
      Dec(Month,3)
     else
      begin
        Inc(Month,9);
        Dec(Year);
      end;
     c:= Year DIV 100;
     ya:= Year - 100*c;
     Date := (146097*c) SHR 2 + (1461*ya) SHR 2 + (153*cardinal(Month)+2) DIV 5 + cardinal(Day);
     // Note that this line can't be part of the line above, since TDateTime is
     // signed and c and ya are not
     Date := Date - 693900;
   end
end;

function TryEncodeTime(Hour, Min, Sec, MSec:word; Out Time : TDateTime) : boolean;

begin
  Result:=(Hour<24) and (Min<60) and (Sec<60) and (MSec<1000);
  If Result then
    Time:=TDateTime(cardinal(Hour)*3600000+cardinal(Min)*60000+cardinal(Sec)*1000+MSec)/MSecsPerDay;
end;

{   EncodeDate packs three variables Year, Month and Day into a
    TDateTime value the result is the number of days since 12/30/1899   }

function EncodeDate(Year, Month, Day: word): TDateTime;

begin
  If Not TryEncodeDate(Year,Month,Day,Result) then
    Raise EConvertError.CreateFmt('%d-%d-%d is not a valid date specification',
                              [Year,Month,Day]);
end;

{   EncodeTime packs four variables Hour, Minute, Second and MilliSecond into
    a TDateTime value     }

function EncodeTime(Hour, Minute, Second, MilliSecond:word):TDateTime;

begin
  If not TryEncodeTime(Hour,Minute,Second,MilliSecond,Result) then
    Raise EConvertError.CreateFmt('%d:%d:%d.%d is not a valid time specification',
                              [Hour,Minute,Second,MilliSecond]);
end;


{   DecodeDate unpacks the value Date into three values:
    Year, Month and Day   }

procedure DecodeDate(Date: TDateTime; out Year, Month, Day: word);
var
  ly,ld,lm,j : cardinal;
begin
  if Date <= -datedelta then  // If Date is before 1-1-1 then return 0-0-0
    begin
    Year := 0;
    Month := 0;
    Day := 0;
    end
  else
    begin
    j := pred((Trunc(System.Int(Date)) + 693900) SHL 2);
    ly:= j DIV 146097;
    j:= j - 146097 * cardinal(ly);
    ld := j SHR 2;
    j:=(ld SHL 2 + 3) DIV 1461;
    ld:= (cardinal(ld) SHL 2 + 7 - 1461*j) SHR 2;
    lm:=(5 * ld-3) DIV 153;
    ld:= (5 * ld +2 - 153*lm) DIV 5;
    ly:= 100 * cardinal(ly) + j;
    if lm < 10 then
     inc(lm,3)
    else
      begin
        dec(lm,9);
        inc(ly);
      end;
    year:=ly;
    month:=lm;
    day:=ld;
    end;
end;


function DecodeDateFully(const DateTime: TDateTime; out Year, Month, Day, DOW: Word): Boolean;
begin
  DecodeDate(DateTime,Year,Month,Day);
  DOW:=DayOfWeek(DateTime);
  Result:=IsLeapYear(Year);
end;


{   DecodeTime unpacks Time into four values:
    Hour, Minute, Second and MilliSecond    }

procedure DecodeTime(Time: TDateTime; out Hour, Minute, Second, MilliSecond: word);
Var
  l : cardinal;
begin
 l := DateTimeToTimeStamp(Time).Time;
 Hour   := l div 3600000;
 l := l mod 3600000;
 Minute := l div 60000;
 l := l mod 60000;
 Second := l div 1000;
 l := l mod 1000;
 MilliSecond := l;
end;

{   DateTimeToSystemTime converts DateTime value to SystemTime   }

procedure DateTimeToSystemTime(DateTime: TDateTime; out SystemTime: TSystemTime);
begin
  DecodeDate(DateTime, SystemTime.Year, SystemTime.Month, SystemTime.Day);
  DecodeTime(DateTime, SystemTime.Hour, SystemTime.Minute, SystemTime.Second, SystemTime.MilliSecond);
end ;

{   SystemTimeToDateTime converts SystemTime to a TDateTime value   }

function SystemTimeToDateTime(const SystemTime: TSystemTime): TDateTime;
begin
  result := ComposeDateTime(DoEncodeDate(SystemTime.Year, SystemTime.Month, SystemTime.Day),
                            DoEncodeTime(SystemTime.Hour, SystemTime.Minute, SystemTime.Second, SystemTime.MilliSecond));
end ;

{   DayOfWeek returns the Day of the week (sunday is day 1)  }

function DayOfWeek(DateTime: TDateTime): integer;
begin
  Result := 1 + ((Trunc(DateTime) - 1) mod 7);
  If (Result<=0) then
    Inc(Result,7);
end;

{   Date returns the current Date   }

function Date: TDateTime;
var
  SystemTime: TSystemTime;
begin
  GetLocalTime(SystemTime);
  result := DoEncodeDate(SystemTime.Year, SystemTime.Month, SystemTime.Day);
end ;

{   Time returns the current Time   }

function Time: TDateTime;
var
  SystemTime: TSystemTime;
begin
  GetLocalTime(SystemTime);
  Result := DoEncodeTime(SystemTime.Hour,SystemTime.Minute,SystemTime.Second,SystemTime.MilliSecond);
end ;

{   Now returns the current Date and Time    }

function Now: TDateTime;
var
  SystemTime: TSystemTime;
begin
  GetLocalTime(SystemTime);
  result := systemTimeToDateTime(SystemTime);
end;

{   IncMonth increments DateTime with NumberOfMonths months,
    NumberOfMonths can be less than zero   }

function IncMonth(const DateTime: TDateTime; NumberOfMonths: integer = 1 ): TDateTime;
var
  Year, Month, Day : word;
begin
  DecodeDate(DateTime, Year, Month, Day);
  IncAMonth(Year, Month, Day, NumberOfMonths);
  result := ComposeDateTime(DoEncodeDate(Year, Month, Day), DateTime);
end ;

{   IncAMonth is the same as IncMonth, but operates on decoded date  }

procedure IncAMonth(var Year, Month, Day: Word; NumberOfMonths: Integer = 1);
var
  TempMonth, S: Integer;
begin
  If NumberOfMonths>=0 then
    s:=1
  else
    s:=-1;
  inc(Year,(NumberOfMonths div 12));
  TempMonth:=Month+(NumberOfMonths mod 12)-1;
  if (TempMonth>11) or
     (TempMonth<0) then
   begin
     Dec(TempMonth, S*12);
     Inc(Year, S);
   end;
  Month:=TempMonth+1;          {   Months from 1 to 12   }
  If (Day>MonthDays[IsLeapYear(Year)][Month]) then
    Day:=MonthDays[IsLeapYear(Year)][Month];
end;

{  IsLeapYear returns true if Year is a leap year   }

function IsLeapYear(Year: Word): boolean;
begin
  Result := (Year mod 4 = 0) and ((Year mod 100 <> 0) or (Year mod 400 = 0));
end;

{  DateToStr returns a string representation of Date using ShortDateFormat   }

function DateToStr(Date: TDateTime): string;
begin
  DateTimeToString(Result, 'ddddd', Date);
end ;

function DateToStr(Date: TDateTime; const FormatSettings: TFormatSettings): string;
begin
  DateTimeToString(result, FormatSettings.ShortDateFormat, Date, FormatSettings);
end;

{  TimeToStr returns a string representation of Time using LongTimeFormat   }

function TimeToStr(Time: TDateTime): string;
begin
  DateTimeToString(Result, 'tt', Time);
end ;

function TimeToStr(Time: TDateTime; const FormatSettings: TFormatSettings): string;
begin
  DateTimeToString(Result, FormatSettings.LongTimeFormat, Time, FormatSettings);
end;

{   DateTimeToStr returns a string representation of DateTime using LongDateTimeFormat   }

function DateTimeToStr(DateTime: TDateTime): string;
begin
  DateTimeToString(Result, 'c', DateTime);
end ;

function DateTimeToStr(DateTime: TDateTime; const FormatSettings: TFormatSettings): string;
begin
  DateTimeToString(Result, 'c', DateTime ,FormatSettings);
end;

{   StrToDate converts the string S to a TDateTime value
    if S does not represent a valid date value
    an EConvertError will be raised   }

function IntStrToDate(Out ErrorMsg : AnsiString; const S: PChar; Len : integer; const useformat : string; const defs:TFormatSettings; separator : char = #0): TDateTime;

const SInvalidDateFormat = '"%s" is not a valid date format';

procedure FixErrorMsg(const errm :ansistring;const errmarg : ansistring);

begin
  errormsg:=format(errm,[errmarg]);
end;

var
   df:string;
   d,m,y,ly:word;
   n,i:longint;
   c:word;
   dp,mp,yp,which : Byte;
   s1:string[4];
   values:array[0..3] of longint;
   LocalTime:tsystemtime;
   YearMoreThenTwoDigits : boolean;
begin
  ErrorMsg:='';   Result:=0;
  if (Len=0) then
    begin
      FixErrorMsg(SInvalidDateFormat,'');
      exit;
    end;
  YearMoreThenTwoDigits := False;
  if separator = #0 then
    separator := defs.DateSeparator;
  df := UpperCase(useFormat);
  { Determine order of D,M,Y }
  yp:=0;
  mp:=0;
  dp:=0;
  Which:=0;
  i:=0;
  while (i<Length(df)) and (Which<3) do
   begin
     inc(i);
     Case df[i] of
       'Y' :
         if yp=0 then
          begin
            Inc(Which);
            yp:=which;
          end;
       'M' :
         if mp=0 then
          begin
            Inc(Which);
            mp:=which;
          end;
       'D' :
         if dp=0 then
          begin
            Inc(Which);
            dp:=which;
          end;
     end;
   end;
  for i := 1 to 3 do
    values[i] := 0;
  s1 := '';
  n := 0;
  dec(len);
  for i := 0 to len do
   begin
     if s[i] in ['0'..'9'] then
      s1 := s1 + s[i];

     { space can be part of the shortdateformat, and is defaultly in slovak
       windows, therefor it shouldn't be taken as separator (unless so specified)
       and ignored }
     if (Separator <> ' ') and (s[i] = ' ') then
       Continue;

     if (s[i] = separator) or ((i = len) and (s[i] in ['0'..'9'])) then
      begin
        inc(n);
        if n>3 then
          begin
            FixErrorMsg(SInvalidDateFormat,s);
            exit;
          end;
         // Check if the year has more then two digits (if n=yp, then we are evaluating the year.)
        if (n=yp) and (length(s1)>2) then YearMoreThenTwoDigits := True;
        val(s1, values[n], c);
        if c<>0 then
          begin
            FixErrorMsg(SInvalidDateFormat,s);
            Exit;
          end;
        s1 := '';
      end
     else if not (s[i] in ['0'..'9']) then
       begin
         FixErrorMsg(SInvalidDateFormat,s);
         Exit;
       end;
   end ;
   if (Which<3) and (N>Which) then
    begin
    FixErrorMsg(SInvalidDateFormat,s);
    Exit;
    end; 
  // Fill in values.
  getLocalTime(LocalTime);
  ly := LocalTime.Year;
  If N=3 then
   begin
     y:=values[yp];
     m:=values[mp];
     d:=values[dp];
   end
  Else
  begin
    Y:=ly;
    If n<2 then
     begin
       d:=values[1];
       m := LocalTime.Month;
     end
    else
     If dp<mp then
      begin
        d:=values[1];
        m:=values[2];
      end
    else
      begin
        d:=values[2];
        m:=values[1];
      end;
  end;
  if (y >= 0) and (y < 100) and not YearMoreThenTwoDigits then
    begin
    ly := ly - defs.TwoDigitYearCenturyWindow;
    Inc(Y, ly div 100 * 100);
    if (defs.TwoDigitYearCenturyWindow > 0) and (Y < ly) then
      Inc(Y, 100);
    end;
  if not TryEncodeDate(y, m, d, result) then
    errormsg:='Invalid date';
end;

function StrToDate(const S: PChar; Len : integer; const useformat : string; separator : char = #0): TDateTime;

Var
  MSg : AnsiString;

begin
  Result:=IntStrToDate(Msg,S,Len,useFormat,DefaultFormatSettings,Separator);
  If (Msg<>'') then
    Raise EConvertError.Create(Msg);
end;

function StrToDate(const S: ShortString; const useformat : string; separator : char = #0): TDateTime;
begin
    result := StrToDate(@S[1],Length(s),UseFormat,separator);
end;

function StrToDate(const S: AnsiString; const useformat : string; separator : char = #0): TDateTime;
begin
    result := StrToDate(@S[1],Length(s),UseFormat,separator);
end;

function StrToDate(const S: ShortString; separator : char): TDateTime;
begin
    result := StrToDate(@S[1],Length(s),DefaultFormatSettings.ShortDateFormat,separator)
end;

function StrToDate(const S: ShortString): TDateTime;
begin
    result := StrToDate(@S[1],Length(s),DefaultFormatSettings.ShortDateFormat,#0);
end;

function StrToDate(const S: AnsiString; separator : char): TDateTime;
begin
    result := StrToDate(@S[1],Length(s),DefaultFormatSettings.ShortDateFormat,separator)
end;

function StrToDate(const S: AnsiString): TDateTime;
begin
    result := StrToDate(@S[1],Length(s),DefaultFormatSettings.ShortDateFormat,#0);
end;

{   StrToTime converts the string S to a TDateTime value
    if S does not represent a valid time value an
    EConvertError will be raised   }


function IntStrToTime(Out ErrorMsg : AnsiString; const S: PChar; Len : integer;const defs:TFormatSettings; separator : char = #0): TDateTime;
const
  AMPM_None = 0;
  AMPM_AM = 1;
  AMPM_PM = 2;
  tiHour = 0;
  tiMin = 1;
  tiSec = 2;
  tiMSec = 3;
type
  TTimeValues = array[tiHour..tiMSec] of Word;
var
   AmPm: integer;
   TimeValues: TTimeValues;

    function StrPas(Src : PChar; len: integer = 0) : ShortString;
    begin
        //this is unsafe for len > 255, it will trash memory (I tested this)
        //reducing it is safe, since whenever we use this a string > 255 is invalid anyway
        if len > 255 then len := 255;
        SetLength(Result, len);
        move(src[0],result[1],len);
    end;

   function SplitElements(out TimeValues: TTimeValues; out AmPm: Integer): Boolean;
   //Strict version. It does not allow #32 as Separator, it will treat it as whitespace always
   const
     Digits = ['0'..'9'];
   var
      Cur, Offset, ElemLen, Err, TimeIndex, FirstSignificantDigit: Integer;
      Value: Word;
      DigitPending, MSecPending: Boolean;
      AmPmStr: ShortString;
      CurChar: Char;
   begin
     Result := False;
     AmPm := AMPM_None; //No Am or PM in string found yet
     MSecPending := False;
     TimeIndex := 0; //indicating which TTimeValue must be filled next
     FillChar(TimeValues, SizeOf(TTimeValues), 0);
     Cur := 0;
     //skip leading blanks
     While (Cur < Len) and (S[Cur] =#32) do Inc(Cur);
     Offset := Cur;
     //First non-blank cannot be Separator or DecimalSeparator
     if (Cur > Len - 1) or (S[Cur] = Separator) or (S[Cur] = defs.Decimalseparator) then Exit;
     DigitPending := (S[Cur] in Digits);
     While (Cur < Len) do
     begin
       //writeln;
       //writeln('Main While loop:  Cur = ',Cur,' S[Cur] = "',S[Cur],'" Len = ',Len);
       CurChar := S[Cur];
       if CurChar in Digits then
       begin//Digits
         //HH, MM, SS, or Msec?
         //writeln('Digit');
         //Digits are only allowed after starting Am/PM or at beginning of string or after Separator
         //and TimeIndex must be <= tiMSec
         //Uncomment "or (#32 = Separator)" and it will allllow #32 as separator
         if (not (DigitPending {or (#32 = Separator)})) or (TimeIndex > tiMSec) then Exit;
         OffSet := Cur;
         if (CurChar <> '0') then FirstSignificantDigit := OffSet else FirstSignificantDigit := -1;
         while (Cur < Len -1) and (S[Cur + 1] in Digits) do
         begin
           //Mark first Digit that is not '0'
           if (FirstSignificantDigit = -1) and (S[Cur] <> '0') then FirstSignificantDigit := Cur;
           Inc(Cur);
         end;
         if (FirstSignificantDigit = -1) then FirstSignificantDigit := Cur;
         ElemLen := 1 + Cur - FirstSignificantDigit;
         //writeln('  S[FirstSignificantDigit] = ',S[FirstSignificantDigit], ' S[Cur] = ',S[Cur],' ElemLen = ',ElemLen,' -> ', StrPas(S + Offset, ElemLen));
         //writeln('  Cur = ',Cur);
         //this way we know that Val() will never overflow Value !
         if (ElemLen <= 2) or ((ElemLen <= 3) and (TimeIndex = tiMSec) ) then
         begin
           Val(StrPas(S + FirstSignificantDigit, ElemLen), Value, Err);
           //writeln('  Value = ',Value,' HH = ',TimeValues[0],' MM = ',TimeValues[1],' SS = ',TimeValues[2],' MSec = ',Timevalues[3]);
           //This is safe now, because we know Value < High(Word)
           TimeValues[TimeIndex] := Value;
           Inc(TimeIndex);
           DigitPending := False;
         end
         else  Exit; //Value to big, so it must be a wrong timestring
       end//Digits
       else if (CurChar = #32) then
       begin
         //writeln('#32');
         //just skip, but we must adress this, or it will be parsed by either AM/PM or Separator
       end
       else if (CurChar = Separator) then
       begin
         //writeln('Separator');
         if DigitPending or (TimeIndex > tiSec) then Exit;
         DigitPending := True;
         MSecPending := False;
       end
       else if (CurChar = defs.DecimalSeparator) then
       begin
         //writeln('DecimalSeparator');
         if DigitPending or MSecPending or (TimeIndex <> tiMSec) then Exit;
         DigitPending := True;
         MSecPending := True;
       end
       else
       begin//AM/PM?
         //None of the above, so this char _must_ be the start of AM/PM string
         //If we already have found AM/PM or we expect a digit then then timestring must be wrong at this point
         //writeln('AM/PM?');
         if (AmPm <> AMPM_None) or DigitPending then Exit;
         OffSet := Cur;
         while (Cur < Len -1) and (not (S[Cur + 1] in [Separator, #32, defs.DecimalSeparator]))
           and not (S[Cur + 1] in Digits) do Inc(Cur);
         ElemLen := 1 + Cur - OffSet;
         //writeln('  S[Offset] = ',S[Offset], ' S[Cur] = ',S[Cur],' ElemLen = ',ElemLen,' -> ', StrPas(S + Offset, ElemLen));
         //writeln('  Cur = ',Cur);
         AmPmStr := StrPas(S + OffSet, ElemLen);

         //writeln('AmPmStr = ',ampmstr,' (',length(ampmstr),')');
         //We must compare to TimeAMString before hardcoded 'AM' for delphi compatibility
         //Also it is perfectly legal, though insane to have TimeAMString = 'PM' and vice versa
         if (AnsiCompareText(AmPmStr, defs.TimeAMString) = 0) then AmPm := AMPM_AM
         else if (AnsiCompareText(AmPmStr, defs.TimePMString) = 0) then AmPm := AMPM_PM
         else if (CompareText(AmPmStr, 'AM') = 0) then AmPm := AMPM_AM
         else if (CompareText(AmPmStr, 'PM') = 0) then AmPm := AMPM_PM
         else Exit; //If text does not match any of these, timestring must be wrong;
         //if AM/PM is at beginning of string, then a digit is mandatory after it
         if (TimeIndex = tiHour) then
         begin
           DigitPending := True;
         end
         //otherwise, no more TimeValues allowed after this
         else
         begin
           TimeIndex := tiMSec + 1;
           DigitPending := False;
         end;
       end;//AM/PM
       Inc(Cur)
     end;//while

     //If we arrive here, parsing the elements has been successfull
     //if not at least Hours specified then input is not valid
     //when am/pm is specified Hour must be <= 12 and not 0
     if (TimeIndex = tiHour) or ((AmPm <> AMPM_None) and ((TimeValues[tiHour] > 12) or (TimeValues[tiHour] = 0))) or DigitPending then Exit;
     Result := True;
   end;

begin
  if separator = #0 then
        separator := defs.TimeSeparator;
  AmPm := AMPM_None;
  if not SplitElements(TimeValues, AmPm) then
  begin
    ErrorMsg:=Format(SErrInvalidTimeFormat,[StrPas(S, Len)]);
    Exit;
  end;
  if (AmPm=AMPM_PM) and (TimeValues[tiHour]<>12) then Inc(TimeValues[tiHour], 12)
  else if (AmPm=AMPM_AM) and (TimeValues[tiHour]=12) then TimeValues[tiHour]:=0;

  if not TryEncodeTime(TimeValues[tiHour], TimeValues[tiMin], TimeValues[tiSec], TimeValues[tiMSec], result) Then
    //errormsg:='Invalid time.';
    ErrorMsg:=Format(SErrInvalidTimeFormat,[StrPas(S, Len)]);
end ;

function StrToTime(const S: PChar; Len : integer; separator : char = #0): TDateTime;

Var
  Msg : AnsiString;

begin
  Result:=IntStrToTime(Msg,S,Len,DefaultFormatSettings,Separator);
  If (Msg<>'') then
    Raise EConvertError.Create(Msg);
end;

function StrToTime(const S: string; FormatSettings : TFormatSettings): TDateTime;
Var
  Msg : AnsiString;
begin
  Result:=IntStrToTime(Msg, @S[1], length(S), FormatSettings, #0);
  If (Msg<>'') then
    Raise EConvertError.Create(Msg);
end;

function StrToTime(const s: ShortString; separator : char): TDateTime;
begin
   result := StrToTime(@s[1], length(s), separator);
end;

function StrToTime(const s: AnsiString; separator : char): TDateTime;
begin
   result := StrToTime(@s[1], length(s), separator);
end;

function StrToTime(const s: ShortString): TDateTime;
begin
   result := StrToTime(@s[1], length(s), #0);
end;

function StrToTime(const s: AnsiString): TDateTime;
begin
   result := StrToTime(@s[1], length(s), #0);
end;

{   StrToDateTime converts the string S to a TDateTime value
    if S does not represent a valid date and/or time value
    an EConvertError will be raised   }

function StrToDateTime(const s: string): TDateTime;
var
  I: integer;
begin
  I:=Pos(DefaultFormatSettings.TimeSeparator,S);
  If (I>0) then
    begin
    While (I>0) and (S[I]<>' ') do
      Dec(I);
    If I>0 then
      result:=ComposeDateTime(StrToDate(Copy(S,1,I-1)),StrToTime(Copy(S,i+1, Length(S)-i)))
    else
      result:=StrToTime(S)
    end
  else
    Result:=StrToDate(S);
end;

function StrToDateTime(const s: AnsiString; const FormatSettings : TFormatSettings): TDateTime;
var
  I: integer;
begin
  I:=Pos(FormatSettings.TimeSeparator,S);
  If (I>0) then
    begin
    While (I>0) and (S[I]<>' ') do
      Dec(I);
    If I>0 then
      result:=ComposeDateTime(StrToDate(Copy(S,1,I-1),FormatSettings.ShortDateFormat,FormatSettings.DateSeparator),
                              StrToTime(Copy(S,i+1, Length(S)-i),FormatSettings))
    else
      result:=StrToTime(S,FormatSettings)
    end
  else
    Result:=StrToDate(S,FormatSettings.ShortDateFormat,FormatSettings.DateSeparator);
end;

function StrToDateTime(const s: ShortString; const FormatSettings : TFormatSettings): TDateTime;
var
  I: integer;
begin
  I:=Pos(FormatSettings.TimeSeparator,S);
  If (I>0) then
    begin
    While (I>0) and (S[I]<>' ') do
      Dec(I);
    If I>0 then
      result:=ComposeDateTime(StrToDate(Copy(S,1,I-1),FormatSettings.ShortDateFormat,FormatSettings.DateSeparator),
                              StrToTime(Copy(S,i+1, Length(S)-i),FormatSettings.TimeSeparator))
    else
      result:=StrToTime(S,FormatSettings.TimeSeparator)
    end
  else
    Result:=StrToDate(S,FormatSettings.ShortDateFormat,FormatSettings.DateSeparator);
end;

{   FormatDateTime formats DateTime to the given format string FormatStr   }

function FormatDateTime(const FormatStr: string; DateTime: TDateTime): string;
begin
  DateTimeToString(Result, FormatStr, DateTime, DefaultFormatSettings);
end;

function FormatDateTime(const FormatStr: string; DateTime: TDateTime; const FormatSettings: TFormatSettings): string;
begin
  DateTimeToString(Result, FormatStr, DateTime, FormatSettings);
end;

{   DateTimeToString formats DateTime to the given format in FormatStr   }

procedure DateTimeToString(out Result: string; const FormatStr: string; const DateTime: TDateTime);
begin
  DateTimeToString(Result, FormatStr, DateTime, DefaultFormatSettings);
end;

procedure DateTimeToString(out Result: string; const FormatStr: string; const DateTime: TDateTime; const FormatSettings: TFormatSettings);
var
  ResultLen: integer;
  ResultBuffer: array[0..255] of char;
  ResultCurrent: pchar;
{$IFDEF MSWindows}
  isEnable_E_Format : Boolean;
  isEnable_G_Format : Boolean;
  eastasiainited : boolean;
{$ENDIF MSWindows}

{$IFDEF MSWindows}
  procedure InitEastAsia;
  var     ALCID : LCID;
         PriLangID , SubLangID : Word;

  begin
    ALCID := GetThreadLocale;
    PriLangID := ALCID and $3FF;
    if (PriLangID>0) then
       SubLangID := (ALCID and $FFFF) shr 10
      else
        begin
          PriLangID := SysLocale.PriLangID;
          SubLangID := SysLocale.SubLangID;
        end;
    isEnable_E_Format := (PriLangID = LANG_JAPANESE)
                  or
                  (PriLangID = LANG_KOREAN)
                  or
                  ((PriLangID = LANG_CHINESE)
                   and
                   (SubLangID = SUBLANG_CHINESE_TRADITIONAL)
                  );
    isEnable_G_Format := (PriLangID = LANG_JAPANESE)
                  or
                  ((PriLangID = LANG_CHINESE)
                   and
                   (SubLangID = SUBLANG_CHINESE_TRADITIONAL)
                  );
    eastasiainited :=true;
  end;
{$ENDIF MSWindows}

  procedure StoreStr(Str: PChar; Len: Integer);
  begin
    if ResultLen + Len < SizeOf(ResultBuffer) then
    begin
      StrMove(ResultCurrent, Str, Len);
      ResultCurrent := ResultCurrent + Len;
      ResultLen := ResultLen + Len;
    end;
  end;

  procedure StoreString(const Str: string);
  var Len: integer;
  begin
   Len := Length(Str);
   if ResultLen + Len < SizeOf(ResultBuffer) then
     begin
       StrMove(ResultCurrent, pchar(Str), Len);
       ResultCurrent := ResultCurrent + Len;
       ResultLen := ResultLen + Len;
     end;
  end;

  procedure StoreInt(Value, Digits: Integer);
  var
    S: string[16];
    Len: integer;
  begin
    System.Str(Value:Digits, S);
    for Len := 1 to Length(S) do
    begin
      if S[Len] = ' ' then
        S[Len] := '0'
      else
        Break;
    end;
    StoreStr(pchar(@S[1]), Length(S));
  end ;

var
  Year, Month, Day, DayOfWeek, Hour, Minute, Second, MilliSecond: word;
  DT : TDateTime;

  procedure StoreFormat(const FormatStr: string; Nesting: Integer; TimeFlag: Boolean);
  var
    Token, lastformattoken: char;
    FormatCurrent: pchar;
    FormatEnd: pchar;
    Count: integer;
    Clock12: boolean;
    P: pchar;
    tmp: integer;

  begin
    if Nesting > 1 then  // 0 is original string, 1 is included FormatString
      Exit;

    FormatCurrent := PChar(FormatStr);
    FormatEnd := FormatCurrent + Length(FormatStr);
    Clock12 := false;
    P := FormatCurrent;
    // look for unquoted 12-hour clock token
    while P < FormatEnd do
    begin
      Token := P^;
      case Token of
        '''', '"':
        begin
          Inc(P);
          while (P < FormatEnd) and (P^ <> Token) do
            Inc(P);
        end;
        'A', 'a':
        begin
          if (StrLIComp(P, 'A/P', 3) = 0) or
             (StrLIComp(P, 'AMPM', 4) = 0) or
             (StrLIComp(P, 'AM/PM', 5) = 0) then
          begin
            Clock12 := true;
            break;
          end;
        end;
      end;  // case
      Inc(P);
    end ;
    token := #255;
    lastformattoken := ' ';
    while FormatCurrent < FormatEnd do
    begin
      Token := UpCase(FormatCurrent^);
      Count := 1;
      P := FormatCurrent + 1;
      case Token of
        '''', '"':
        begin
          while (P < FormatEnd) and (p^ <> Token) do
            Inc(P);
          Inc(P);
          Count := P - FormatCurrent;
          StoreStr(FormatCurrent + 1, Count - 2);
        end ;
        'A':
        begin
          if StrLIComp(FormatCurrent, 'AMPM', 4) = 0 then
          begin
            Count := 4;
            if Hour < 12 then
              StoreString(FormatSettings.TimeAMString)
            else
              StoreString(FormatSettings.TimePMString);
          end
          else if StrLIComp(FormatCurrent, 'AM/PM', 5) = 0 then
          begin
            Count := 5;
            if Hour < 12 then StoreStr(FormatCurrent, 2)
                         else StoreStr(FormatCurrent+3, 2);
          end
          else if StrLIComp(FormatCurrent, 'A/P', 3) = 0 then
          begin
            Count := 3;
            if Hour < 12 then StoreStr(FormatCurrent, 1)
                         else StoreStr(FormatCurrent+2, 1);
          end
          else
            raise EConvertError.Create('Illegal character in format string');
        end ;
        '/': StoreStr(@FormatSettings.DateSeparator, 1);
        ':': StoreStr(@FormatSettings.TimeSeparator, 1);
        ' ', 'C', 'D', 'H', 'M', 'N', 'S', 'T', 'Y','Z' :
        begin
          while (P < FormatEnd) and (UpCase(P^) = Token) do
            Inc(P);
          Count := P - FormatCurrent;
          case Token of
            ' ': StoreStr(FormatCurrent, Count);
            'Y': begin
              if Count > 2 then
                StoreInt(Year, 4)
              else
                StoreInt(Year mod 100, 2);
            end;
            'M': begin
              if (lastformattoken = 'H') or TimeFlag then
              begin
                if Count = 1 then
                  StoreInt(Minute, 0)
                else
                  StoreInt(Minute, 2);
              end
              else
              begin
                case Count of
                  1: StoreInt(Month, 0);
                  2: StoreInt(Month, 2);
                  3: StoreString(FormatSettings.ShortMonthNames[Month]);
                else
                  StoreString(FormatSettings.LongMonthNames[Month]);
                end;
              end;
            end;
            'D': begin
              case Count of
                1: StoreInt(Day, 0);
                2: StoreInt(Day, 2);
                3: StoreString(FormatSettings.ShortDayNames[DayOfWeek]);
                4: StoreString(FormatSettings.LongDayNames[DayOfWeek]);
                5: StoreFormat(FormatSettings.ShortDateFormat, Nesting+1, False);
              else
                StoreFormat(FormatSettings.LongDateFormat, Nesting+1, False);
              end ;
            end ;
            'H': if Clock12 then
              begin
                tmp := hour mod 12;
                if tmp=0 then tmp:=12;
                if Count = 1 then
                  StoreInt(tmp, 0)
                else
                  StoreInt(tmp, 2);
              end
              else begin
                if Count = 1 then
		  StoreInt(Hour, 0)
                else
                  StoreInt(Hour, 2);
              end;
            'N': if Count = 1 then
                   StoreInt(Minute, 0)
                 else
                   StoreInt(Minute, 2);
            'S': if Count = 1 then
                   StoreInt(Second, 0)
                 else
                   StoreInt(Second, 2);
            'Z': if Count = 1 then
                   StoreInt(MilliSecond, 0)
                 else
		   StoreInt(MilliSecond, 3);
            'T': if Count = 1 then
		   StoreFormat(FormatSettings.ShortTimeFormat, Nesting+1, True)
                 else
	           StoreFormat(FormatSettings.LongTimeFormat, Nesting+1, True);
            'C': begin
                   StoreFormat(FormatSettings.ShortDateFormat, Nesting+1, False);
                   if (Hour<>0) or (Minute<>0) or (Second<>0) then
                     begin
                      StoreString(' ');
                      StoreFormat(FormatSettings.LongTimeFormat, Nesting+1, True);
                     end;
                 end;
{$IFDEF MSWindows}
            'E':
               begin
                 if not Eastasiainited then InitEastAsia;
                 if Not(isEnable_E_Format) then StoreStr(@FormatCurrent^, 1)
                  else
                   begin
                     while (P < FormatEnd) and (UpCase(P^) = Token) do
                     P := P + 1;
                     Count := P - FormatCurrent;
                     StoreString(ConvertEraYearString(Count,Year,Month,Day));
                   end;
                 lastformattoken:=token;
               end;
             'G':
               begin
                 if not Eastasiainited then InitEastAsia;
                 if Not(isEnable_G_Format) then StoreStr(@FormatCurrent^, 1)
                  else
                   begin
                     while (P < FormatEnd) and (UpCase(P^) = Token) do
                     P := P + 1;
                     Count := P - FormatCurrent;
                     StoreString(ConvertEraString(Count,Year,Month,Day));
                   end;
                 lastformattoken:=token;
               end;
{$ENDIF MSWindows}
          end;
          lastformattoken := token;
        end;
        else
          StoreStr(@Token, 1);
      end ;
      Inc(FormatCurrent, Count);
    end;
  end;

begin
{$ifdef MSWindows}
  eastasiainited:=false;
{$endif MSWindows}
  DecodeDateFully(DateTime, Year, Month, Day, DayOfWeek);
  DecodeTime(DateTime, Hour, Minute, Second, MilliSecond);
  ResultLen := 0;
  ResultCurrent := @ResultBuffer[0];
  if FormatStr <> '' then
    StoreFormat(FormatStr, 0, False)
  else
    StoreFormat('C', 0, False);
  ResultBuffer[ResultLen] := #0;
  result := StrPas(@ResultBuffer[0]);
end ;


Function DateTimeToFileDate(DateTime : TDateTime) : Longint;

Var YY,MM,DD,H,m,s,msec : Word;

begin
  Decodedate (DateTime,YY,MM,DD);
  DecodeTime (DateTime,h,m,s,msec);
{$ifndef unix}
  If (YY<1980) or (YY>2099) then
    Result:=0
  else
    begin
    Result:=(s shr 1) or (m shl 5) or (h shl 11);
    Result:=Result or longint(DD shl 16 or (MM shl 21) or (word(YY-1980) shl 25));
    end;
{$else unix}
  Result:=LocalToEpoch(yy,mm,dd,h,m,s);
{$endif unix}
end;

function CurrentYear: Word;
var
  SysTime: TSystemTime;
begin
  GetLocalTime(SysTime);
  Result := SysTime.Year;
end;

Function FileDateToDateTime (Filedate : Longint) : TDateTime;

{$ifndef unix}
Var Date,Time : Word;

begin
  Date:=FileDate shr 16;
  Time:=FileDate and $ffff;
  Result:=ComposeDateTime(EncodeDate((Date shr 9) + 1980,(Date shr 5) and 15, Date and 31),
          EncodeTime(Time shr 11, (Time shr 5) and 63, (Time and 31) shl 1,0));
end;
{$else unix}
var
  y, mon, d, h, min, s: word;
begin
  EpochToLocal(FileDate,y,mon,d,h,min,s);
  Result:=ComposeDateTime(EncodeDate(y,mon,d),EncodeTime(h,min,s,0));
end;
{$endif unix}

function TryStrToDate(const S: ShortString; out Value: TDateTime): Boolean;
begin
    result := TryStrToDate(S, Value, #0);
end;

function TryStrToDate(const S: ShortString; out Value: TDateTime;
                    const useformat : string; separator : char = #0): Boolean;

Var
  Msg : Ansistring;

begin
  Value:=IntStrToDate(Msg,@S[1],Length(S),useformat,defaultformatsettings,separator);
  Result:=(Msg='');
end;

function TryStrToDate(const S: AnsiString; out Value: TDateTime;
                    const useformat : string; separator : char = #0): Boolean;

Var
  Msg : Ansistring;

begin
  Result:=Length(S)<>0;
  If Result then
    begin
    Value:=IntStrToDate(Msg,@S[1],Length(S),useformat,DefaultFormatSettings,Separator);
    Result:=(Msg='');
    end;
end;

function TryStrToDate(const S: ShortString; out Value: TDateTime; separator : char): Boolean;
begin
  Result:=TryStrToDate(S,Value,DefaultFormatSettings.ShortDateFormat,Separator);
end;


function TryStrToDate(const S: AnsiString; out Value: TDateTime): Boolean;
begin
  Result:=TryStrToDate(S,Value,DefaultFormatSettings.ShortDateFormat,#0);
end;

function TryStrToDate(const S: AnsiString; out Value: TDateTime; separator : char): Boolean;

begin
  Result:=TryStrToDate(S,Value,DefaultFormatSettings.ShortDateFormat,Separator);
end;

function TryStrToDate(const S: string; out Value: TDateTime; const FormatSettings: TFormatSettings): Boolean;
Var
  Msg : Ansistring;

begin
  Result:=Length(S)<>0;
  If Result then
    begin
      Value:=IntStrToDate(Msg,@S[1],Length(S),FormatSettings.ShortDateFormat,FormatSettings,#0);
      Result:=(Msg='');
    end;
end;

function TryStrToTime(const S: ShortString; out Value: TDateTime; separator : char): Boolean;

Var
  Msg : AnsiString;
begin
  Value:=IntStrToTime(Msg,@S[1],Length(S),DefaultFormatSettings,Separator);
  result:=(Msg='');
end;

function TryStrToTime(const S: ShortString; out Value: TDateTime): Boolean;
begin
  Result := TryStrToTime(S,Value,#0);
end;

function TryStrToTime(const S: AnsiString; out Value: TDateTime; separator : char): Boolean;
Var
  Msg : AnsiString;
begin
  Result:=Length(S)<>0;
  If Result then
    begin
      Value:=IntStrToTime(Msg,@S[1],Length(S),DefaultFormatSettings,Separator);
      Result:=(Msg='');
    end;
end;

function TryStrToTime(const S: AnsiString; out Value: TDateTime): Boolean;
begin
    result := TryStrToTime(S,Value,#0);
end;

function TryStrToTime(const S: string; out Value: TDateTime; const FormatSettings: TFormatSettings): Boolean;
Var msg : AnsiString;
begin
  Result:=Length(S)<>0;
  If Result then
    begin
      Value:=IntStrToTime(Msg,@S[1],Length(S),FormatSettings,#0);
      Result:=(Msg='');
    end;
end;

function TryStrToDateTime(const S: ShortString; out Value: TDateTime): Boolean;
  begin
    result:=true;
    try
      value:=StrToDateTime(s);
    except
      on EConvertError do
        result:=false
    end;
  end;

function TryStrToDateTime(const S: AnsiString; out Value: TDateTime): Boolean;
  begin
    result:=true;
    try
      value:=StrToDateTime(s);
    except
      on EConvertError do
        result:=false
    end;
  end;

function TryStrToDateTime(const S: string; out Value: TDateTime; const FormatSettings: TFormatSettings): Boolean;
var
  I: integer;
  dtdate, dttime :TDateTime;
begin
  result:=false;
  I:=Pos(FormatSettings.TimeSeparator,S);
  If (I>0) then
    begin
      While (I>0) and (S[I]<>' ') do
        Dec(I);
      If I>0 then
        begin
          if not TryStrToDate(Copy(S,1,I-1),dtdate,Formatsettings) then
            exit;
          if not TryStrToTime(Copy(S,i+1, Length(S)-i),dttime,Formatsettings) then
            exit;
          Value:=ComposeDateTime(dtdate,dttime);
          result:=true;
        end
      else
         result:=TryStrToTime(s,Value,Formatsettings);
    end
  else
    result:=TryStrToDate(s,Value,Formatsettings);
end;

function StrToDateDef(const S: ShortString; const Defvalue : TDateTime): TDateTime;
begin
   result := StrToDateDef(S,DefValue,#0);
end;

function StrToTimeDef(const S: ShortString; const Defvalue : TDateTime): TDateTime;
begin
   result := StrToTimeDef(S,DefValue,#0);
end;

function StrToDateTimeDef(const S: ShortString; const Defvalue : TDateTime): TDateTime;
begin
  if not TryStrToDateTime(s,Result) Then
    result:=defvalue;
end;

function StrToDateDef(const S: ShortString; const Defvalue : TDateTime; separator : char): TDateTime;
begin
  if not TryStrToDate(s,Result, separator) Then
    result:=defvalue;
end;

function StrToTimeDef(const S: ShortString; const Defvalue : TDateTime; separator : char): TDateTime;
begin
  if not TryStrToTime(s,Result, separator) Then
    result:=defvalue;
end;

function StrToDateDef(const S: AnsiString; const Defvalue : TDateTime): TDateTime;
begin
   result := StrToDateDef(S,DefValue,#0);
end;

function StrToTimeDef(const S: AnsiString; const Defvalue : TDateTime): TDateTime;
begin
   result := StrToTimeDef(S,DefValue,#0);
end;

function StrToDateTimeDef(const S: AnsiString; const Defvalue : TDateTime): TDateTime;
begin
  if not TryStrToDateTime(s,Result) Then
    result:=defvalue;
end;

function StrToDateDef(const S: AnsiString; const Defvalue : TDateTime; separator : char): TDateTime;
begin
  if not TryStrToDate(s,Result, separator) Then
    result:=defvalue;
end;

function StrToTimeDef(const S: AnsiString; const Defvalue : TDateTime; separator : char): TDateTime;
begin
  if not TryStrToTime(s,Result, separator) Then
    result:=defvalue;
end;

procedure ReplaceTime(var dati:TDateTime; NewTime : TDateTime);inline;
begin
  dati:= ComposeDateTime(dati, newtime);
end;

procedure ReplaceDate(var DateTime: TDateTime; const NewDate: TDateTime); inline;
var
  tmp : TDateTime;
begin
  tmp:=NewDate;
  ReplaceTime(tmp,DateTime);
  DateTime:=tmp;
end;

{$IFNDEF HAS_LOCALTIMEZONEOFFSET}
Function GetLocalTimeOffset : Integer;

begin
  Result:=0;
end;
{$ENDIF}