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