1{
2    *********************************************************************
3    Copyright (C) 1997, 1998 Gertjan Schouten
4
5    See the file COPYING.FPC, included in this distribution,
6    for details about the copyright.
7
8    This program is distributed in the hope that it will be useful,
9    but WITHOUT ANY WARRANTY; without even the implied warranty of
10    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
11
12 **********************************************************************
13
14    System Utilities For Free Pascal
15}
16
17{==============================================================================}
18{   internal functions                                                         }
19{==============================================================================}
20
21Function DoEncodeDate(Year, Month, Day: Word): longint;
22
23Var
24  D : TDateTime;
25
26begin
27  If TryEncodeDate(Year,Month,Day,D) then
28    Result:=Trunc(D)
29  else
30    Result:=0;
31end;
32
33function DoEncodeTime(Hour, Minute, Second, MilliSecond: word): TDateTime;
34
35begin
36  If not TryEncodeTime(Hour,Minute,Second,MilliSecond,Result) then
37    Result:=0;
38end;
39
40{==============================================================================}
41{   Public functions                                                           }
42{==============================================================================}
43
44{   ComposeDateTime converts a Date and a Time into one TDateTime   }
45function ComposeDateTime(Date,Time : TDateTime) : TDateTime;
46
47begin
48  if Date < 0 then Result := trunc(Date) - Abs(frac(Time))
49  else Result := trunc(Date) + Abs(frac(Time));
50end;
51
52{   DateTimeToTimeStamp converts DateTime to a TTimeStamp   }
53
54function DateTimeToTimeStamp(DateTime: TDateTime): TTimeStamp;
55
56Var
57  D : Double;
58begin
59  D:=DateTime * Single(MSecsPerDay);
60  if D<0 then
61    D:=D-0.5
62  else
63    D:=D+0.5;
64  result.Time := Abs(Trunc(D)) Mod MSecsPerDay;
65  result.Date := DateDelta + Trunc(D) div MSecsPerDay;
66end;
67
68{   TimeStampToDateTime converts TimeStamp to a TDateTime value   }
69
70function TimeStampToDateTime(const TimeStamp: TTimeStamp): TDateTime;
71begin
72  Result := ComposeDateTime(TimeStamp.Date - DateDelta,TimeStamp.Time / MSecsPerDay)
73end;
74
75{   MSecsToTimeStamp   }
76
77function MSecsToTimeStamp(MSecs: comp): TTimeStamp;
78begin
79  result.Date := Trunc(msecs / msecsperday);
80  msecs:= msecs-comp(result.date)*msecsperday;
81  result.Time := Round(MSecs);
82end ;
83
84{   TimeStampToMSecs   }
85
86function TimeStampToMSecs(const TimeStamp: TTimeStamp): comp;
87begin
88  result := TimeStamp.Time + comp(timestamp.date)*msecsperday;
89end ;
90
91Function TryEncodeDate(Year,Month,Day : Word; Out Date : TDateTime) : Boolean;
92
93var
94  c, ya: cardinal;
95begin
96  Result:=(Year>0) and (Year<10000) and
97          (Month in [1..12]) and
98          (Day>0) and (Day<=MonthDays[IsleapYear(Year),Month]);
99 If Result then
100   begin
101     if month > 2 then
102      Dec(Month,3)
103     else
104      begin
105        Inc(Month,9);
106        Dec(Year);
107      end;
108     c:= Year DIV 100;
109     ya:= Year - 100*c;
110     Date := (146097*c) SHR 2 + (1461*ya) SHR 2 + (153*cardinal(Month)+2) DIV 5 + cardinal(Day);
111     // Note that this line can't be part of the line above, since TDateTime is
112     // signed and c and ya are not
113     Date := Date - 693900;
114   end
115end;
116
117function TryEncodeTime(Hour, Min, Sec, MSec:word; Out Time : TDateTime) : boolean;
118
119begin
120  Result:=(Hour<24) and (Min<60) and (Sec<60) and (MSec<1000);
121  If Result then
122    Time:=TDateTime(cardinal(Hour)*3600000+cardinal(Min)*60000+cardinal(Sec)*1000+MSec)/MSecsPerDay;
123end;
124
125{   EncodeDate packs three variables Year, Month and Day into a
126    TDateTime value the result is the number of days since 12/30/1899   }
127
128function EncodeDate(Year, Month, Day: word): TDateTime;
129
130begin
131  If Not TryEncodeDate(Year,Month,Day,Result) then
132    Raise EConvertError.CreateFmt('%d-%d-%d is not a valid date specification',
133                              [Year,Month,Day]);
134end;
135
136{   EncodeTime packs four variables Hour, Minute, Second and MilliSecond into
137    a TDateTime value     }
138
139function EncodeTime(Hour, Minute, Second, MilliSecond:word):TDateTime;
140
141begin
142  If not TryEncodeTime(Hour,Minute,Second,MilliSecond,Result) then
143    Raise EConvertError.CreateFmt('%d:%d:%d.%d is not a valid time specification',
144                              [Hour,Minute,Second,MilliSecond]);
145end;
146
147
148{   DecodeDate unpacks the value Date into three values:
149    Year, Month and Day   }
150
151procedure DecodeDate(Date: TDateTime; out Year, Month, Day: word);
152var
153  ly,ld,lm,j : cardinal;
154begin
155  if Date <= -datedelta then  // If Date is before 1-1-1 then return 0-0-0
156    begin
157    Year := 0;
158    Month := 0;
159    Day := 0;
160    end
161  else
162    begin
163    if Date>0 then
164      Date:=Date+1/(msecsperday*2)
165    else
166      Date:=Date-1/(msecsperday*2);
167    if Date>MaxDateTime then
168      Date:=MaxDateTime;
169//       Raise EConvertError.CreateFmt('%f is not a valid TDatetime encoding, maximum value is %f.',[Date,MaxDateTime]);
170    j := pred((longint(Trunc(System.Int(Date))) + 693900) SHL 2);
171    ly:= j DIV 146097;
172    j:= j - 146097 * cardinal(ly);
173    ld := j SHR 2;
174    j:=(ld SHL 2 + 3) DIV 1461;
175    ld:= (cardinal(ld) SHL 2 + 7 - 1461*j) SHR 2;
176    lm:=(5 * ld-3) DIV 153;
177    ld:= (5 * ld +2 - 153*lm) DIV 5;
178    ly:= 100 * cardinal(ly) + j;
179    if lm < 10 then
180     inc(lm,3)
181    else
182      begin
183        dec(lm,9);
184        inc(ly);
185      end;
186    year:=ly;
187    month:=lm;
188    day:=ld;
189    end;
190end;
191
192
193function DecodeDateFully(const DateTime: TDateTime; out Year, Month, Day, DOW: Word): Boolean;
194begin
195  DecodeDate(DateTime,Year,Month,Day);
196  DOW:=DayOfWeek(DateTime);
197  Result:=IsLeapYear(Year);
198end;
199
200
201{   DecodeTime unpacks Time into four values:
202    Hour, Minute, Second and MilliSecond    }
203
204procedure DecodeTime(Time: TDateTime; out Hour, Minute, Second, MilliSecond: word);
205Var
206  l : cardinal;
207begin
208 l := DateTimeToTimeStamp(Time).Time;
209 Hour   := l div 3600000;
210 l := l mod 3600000;
211 Minute := l div 60000;
212 l := l mod 60000;
213 Second := l div 1000;
214 l := l mod 1000;
215 MilliSecond := l;
216end;
217
218{   DateTimeToSystemTime converts DateTime value to SystemTime   }
219
220procedure DateTimeToSystemTime(DateTime: TDateTime; out SystemTime: TSystemTime);
221begin
222  DecodeDateFully(DateTime, SystemTime.Year, SystemTime.Month, SystemTime.Day,SystemTime.DayOfWeek);
223  DecodeTime(DateTime, SystemTime.Hour, SystemTime.Minute, SystemTime.Second, SystemTime.MilliSecond);
224  Dec(SystemTime.DayOfWeek);
225end ;
226
227{   SystemTimeToDateTime converts SystemTime to a TDateTime value   }
228
229function SystemTimeToDateTime(const SystemTime: TSystemTime): TDateTime;
230begin
231  result := ComposeDateTime(DoEncodeDate(SystemTime.Year, SystemTime.Month, SystemTime.Day),
232                            DoEncodeTime(SystemTime.Hour, SystemTime.Minute, SystemTime.Second, SystemTime.MilliSecond));
233end ;
234
235{   DayOfWeek returns the Day of the week (sunday is day 1)  }
236
237function DayOfWeek(DateTime: TDateTime): integer;
238begin
239  Result := 1 + ((Trunc(DateTime) - 1) mod 7);
240  If (Result<=0) then
241    Inc(Result,7);
242end;
243
244{   Date returns the current Date   }
245
246function Date: TDateTime;
247var
248  SystemTime: TSystemTime;
249begin
250  GetLocalTime(SystemTime);
251  result := DoEncodeDate(SystemTime.Year, SystemTime.Month, SystemTime.Day);
252end ;
253
254{   Time returns the current Time   }
255
256function Time: TDateTime;
257var
258  SystemTime: TSystemTime;
259begin
260  GetLocalTime(SystemTime);
261  Result := DoEncodeTime(SystemTime.Hour,SystemTime.Minute,SystemTime.Second,SystemTime.MilliSecond);
262end ;
263
264{   Now returns the current Date and Time    }
265
266function Now: TDateTime;
267var
268  SystemTime: TSystemTime;
269begin
270  GetLocalTime(SystemTime);
271  result := systemTimeToDateTime(SystemTime);
272end;
273
274{   IncMonth increments DateTime with NumberOfMonths months,
275    NumberOfMonths can be less than zero   }
276
277function IncMonth(const DateTime: TDateTime; NumberOfMonths: integer = 1 ): TDateTime;
278var
279  Year, Month, Day : word;
280begin
281  DecodeDate(DateTime, Year, Month, Day);
282  IncAMonth(Year, Month, Day, NumberOfMonths);
283  result := ComposeDateTime(DoEncodeDate(Year, Month, Day), DateTime);
284end ;
285
286{   IncAMonth is the same as IncMonth, but operates on decoded date  }
287
288procedure IncAMonth(var Year, Month, Day: Word; NumberOfMonths: Integer = 1);
289var
290  TempMonth, S: Integer;
291begin
292  If NumberOfMonths>=0 then
293    s:=1
294  else
295    s:=-1;
296  inc(Year,(NumberOfMonths div 12));
297  TempMonth:=Month+(NumberOfMonths mod 12)-1;
298  if (TempMonth>11) or
299     (TempMonth<0) then
300   begin
301     Dec(TempMonth, S*12);
302     Inc(Year, S);
303   end;
304  Month:=TempMonth+1;          {   Months from 1 to 12   }
305  If (Day>MonthDays[IsLeapYear(Year)][Month]) then
306    Day:=MonthDays[IsLeapYear(Year)][Month];
307end;
308
309{  IsLeapYear returns true if Year is a leap year   }
310
311function IsLeapYear(Year: Word): boolean;
312begin
313  Result := (Year mod 4 = 0) and ((Year mod 100 <> 0) or (Year mod 400 = 0));
314end;
315
316{  DateToStr returns a string representation of Date using ShortDateFormat   }
317
318function DateToStr(Date: TDateTime): string;
319begin
320  DateTimeToString(Result, 'ddddd', Date);
321end ;
322
323function DateToStr(Date: TDateTime; const FormatSettings: TFormatSettings): string;
324begin
325  DateTimeToString(result, FormatSettings.ShortDateFormat, Date, FormatSettings);
326end;
327
328{  TimeToStr returns a string representation of Time using LongTimeFormat   }
329
330function TimeToStr(Time: TDateTime): string;
331begin
332  DateTimeToString(Result, 'tt', Time);
333end ;
334
335function TimeToStr(Time: TDateTime; const FormatSettings: TFormatSettings): string;
336begin
337  DateTimeToString(Result, FormatSettings.LongTimeFormat, Time, FormatSettings);
338end;
339
340{   DateTimeToStr returns a string representation of DateTime using ShortDateFormat and LongTimeFormat   }
341
342Const
343  DateTimeToStrFormat : Array[Boolean] of string = ('c','f');
344
345function DateTimeToStr(DateTime: TDateTime; ForceTimeIfZero : Boolean = False): string;
346begin
347  DateTimeToString(Result, DateTimeToStrFormat[ForceTimeIfZero], DateTime)
348end ;
349
350function DateTimeToStr(DateTime: TDateTime; const FormatSettings: TFormatSettings; ForceTimeIfZero : Boolean = False): string;
351begin
352  DateTimeToString(Result,  DateTimeToStrFormat[ForceTimeIfZero], DateTime ,FormatSettings);
353end;
354
355{   StrToDate converts the string S to a TDateTime value
356    if S does not represent a valid date value
357    an EConvertError will be raised   }
358
359function IntStrToDate(Out ErrorMsg : AnsiString; const S: PChar; Len : integer; const useformat : string; const defs:TFormatSettings; separator : char = #0): TDateTime;
360
361const SInvalidDateFormat = '"%s" is not a valid date format';
362
363procedure FixErrorMsg(const errm :ansistring;const errmarg : ansistring);
364
365begin
366  errormsg:=format(errm,[errmarg]);
367end;
368
369var
370   df:string;
371   d,m,y,ly:integer;
372   n,i:longint;
373   c:word;
374   dp,mp,yp,which : Byte;
375   s1:string;
376   values:array[0..3] of longint;
377   LocalTime:tsystemtime;
378   YearMoreThenTwoDigits : boolean;
379begin
380  ErrorMsg:='';   Result:=0;
381  While (Len>0) and (S[Len-1] in [' ',#8,#9,#10,#12,#13]) do
382    Dec(len);
383  if (Len=0) then
384    begin
385      FixErrorMsg(SInvalidDateFormat,'');
386      exit;
387    end;
388  YearMoreThenTwoDigits := False;
389  if separator = #0 then
390    separator := defs.DateSeparator;
391  df := UpperCase(useFormat);
392  { Determine order of D,M,Y }
393  yp:=0;
394  mp:=0;
395  dp:=0;
396  Which:=0;
397  i:=0;
398  while (i<Length(df)) and (Which<3) do
399   begin
400     inc(i);
401     Case df[i] of
402       'Y' :
403         if yp=0 then
404          begin
405            Inc(Which);
406            yp:=which;
407          end;
408       'M' :
409         if mp=0 then
410          begin
411            Inc(Which);
412            mp:=which;
413          end;
414       'D' :
415         if dp=0 then
416          begin
417            Inc(Which);
418            dp:=which;
419          end;
420     end;
421   end;
422  for i := 1 to 3 do
423    values[i] := 0;
424  s1 := '';
425  n := 0;
426  dec(len);
427  for i := 0 to len do
428   begin
429     if s[i] in ['0'..'9'] then
430      s1 := s1 + s[i];
431
432     { space can be part of the shortdateformat, and is defaultly in slovak
433       windows, therefor it shouldn't be taken as separator (unless so specified)
434       and ignored }
435     if (Separator <> ' ') and (s[i] = ' ') then
436       Continue;
437
438     if (s[i] = separator) or ((i = len) and (s[i] in ['0'..'9'])) then
439      begin
440        inc(n);
441        if n>3 then
442          begin
443            FixErrorMsg(SInvalidDateFormat,s);
444            exit;
445          end;
446         // Check if the year has more then two digits (if n=yp, then we are evaluating the year.)
447        if (n=yp) and (length(s1)>2) then YearMoreThenTwoDigits := True;
448        val(s1, values[n], c);
449//        Writeln(s1,'->',values[n]);
450        if c<>0 then
451          begin
452            FixErrorMsg(SInvalidDateFormat,s);
453            Exit;
454          end;
455        s1 := '';
456      end
457     else if not (s[i] in ['0'..'9']) then
458       begin
459         FixErrorMsg(SInvalidDateFormat,s);
460         Exit;
461       end;
462   end ;
463   if (Which<3) and (N>Which) then
464    begin
465    FixErrorMsg(SInvalidDateFormat,s);
466    Exit;
467    end;
468  // Fill in values.
469  getLocalTime(LocalTime);
470  ly := LocalTime.Year;
471  for I:=1 to 3 do
472    if values[i]>high(Word) then
473      begin
474      errormsg:='Invalid date';
475      exit;
476      end;
477  If N=3 then
478   begin
479     y:=values[yp];
480     m:=values[mp];
481     d:=values[dp];
482   end
483  Else
484  begin
485    Y:=ly;
486    If n<2 then
487     begin
488       d:=values[1];
489       m := LocalTime.Month;
490     end
491    else
492     If dp<mp then
493      begin
494        d:=values[1];
495        m:=values[2];
496      end
497    else
498      begin
499        d:=values[2];
500        m:=values[1];
501      end;
502  end;
503  if (y >= 0) and (y < 100) and not YearMoreThenTwoDigits then
504    begin
505    ly := ly - defs.TwoDigitYearCenturyWindow;
506    Inc(Y, ly div 100 * 100);
507    if (defs.TwoDigitYearCenturyWindow > 0) and (Y < ly) then
508      Inc(Y, 100);
509    end;
510
511  if not TryEncodeDate(y, m, d, result) then
512    errormsg:='Invalid date';
513end;
514
515function StrToDate(const S: PChar; Len : integer; const useformat : string; separator : char = #0): TDateTime;
516
517Var
518  MSg : AnsiString;
519
520begin
521  Result:=IntStrToDate(Msg,S,Len,useFormat,DefaultFormatSettings,Separator);
522  If (Msg<>'') then
523    Raise EConvertError.Create(Msg);
524end;
525
526function StrToDate(const S: string; FormatSettings: TFormatSettings): TDateTime;
527var
528  Msg: AnsiString;
529begin
530  Result:=IntStrToDate(Msg,PChar(S),Length(S),FormatSettings.ShortDateFormat,FormatSettings);
531  if Msg<>'' then
532    raise EConvertError.Create(Msg);
533end;
534
535function StrToDate(const S: ShortString; const useformat : string; separator : char = #0): TDateTime;
536begin
537  // S[1] always exists for shortstring. Length 0 will trigger an error.
538  result := StrToDate(@S[1],Length(s),UseFormat,separator);
539end;
540
541function StrToDate(const S: AnsiString; const useformat : string; separator : char = #0): TDateTime;
542begin
543  result := StrToDate(PChar(S),Length(s),UseFormat,separator);
544end;
545
546function StrToDate(const S: ShortString; separator : char): TDateTime;
547begin
548  // S[1] always exists for shortstring. Length 0 will trigger an error.
549  result := StrToDate(@S[1],Length(s),DefaultFormatSettings.ShortDateFormat,separator)
550end;
551
552function StrToDate(const S: ShortString): TDateTime;
553begin
554  // S[1] always exists for shortstring. Length 0 will trigger an error.
555  result := StrToDate(@S[1],Length(s),DefaultFormatSettings.ShortDateFormat,#0);
556end;
557
558function StrToDate(const S: AnsiString; separator : char): TDateTime;
559begin
560    result := StrToDate(Pchar(S),Length(s),DefaultFormatSettings.ShortDateFormat,separator)
561end;
562
563function StrToDate(const S: AnsiString): TDateTime;
564begin
565  result := StrToDate(Pchar(S),Length(s),DefaultFormatSettings.ShortDateFormat,#0);
566end;
567
568{   StrToTime converts the string S to a TDateTime value
569    if S does not represent a valid time value an
570    EConvertError will be raised   }
571
572
573function IntStrToTime(Out ErrorMsg : AnsiString; const S: PChar; Len : integer;const defs:TFormatSettings; separator : char = #0): TDateTime;
574const
575  AMPM_None = 0;
576  AMPM_AM = 1;
577  AMPM_PM = 2;
578  tiHour = 0;
579  tiMin = 1;
580  tiSec = 2;
581  tiMSec = 3;
582type
583  TTimeValues = array[tiHour..tiMSec] of Word;
584var
585   AmPm: integer;
586   TimeValues: TTimeValues;
587
588    function StrPas(Src : PChar; len: integer = 0) : ShortString;
589    begin
590        //this is unsafe for len > 255, it will trash memory (I tested this)
591        //reducing it is safe, since whenever we use this a string > 255 is invalid anyway
592        if len > 255 then len := 255;
593        SetLength(Result, len);
594        move(src[0],result[1],len);
595    end;
596
597   function SplitElements(out TimeValues: TTimeValues; out AmPm: Integer): Boolean;
598   //Strict version. It does not allow #32 as Separator, it will treat it as whitespace always
599   const
600     Digits = ['0'..'9'];
601   var
602      Cur, Offset, ElemLen, Err, TimeIndex, FirstSignificantDigit: Integer;
603      Value: Word;
604      DigitPending, MSecPending: Boolean;
605      AmPmStr: ShortString;
606      CurChar: Char;
607   begin
608     Result := False;
609     AmPm := AMPM_None; //No Am or PM in string found yet
610     MSecPending := False;
611     TimeIndex := 0; //indicating which TTimeValue must be filled next
612     FillChar(TimeValues, SizeOf(TTimeValues), 0);
613     Cur := 0;
614     //skip leading blanks
615     While (Cur < Len) and (S[Cur] =#32) do Inc(Cur);
616     Offset := Cur;
617     //First non-blank cannot be Separator or DecimalSeparator
618     if (Cur > Len - 1) or (S[Cur] = Separator) or (S[Cur] = defs.Decimalseparator) then Exit;
619     DigitPending := (S[Cur] in Digits);
620     While (Cur < Len) do
621     begin
622       //writeln;
623       //writeln('Main While loop:  Cur = ',Cur,' S[Cur] = "',S[Cur],'" Len = ',Len);
624       CurChar := S[Cur];
625       if CurChar in Digits then
626       begin//Digits
627         //HH, MM, SS, or Msec?
628         //writeln('Digit');
629         //Digits are only allowed after starting Am/PM or at beginning of string or after Separator
630         //and TimeIndex must be <= tiMSec
631         //Uncomment "or (#32 = Separator)" and it will allllow #32 as separator
632         if (not (DigitPending {or (#32 = Separator)})) or (TimeIndex > tiMSec) then Exit;
633         OffSet := Cur;
634         if (CurChar <> '0') then FirstSignificantDigit := OffSet else FirstSignificantDigit := -1;
635         while (Cur < Len -1) and (S[Cur + 1] in Digits) do
636         begin
637           //Mark first Digit that is not '0'
638           if (FirstSignificantDigit = -1) and (S[Cur] <> '0') then FirstSignificantDigit := Cur;
639           Inc(Cur);
640         end;
641         if (FirstSignificantDigit = -1) then FirstSignificantDigit := Cur;
642         ElemLen := 1 + Cur - FirstSignificantDigit;
643         //writeln('  S[FirstSignificantDigit] = ',S[FirstSignificantDigit], ' S[Cur] = ',S[Cur],' ElemLen = ',ElemLen,' -> ', StrPas(S + Offset, ElemLen));
644         //writeln('  Cur = ',Cur);
645         //this way we know that Val() will never overflow Value !
646         if (ElemLen <= 2) or ((ElemLen <= 3) and (TimeIndex = tiMSec) ) then
647         begin
648           Val(StrPas(S + FirstSignificantDigit, ElemLen), Value, Err);
649           //writeln('  Value = ',Value,' HH = ',TimeValues[0],' MM = ',TimeValues[1],' SS = ',TimeValues[2],' MSec = ',Timevalues[3]);
650           //This is safe now, because we know Value < High(Word)
651           TimeValues[TimeIndex] := Value;
652           Inc(TimeIndex);
653           DigitPending := False;
654         end
655         else  Exit; //Value to big, so it must be a wrong timestring
656       end//Digits
657       else if (CurChar = #32) then
658       begin
659         //writeln('#32');
660         //just skip, but we must adress this, or it will be parsed by either AM/PM or Separator
661       end
662       else if (CurChar = Separator) then
663       begin
664         //writeln('Separator');
665         if DigitPending or (TimeIndex > tiSec) then Exit;
666         DigitPending := True;
667         MSecPending := False;
668       end
669       else if (CurChar = defs.DecimalSeparator) then
670       begin
671         //writeln('DecimalSeparator');
672         if DigitPending or MSecPending or (TimeIndex <> tiMSec) then Exit;
673         DigitPending := True;
674         MSecPending := True;
675       end
676       else
677       begin//AM/PM?
678         //None of the above, so this char _must_ be the start of AM/PM string
679         //If we already have found AM/PM or we expect a digit then then timestring must be wrong at this point
680         //writeln('AM/PM?');
681         if (AmPm <> AMPM_None) or DigitPending then Exit;
682         OffSet := Cur;
683         while (Cur < Len -1) and (not (S[Cur + 1] in [Separator, #32, defs.DecimalSeparator]))
684           and not (S[Cur + 1] in Digits) do Inc(Cur);
685         ElemLen := 1 + Cur - OffSet;
686         //writeln('  S[Offset] = ',S[Offset], ' S[Cur] = ',S[Cur],' ElemLen = ',ElemLen,' -> ', StrPas(S + Offset, ElemLen));
687         //writeln('  Cur = ',Cur);
688         AmPmStr := StrPas(S + OffSet, ElemLen);
689
690         //writeln('AmPmStr = ',ampmstr,' (',length(ampmstr),')');
691         //We must compare to TimeAMString before hardcoded 'AM' for delphi compatibility
692         //Also it is perfectly legal, though insane to have TimeAMString = 'PM' and vice versa
693         if (AnsiCompareText(AmPmStr, defs.TimeAMString) = 0) then AmPm := AMPM_AM
694         else if (AnsiCompareText(AmPmStr, defs.TimePMString) = 0) then AmPm := AMPM_PM
695         else if (CompareText(AmPmStr, 'AM') = 0) then AmPm := AMPM_AM
696         else if (CompareText(AmPmStr, 'PM') = 0) then AmPm := AMPM_PM
697         else Exit; //If text does not match any of these, timestring must be wrong;
698         //if AM/PM is at beginning of string, then a digit is mandatory after it
699         if (TimeIndex = tiHour) then
700         begin
701           DigitPending := True;
702         end
703         //otherwise, no more TimeValues allowed after this
704         else
705         begin
706           TimeIndex := tiMSec + 1;
707           DigitPending := False;
708         end;
709       end;//AM/PM
710       Inc(Cur)
711     end;//while
712
713     //If we arrive here, parsing the elements has been successfull
714     //if not at least Hours specified then input is not valid
715     //when am/pm is specified Hour must be <= 12 and not 0
716     if (TimeIndex = tiHour) or ((AmPm <> AMPM_None) and ((TimeValues[tiHour] > 12) or (TimeValues[tiHour] = 0))) or DigitPending then Exit;
717     Result := True;
718   end;
719
720begin
721  if separator = #0 then
722        separator := defs.TimeSeparator;
723  AmPm := AMPM_None;
724  if not SplitElements(TimeValues, AmPm) then
725  begin
726    ErrorMsg:=Format(SErrInvalidTimeFormat,[StrPas(S, Len)]);
727    Exit;
728  end;
729  if (AmPm=AMPM_PM) and (TimeValues[tiHour]<>12) then Inc(TimeValues[tiHour], 12)
730  else if (AmPm=AMPM_AM) and (TimeValues[tiHour]=12) then TimeValues[tiHour]:=0;
731
732  if not TryEncodeTime(TimeValues[tiHour], TimeValues[tiMin], TimeValues[tiSec], TimeValues[tiMSec], result) Then
733    //errormsg:='Invalid time.';
734    ErrorMsg:=Format(SErrInvalidTimeFormat,[StrPas(S, Len)]);
735end ;
736
737function StrToTime(const S: PChar; Len : integer; separator : char = #0): TDateTime;
738
739Var
740  Msg : AnsiString;
741
742begin
743  Result:=IntStrToTime(Msg,S,Len,DefaultFormatSettings,Separator);
744  If (Msg<>'') then
745    Raise EConvertError.Create(Msg);
746end;
747
748function StrToTime(const S: string; FormatSettings : TFormatSettings): TDateTime;
749Var
750  Msg : AnsiString;
751begin
752  Result:=IntStrToTime(Msg, PChar(S), length(S), FormatSettings, #0);
753  If (Msg<>'') then
754    Raise EConvertError.Create(Msg);
755end;
756
757function StrToTime(const s: ShortString; separator : char): TDateTime;
758begin
759  // S[1] always exists for shortstring. Length 0 will trigger an error.
760  result := StrToTime(@s[1], length(s), separator);
761end;
762
763function StrToTime(const s: AnsiString; separator : char): TDateTime;
764begin
765   result := StrToTime(PChar(S), length(s), separator);
766end;
767
768function StrToTime(const s: ShortString): TDateTime;
769begin
770  // S[1] always exists for shortstring. Length 0 will trigger an error.
771   result := StrToTime(@s[1], length(s), #0);
772end;
773
774function StrToTime(const s: AnsiString): TDateTime;
775begin
776   result:= StrToTime(PChar(s), length(s), #0);
777end;
778
779{   StrToDateTime converts the string S to a TDateTime value
780    if S does not represent a valid date and/or time value
781    an EConvertError will be raised   }
782
783function SplitDateTimeStr(DateTimeStr: AnsiString; const FS: TFormatSettings; out DateStr, TimeStr: AnsiString): Integer;
784
785{ Helper function for StrToDateTime
786  Pre-condition
787    Date is before Time
788    If either Date or Time is omitted then see what fits best, a time or a date (issue #0020522)
789    Date and Time are separated by whitespace (space Tab, Linefeed or carriage return)
790    FS.DateSeparator can be the same as FS.TimeSeparator (issue #0020522)
791    If they are both #32 and TrimWhite(DateTimeStr) contains a #32 a date is assumed.
792  Post-condition
793    DateStr holds date as string or is empty
794    TimeStr holds time as string or is empty
795    Result = number of strings returned, 0 = error
796}
797const
798  WhiteSpace = [#9,#10,#13,#32];
799  Space : String = #32; // String, to avoid error 'Cannot decide what overload to call'
800
801var
802  p: Integer;
803  DummyDT: TDateTime;
804begin
805  Result := 0;
806  DateStr := '';
807  TimeStr := '';
808  DateTimeStr := Trim(DateTimeStr);
809  if Length(DateTimeStr) = 0 then exit;
810  if (FS.DateSeparator = #32) and (FS.TimeSeparator = #32) and (Pos(#32, DateTimeStr) > 0) then
811    begin
812    DateStr:=DateTimeStr;
813    {
814      Assume a date: dd [mm [yy]].
815      Really fancy would be counting the number of whitespace occurrences and decide
816      and split accordingly
817    }
818    Exit(1);
819    end;
820  p:=1;
821  //find separator
822  if Pos(Space,FS.DateSeparator)=0 then
823    begin
824    while (p<Length(DateTimeStr)) and (not (DateTimeStr[p+1] in WhiteSpace)) do
825      Inc(p);
826    end
827  else
828    begin
829    p:=Pos(FS.TimeSeparator, DateTimeStr);
830    if (p<>0) then
831      repeat
832        Dec(p);
833      until (p=0) or (DateTimeStr[p] in WhiteSpace);
834    end;
835  //Always fill DateStr, it eases the algorithm later
836  if (p=0) then
837    p:=Length(DateTimeStr);
838  DateStr:=Copy(DateTimeStr,1,p);
839  TimeStr:=Trim(Copy(DateTimeStr,p+1,MaxInt));
840  if (Length(TimeStr)<>0) then
841    Result:=2
842  else
843    begin
844    Result:=1; //found 1 string
845    // 2 cases when DateTimeStr only contains a time:
846    // Date/time separator differ, and string contains a timeseparator
847    // Date/time separators are equal, but transformation to date fails.
848    if ((FS.DateSeparator<>FS.TimeSeparator) and (Pos(FS.TimeSeparator,DateStr) > 0))
849       or ((FS.DateSeparator=FS.TimeSeparator) and (not TryStrToDate(DateStr, DummyDT, FS)))  then
850      begin
851      TimeStr := DateStr;
852      DateStr := '';
853      end;
854    end;
855end;
856
857
858function StrToDateTime(const s: AnsiString; const FormatSettings : TFormatSettings): TDateTime;
859var
860  TimeStr, DateStr: AnsiString;
861  PartsFound: Integer;
862begin
863  PartsFound := SplitDateTimeStr(S, FormatSettings, DateStr, TimeStr);
864  case PartsFound of
865    0: Result:=StrToDate('');
866    1: if (Length(DateStr) > 0) then
867         Result := StrToDate(DateStr, FormatSettings.ShortDateFormat,FormatSettings.DateSeparator)
868       else
869         Result := StrToTime(TimeStr, FormatSettings);
870    2: Result := ComposeDateTime(StrTodate(DateStr,FormatSettings.ShortDateFormat,FormatSettings.DateSeparator),
871                                  StrToTime(TimeStr,FormatSettings));
872  end;
873end;
874
875function StrToDateTime(const s: AnsiString): TDateTime;
876begin
877  Result:=StrToDateTime(S,DefaultFormatSettings);
878end;
879
880function StrToDateTime(const s: ShortString; const FormatSettings : TFormatSettings): TDateTime;
881
882var
883  A : AnsiString;
884begin
885  A:=S;
886  Result:=StrToDateTime(A,FormatSettings);
887end;
888
889{   FormatDateTime formats DateTime to the given format string FormatStr   }
890
891function FormatDateTime(const FormatStr: string; DateTime: TDateTime; Options : TFormatDateTimeOptions = []): string;
892begin
893  DateTimeToString(Result, FormatStr, DateTime, DefaultFormatSettings,Options);
894end;
895
896function FormatDateTime(const FormatStr: string; DateTime: TDateTime; const FormatSettings: TFormatSettings; Options : TFormatDateTimeOptions = []): string;
897begin
898  DateTimeToString(Result, FormatStr, DateTime, FormatSettings,Options);
899end;
900
901{   DateTimeToString formats DateTime to the given format in FormatStr   }
902
903procedure DateTimeToString(out Result: string; const FormatStr: string;
904  const DateTime: TDateTime; Options : TFormatDateTimeOptions = []);
905begin
906  DateTimeToString(Result, FormatStr, DateTime, DefaultFormatSettings, Options);
907end;
908
909procedure DateTimeToString(out Result: string; const FormatStr: string; const DateTime: TDateTime;
910  const FormatSettings: TFormatSettings; Options : TFormatDateTimeOptions = []);
911var
912  ResultLen: integer;
913  ResultBuffer: array[0..255] of char;
914  ResultCurrent: pchar;
915{$if defined(win32) or defined(win64)}
916  isEnable_E_Format : Boolean;
917  isEnable_G_Format : Boolean;
918  eastasiainited : boolean;
919
920  procedure InitEastAsia;
921  var     ALCID : LCID;
922         PriLangID , SubLangID : Word;
923
924  begin
925    ALCID := GetThreadLocale;
926    PriLangID := ALCID and $3FF;
927    if (PriLangID>0) then
928       SubLangID := (ALCID and $FFFF) shr 10
929      else
930        begin
931          PriLangID := SysLocale.PriLangID;
932          SubLangID := SysLocale.SubLangID;
933        end;
934    isEnable_E_Format := (PriLangID = LANG_JAPANESE)
935                  or
936                  (PriLangID = LANG_KOREAN)
937                  or
938                  ((PriLangID = LANG_CHINESE)
939                   and
940                   (SubLangID = SUBLANG_CHINESE_TRADITIONAL)
941                  );
942    isEnable_G_Format := (PriLangID = LANG_JAPANESE)
943                  or
944                  ((PriLangID = LANG_CHINESE)
945                   and
946                   (SubLangID = SUBLANG_CHINESE_TRADITIONAL)
947                  );
948    eastasiainited :=true;
949  end;
950{$endif win32 or win64}
951
952  procedure StoreStr(Str: PChar; Len: Integer);
953  begin
954    if ResultLen + Len < SizeOf(ResultBuffer) then
955    begin
956      StrMove(ResultCurrent, Str, Len);
957      ResultCurrent := ResultCurrent + Len;
958      ResultLen := ResultLen + Len;
959    end;
960  end;
961
962  procedure StoreString(const Str: string);
963  var Len: integer;
964  begin
965   Len := Length(Str);
966   if ResultLen + Len < SizeOf(ResultBuffer) then
967     begin
968       StrMove(ResultCurrent, pchar(Str), Len);
969       ResultCurrent := ResultCurrent + Len;
970       ResultLen := ResultLen + Len;
971     end;
972  end;
973
974  procedure StoreInt(Value, Digits: Integer);
975  var
976    S: string[16];
977    Len: integer;
978  begin
979    System.Str(Value:Digits, S);
980    for Len := 1 to Length(S) do
981    begin
982      if S[Len] = ' ' then
983        S[Len] := '0'
984      else
985        Break;
986    end;
987    StoreStr(pchar(@S[1]), Length(S));
988  end ;
989
990var
991  Year, Month, Day, DayOfWeek, Hour, Minute, Second, MilliSecond: word;
992
993  procedure StoreFormat(const FormatStr: string; Nesting: Integer; TimeFlag: Boolean);
994  var
995    Token, lastformattoken, prevlasttoken: char;
996    FormatCurrent: pchar;
997    FormatEnd: pchar;
998    Count: integer;
999    Clock12: boolean;
1000    P: pchar;
1001    tmp: integer;
1002    isInterval: Boolean;
1003
1004  begin
1005    if Nesting > 1 then  // 0 is original string, 1 is included FormatString
1006      Exit;
1007
1008    FormatCurrent := PChar(FormatStr);
1009    FormatEnd := FormatCurrent + Length(FormatStr);
1010    Clock12 := false;
1011    isInterval := false;
1012    P := FormatCurrent;
1013    // look for unquoted 12-hour clock token
1014    while P < FormatEnd do
1015    begin
1016      Token := P^;
1017      case Token of
1018        '''', '"':
1019        begin
1020          Inc(P);
1021          while (P < FormatEnd) and (P^ <> Token) do
1022            Inc(P);
1023        end;
1024        'A', 'a':
1025        begin
1026          if (StrLIComp(P, 'A/P', 3) = 0) or
1027             (StrLIComp(P, 'AMPM', 4) = 0) or
1028             (StrLIComp(P, 'AM/PM', 5) = 0) then
1029          begin
1030            Clock12 := true;
1031            break;
1032          end;
1033        end;
1034      end;  // case
1035      Inc(P);
1036    end ;
1037    token := #255;
1038    lastformattoken := ' ';
1039    prevlasttoken := 'H';
1040    while FormatCurrent < FormatEnd do
1041    begin
1042      Token := UpCase(FormatCurrent^);
1043      Count := 1;
1044      P := FormatCurrent + 1;
1045      case Token of
1046        '''', '"':
1047        begin
1048          while (P < FormatEnd) and (p^ <> Token) do
1049            Inc(P);
1050          Inc(P);
1051          Count := P - FormatCurrent;
1052          StoreStr(FormatCurrent + 1, Count - 2);
1053        end ;
1054        'A':
1055        begin
1056          if StrLIComp(FormatCurrent, 'AMPM', 4) = 0 then
1057          begin
1058            Count := 4;
1059            if Hour < 12 then
1060              StoreString(FormatSettings.TimeAMString)
1061            else
1062              StoreString(FormatSettings.TimePMString);
1063          end
1064          else if StrLIComp(FormatCurrent, 'AM/PM', 5) = 0 then
1065          begin
1066            Count := 5;
1067            if Hour < 12 then StoreStr(FormatCurrent, 2)
1068                         else StoreStr(FormatCurrent+3, 2);
1069          end
1070          else if StrLIComp(FormatCurrent, 'A/P', 3) = 0 then
1071          begin
1072            Count := 3;
1073            if Hour < 12 then StoreStr(FormatCurrent, 1)
1074                         else StoreStr(FormatCurrent+2, 1);
1075          end
1076          else
1077            raise EConvertError.Create('Illegal character in format string');
1078        end ;
1079        '/': StoreStr(@FormatSettings.DateSeparator, 1);
1080        ':': StoreStr(@FormatSettings.TimeSeparator, 1);
1081	'[': if (fdoInterval in Options) then isInterval := true else StoreStr(FormatCurrent, 1);
1082	']': if (fdoInterval in Options) then isInterval := false else StoreStr(FormatCurrent, 1);
1083        ' ', 'C', 'D', 'H', 'M', 'N', 'S', 'T', 'Y', 'Z', 'F' {$IFDEF MSWindows}, 'G', 'E'{$ENDIF MSWindows} :
1084        begin
1085          while (P < FormatEnd) and (UpCase(P^) = Token) do
1086            Inc(P);
1087          Count := P - FormatCurrent;
1088          case Token of
1089            ' ': StoreStr(FormatCurrent, Count);
1090            'Y': begin
1091              if Count > 2 then
1092                StoreInt(Year, 4)
1093              else
1094                StoreInt(Year mod 100, 2);
1095            end;
1096            'M': begin
1097	      if isInterval and ((prevlasttoken = 'H') or TimeFlag) then
1098	        StoreInt(Minute + (Hour + trunc(abs(DateTime))*24)*60, 0)
1099	      else
1100              if (lastformattoken = 'H') or TimeFlag then
1101              begin
1102                if Count = 1 then
1103                  StoreInt(Minute, 0)
1104                else
1105                  StoreInt(Minute, 2);
1106              end
1107              else
1108              begin
1109                case Count of
1110                  1: StoreInt(Month, 0);
1111                  2: StoreInt(Month, 2);
1112                  3: StoreString(FormatSettings.ShortMonthNames[Month]);
1113                else
1114                  StoreString(FormatSettings.LongMonthNames[Month]);
1115                end;
1116              end;
1117            end;
1118            'D': begin
1119              case Count of
1120                1: StoreInt(Day, 0);
1121                2: StoreInt(Day, 2);
1122                3: StoreString(FormatSettings.ShortDayNames[DayOfWeek]);
1123                4: StoreString(FormatSettings.LongDayNames[DayOfWeek]);
1124                5: StoreFormat(FormatSettings.ShortDateFormat, Nesting+1, False);
1125              else
1126                StoreFormat(FormatSettings.LongDateFormat, Nesting+1, False);
1127              end ;
1128            end ;
1129            'H':
1130	      if isInterval then
1131	        StoreInt(Hour + trunc(abs(DateTime))*24, 0)
1132	      else
1133	      if Clock12 then
1134              begin
1135                tmp := hour mod 12;
1136                if tmp=0 then tmp:=12;
1137                if Count = 1 then
1138                  StoreInt(tmp, 0)
1139                else
1140                  StoreInt(tmp, 2);
1141              end
1142              else begin
1143                if Count = 1 then
1144		  StoreInt(Hour, 0)
1145                else
1146                  StoreInt(Hour, 2);
1147              end;
1148            'N': if isInterval then
1149	           StoreInt(Minute + (Hour + trunc(abs(DateTime))*24)*60, 0)
1150		 else
1151		 if Count = 1 then
1152                   StoreInt(Minute, 0)
1153                 else
1154                   StoreInt(Minute, 2);
1155            'S': if isInterval then
1156	           StoreInt(Second + (Minute + (Hour + trunc(abs(DateTime))*24)*60)*60, 0)
1157	         else
1158	         if Count = 1 then
1159                   StoreInt(Second, 0)
1160                 else
1161                   StoreInt(Second, 2);
1162            'Z': if Count = 1 then
1163                   StoreInt(MilliSecond, 0)
1164                 else
1165		   StoreInt(MilliSecond, 3);
1166            'T': if Count = 1 then
1167		   StoreFormat(FormatSettings.ShortTimeFormat, Nesting+1, True)
1168                 else
1169	           StoreFormat(FormatSettings.LongTimeFormat, Nesting+1, True);
1170            'C': begin
1171                   StoreFormat(FormatSettings.ShortDateFormat, Nesting+1, False);
1172                   if (Hour<>0) or (Minute<>0) or (Second<>0) then
1173                     begin
1174                      StoreString(' ');
1175                      StoreFormat(FormatSettings.LongTimeFormat, Nesting+1, True);
1176                     end;
1177                 end;
1178            'F': begin
1179                   StoreFormat(FormatSettings.ShortDateFormat, Nesting+1, False);
1180                   StoreString(' ');
1181                   StoreFormat(FormatSettings.LongTimeFormat, Nesting+1, True);
1182                 end;
1183{$if defined(win32) or defined(win64)}
1184            'E':
1185               begin
1186                 if not Eastasiainited then InitEastAsia;
1187                 if Not(isEnable_E_Format) then StoreStr(FormatCurrent, 1)
1188                  else
1189                   begin
1190                     while (P < FormatEnd) and (UpCase(P^) = Token) do
1191                     P := P + 1;
1192                     Count := P - FormatCurrent;
1193                     StoreString(ConvertEraYearString(Count,Year,Month,Day));
1194                   end;
1195		 prevlasttoken := lastformattoken;
1196                 lastformattoken:=token;
1197               end;
1198             'G':
1199               begin
1200                 if not Eastasiainited then InitEastAsia;
1201                 if Not(isEnable_G_Format) then StoreStr(FormatCurrent, 1)
1202                  else
1203                   begin
1204                     while (P < FormatEnd) and (UpCase(P^) = Token) do
1205                     P := P + 1;
1206                     Count := P - FormatCurrent;
1207                     StoreString(ConvertEraString(Count,Year,Month,Day));
1208                   end;
1209		 prevlasttoken := lastformattoken;
1210                 lastformattoken:=token;
1211               end;
1212{$endif win32 or win64}
1213          end;
1214	  prevlasttoken := lastformattoken;
1215          lastformattoken := token;
1216        end;
1217        else
1218          StoreStr(@Token, 1);
1219      end ;
1220      Inc(FormatCurrent, Count);
1221    end;
1222  end;
1223
1224begin
1225{$if defined(win32) or defined(win64)}
1226  eastasiainited:=false;
1227{$endif win32 or win64}
1228  DecodeDateFully(DateTime, Year, Month, Day, DayOfWeek);
1229  DecodeTime(DateTime, Hour, Minute, Second, MilliSecond);
1230  ResultLen := 0;
1231  ResultCurrent := @ResultBuffer[0];
1232  if FormatStr <> '' then
1233    StoreFormat(FormatStr, 0, False)
1234  else
1235    StoreFormat('C', 0, False);
1236  ResultBuffer[ResultLen] := #0;
1237  result := StrPas(@ResultBuffer[0]);
1238end ;
1239
1240
1241Function DateTimeToFileDate(DateTime : TDateTime) : Longint;
1242
1243Var YY,MM,DD,H,m,s,msec : Word;
1244
1245begin
1246  Decodedate (DateTime,YY,MM,DD);
1247  DecodeTime (DateTime,h,m,s,msec);
1248{$ifndef unix}
1249  If (YY<1980) or (YY>2099) then
1250    Result:=0
1251  else
1252    begin
1253    Result:=(s shr 1) or (m shl 5) or (h shl 11);
1254    Result:=Result or longint(DD shl 16 or (MM shl 21) or (word(YY-1980) shl 25));
1255    end;
1256{$else unix}
1257  Result:=LocalToEpoch(yy,mm,dd,h,m,s);
1258{$endif unix}
1259end;
1260
1261function CurrentYear: Word;
1262var
1263  SysTime: TSystemTime;
1264begin
1265  GetLocalTime(SysTime);
1266  Result := SysTime.Year;
1267end;
1268
1269Function FileDateToDateTime (Filedate : Longint) : TDateTime;
1270
1271{$ifndef unix}
1272Var Date,Time : Word;
1273
1274begin
1275  Date:=FileDate shr 16;
1276  Time:=FileDate and $ffff;
1277  Result:=ComposeDateTime(EncodeDate((Date shr 9) + 1980,(Date shr 5) and 15, Date and 31),
1278          EncodeTime(Time shr 11, (Time shr 5) and 63, (Time and 31) shl 1,0));
1279end;
1280{$else unix}
1281var
1282  y, mon, d, h, min, s: word;
1283begin
1284  EpochToLocal(FileDate,y,mon,d,h,min,s);
1285  Result:=ComposeDateTime(EncodeDate(y,mon,d),EncodeTime(h,min,s,0));
1286end;
1287{$endif unix}
1288
1289function TryStrToDate(const S: ShortString; out Value: TDateTime): Boolean;
1290begin
1291    result := TryStrToDate(S, Value, #0);
1292end;
1293
1294function TryStrToDate(const S: ShortString; out Value: TDateTime;
1295                    const useformat : string; separator : char = #0): Boolean;
1296
1297Var
1298  Msg : Ansistring;
1299
1300begin
1301  // S[1] always exists for shortstring. Length 0 will trigger an error.
1302  Value:=IntStrToDate(Msg,@S[1],Length(S),useformat,defaultformatsettings,separator);
1303  Result:=(Msg='');
1304end;
1305
1306function TryStrToDate(const S: AnsiString; out Value: TDateTime;
1307                    const useformat : string; separator : char = #0): Boolean;
1308
1309Var
1310  Msg : Ansistring;
1311
1312begin
1313  Result:=Length(S)<>0;
1314  If Result then
1315    begin
1316    Value:=IntStrToDate(Msg,PChar(S),Length(S),useformat,DefaultFormatSettings,Separator);
1317    Result:=(Msg='');
1318    end;
1319end;
1320
1321function TryStrToDate(const S: ShortString; out Value: TDateTime; separator : char): Boolean;
1322begin
1323  Result:=TryStrToDate(S,Value,DefaultFormatSettings.ShortDateFormat,Separator);
1324end;
1325
1326
1327function TryStrToDate(const S: AnsiString; out Value: TDateTime): Boolean;
1328begin
1329  Result:=TryStrToDate(S,Value,DefaultFormatSettings.ShortDateFormat,#0);
1330end;
1331
1332function TryStrToDate(const S: AnsiString; out Value: TDateTime; separator : char): Boolean;
1333
1334begin
1335  Result:=TryStrToDate(S,Value,DefaultFormatSettings.ShortDateFormat,Separator);
1336end;
1337
1338function TryStrToDate(const S: string; out Value: TDateTime; const FormatSettings: TFormatSettings): Boolean;
1339Var
1340  Msg : Ansistring;
1341
1342begin
1343  Result:=Length(S)<>0;
1344  If Result then
1345    begin
1346      Value:=IntStrToDate(Msg,PChar(S),Length(S),FormatSettings.ShortDateFormat,FormatSettings,#0);
1347      Result:=(Msg='');
1348    end;
1349end;
1350
1351function TryStrToTime(const S: ShortString; out Value: TDateTime; separator : char): Boolean;
1352
1353Var
1354  Msg : AnsiString;
1355begin
1356  // S[1] always exists for shortstring. Length 0 will trigger an error.
1357  Value:=IntStrToTime(Msg,@S[1],Length(S),DefaultFormatSettings,Separator);
1358  result:=(Msg='');
1359end;
1360
1361function TryStrToTime(const S: ShortString; out Value: TDateTime): Boolean;
1362begin
1363  Result := TryStrToTime(S,Value,#0);
1364end;
1365
1366function TryStrToTime(const S: AnsiString; out Value: TDateTime; separator : char): Boolean;
1367Var
1368  Msg : AnsiString;
1369begin
1370  Result:=Length(S)<>0;
1371  If Result then
1372    begin
1373      Value:=IntStrToTime(Msg,PChar(S),Length(S),DefaultFormatSettings,Separator);
1374      Result:=(Msg='');
1375    end;
1376end;
1377
1378function TryStrToTime(const S: AnsiString; out Value: TDateTime): Boolean;
1379begin
1380    result := TryStrToTime(S,Value,#0);
1381end;
1382
1383function TryStrToTime(const S: string; out Value: TDateTime; const FormatSettings: TFormatSettings): Boolean;
1384Var msg : AnsiString;
1385begin
1386  Result:=Length(S)<>0;
1387  If Result then
1388    begin
1389      Value:=IntStrToTime(Msg,PChar(S),Length(S),FormatSettings,#0);
1390      Result:=(Msg='');
1391    end;
1392end;
1393
1394function TryStrToDateTime(const S: ShortString; out Value: TDateTime): Boolean;
1395  begin
1396    result := TryStrToDateTime(S, Value, DefaultFormatSettings);
1397  end;
1398
1399function TryStrToDateTime(const S: AnsiString; out Value: TDateTime): Boolean;
1400  begin
1401    result := TryStrToDateTime(S, Value, DefaultFormatSettings);
1402  end;
1403
1404function TryStrToDateTime(const S: string; out Value: TDateTime; const FormatSettings: TFormatSettings): Boolean;
1405var
1406  I: integer;
1407  dtdate, dttime :TDateTime;
1408begin
1409  result:=false;
1410  I:=Pos(FormatSettings.TimeSeparator,S);
1411  If (I>0) then
1412    begin
1413      While (I>0) and (S[I]<>' ') do
1414        Dec(I);
1415      If I>0 then
1416        begin
1417          if not TryStrToDate(Copy(S,1,I-1),dtdate,Formatsettings) then
1418            exit;
1419          if not TryStrToTime(Copy(S,i+1, Length(S)-i),dttime,Formatsettings) then
1420            exit;
1421          Value:=ComposeDateTime(dtdate,dttime);
1422          result:=true;
1423        end
1424      else
1425         result:=TryStrToTime(s,Value,Formatsettings);
1426    end
1427  else
1428    result:=TryStrToDate(s,Value,Formatsettings);
1429end;
1430
1431function StrToDateDef(const S: ShortString; const Defvalue : TDateTime): TDateTime;
1432begin
1433   result := StrToDateDef(S,DefValue,#0);
1434end;
1435
1436function StrToTimeDef(const S: ShortString; const Defvalue : TDateTime): TDateTime;
1437begin
1438   result := StrToTimeDef(S,DefValue,#0);
1439end;
1440
1441function StrToDateTimeDef(const S: ShortString; const Defvalue : TDateTime): TDateTime;
1442begin
1443  Result:=StrToDateTimeDef(S,DefValue,DefaultFormatSettings);
1444end;
1445
1446function StrToDateTimeDef(const S: AnsiString; const Defvalue : TDateTime; const FormatSettings: TFormatSettings): TDateTime;
1447begin
1448  if not TryStrToDateTime(s,Result,FormatSettings) Then
1449    result:=defvalue;
1450end;
1451
1452function StrToDateDef(const S: ShortString; const Defvalue : TDateTime; separator : char): TDateTime;
1453begin
1454  if not TryStrToDate(s,Result, separator) Then
1455    result:=defvalue;
1456end;
1457
1458function StrToTimeDef(const S: ShortString; const Defvalue : TDateTime; separator : char): TDateTime;
1459begin
1460  if not TryStrToTime(s,Result, separator) Then
1461    result:=defvalue;
1462end;
1463
1464function StrToDateDef(const S: AnsiString; const Defvalue : TDateTime): TDateTime;
1465begin
1466   result := StrToDateDef(S,DefValue,#0);
1467end;
1468
1469function StrToTimeDef(const S: AnsiString; const Defvalue : TDateTime): TDateTime;
1470begin
1471   result := StrToTimeDef(S,DefValue,#0);
1472end;
1473
1474function StrToDateTimeDef(const S: AnsiString; const Defvalue : TDateTime): TDateTime;
1475begin
1476  if not TryStrToDateTime(s,Result) Then
1477    result:=defvalue;
1478end;
1479
1480function StrToDateDef(const S: AnsiString; const Defvalue : TDateTime; separator : char): TDateTime;
1481begin
1482  if not TryStrToDate(s,Result, separator) Then
1483    result:=defvalue;
1484end;
1485
1486function StrToTimeDef(const S: AnsiString; const Defvalue : TDateTime; separator : char): TDateTime;
1487begin
1488  if not TryStrToTime(s,Result, separator) Then
1489    result:=defvalue;
1490end;
1491
1492procedure ReplaceTime(var dati:TDateTime; NewTime : TDateTime);inline;
1493begin
1494  dati:= ComposeDateTime(dati, newtime);
1495end;
1496
1497procedure ReplaceDate(var DateTime: TDateTime; const NewDate: TDateTime); inline;
1498var
1499  tmp : TDateTime;
1500begin
1501  tmp:=NewDate;
1502  ReplaceTime(tmp,DateTime);
1503  DateTime:=tmp;
1504end;
1505
1506{$IFNDEF HAS_LOCALTIMEZONEOFFSET}
1507Function GetLocalTimeOffset : Integer;
1508
1509begin
1510  Result:=0;
1511end;
1512{$ENDIF}
1513