dati.inc 25 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898
  1. {
  2. *********************************************************************
  3. Copyright (C) 1997, 1998 Gertjan Schouten
  4. This program is free software; you can redistribute it and/or modify
  5. it under the terms of the GNU General Public License as published by
  6. the Free Software Foundation; either version 2 of the License, or
  7. (at your option) any later version.
  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. See the
  11. GNU General Public License for more details.
  12. You should have received a copy of the GNU General Public License
  13. along with this program; if not, write to the Free Software
  14. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  15. *********************************************************************
  16. System Utilities For Free Pascal
  17. }
  18. {==============================================================================}
  19. { internal functions }
  20. {==============================================================================}
  21. Function DoEncodeDate(Year, Month, Day: Word): longint;
  22. Var
  23. D : TDateTime;
  24. begin
  25. If TryEncodeDate(Year,Month,Day,D) then
  26. Result:=Trunc(D)
  27. else
  28. Result:=0;
  29. end;
  30. function DoEncodeTime(Hour, Minute, Second, MilliSecond: word): TDateTime;
  31. begin
  32. If not TryEncodeTime(Hour,Minute,Second,MilliSecond,Result) then
  33. Result:=0;
  34. end;
  35. {==============================================================================}
  36. { Public functions }
  37. {==============================================================================}
  38. { ComposeDateTime converts a Date and a Time into one TDateTime }
  39. function ComposeDateTime(Date,Time : TDateTime) : TDateTime;
  40. begin
  41. if Date < 0 then Result := trunc(Date) - Abs(frac(Time))
  42. else Result := trunc(Date) + Abs(frac(Time));
  43. end;
  44. { DateTimeToTimeStamp converts DateTime to a TTimeStamp }
  45. function DateTimeToTimeStamp(DateTime: TDateTime): TTimeStamp;
  46. begin
  47. result.Time := Round(abs(Frac(DateTime)) * MSecsPerDay);
  48. result.Date := DateDelta + trunc(DateTime);
  49. end ;
  50. { TimeStampToDateTime converts TimeStamp to a TDateTime value }
  51. function TimeStampToDateTime(const TimeStamp: TTimeStamp): TDateTime;
  52. begin
  53. Result := ComposeDateTime(TimeStamp.Date - DateDelta,TimeStamp.Time / MSecsPerDay)
  54. end;
  55. { MSecsToTimeStamp }
  56. function MSecsToTimeStamp(MSecs: comp): TTimeStamp;
  57. begin
  58. result.Date := Trunc(msecs / msecsperday);
  59. msecs:= msecs-comp(result.date)*msecsperday;
  60. result.Time := Round(MSecs);
  61. end ;
  62. { TimeStampToMSecs }
  63. function TimeStampToMSecs(const TimeStamp: TTimeStamp): comp;
  64. begin
  65. result := TimeStamp.Time + comp(timestamp.date)*msecsperday;
  66. end ;
  67. Function TryEncodeDate(Year,Month,Day : Word; Out Date : TDateTime) : Boolean;
  68. var
  69. c, ya: cardinal;
  70. begin
  71. Result:=(Year>0) and (Year<10000) and
  72. (Month in [1..12]) and
  73. (Day>0) and (Day<=MonthDays[IsleapYear(Year),Month]);
  74. If Result then
  75. begin
  76. if month > 2 then
  77. Dec(Month,3)
  78. else
  79. begin
  80. Inc(Month,9);
  81. Dec(Year);
  82. end;
  83. c:= Year DIV 100;
  84. ya:= Year - 100*c;
  85. Date := (146097*c) SHR 2 + (1461*ya) SHR 2 + (153*cardinal(Month)+2) DIV 5 + cardinal(Day);
  86. // Note that this line can't be part of the line above, since TDateTime is
  87. // signed and c and ya are not
  88. Date := Date - 693900;
  89. end
  90. end;
  91. function TryEncodeTime(Hour, Min, Sec, MSec:word; Out Time : TDateTime) : boolean;
  92. begin
  93. Result:=(Hour<24) and (Min<60) and (Sec<60) and (MSec<1000);
  94. If Result then
  95. Time:=TDateTime(cardinal(Hour)*3600000+cardinal(Min)*60000+cardinal(Sec)*1000+MSec)/MSecsPerDay;
  96. end;
  97. { EncodeDate packs three variables Year, Month and Day into a
  98. TDateTime value the result is the number of days since 12/30/1899 }
  99. function EncodeDate(Year, Month, Day: word): TDateTime;
  100. begin
  101. If Not TryEncodeDate(Year,Month,Day,Result) then
  102. Raise EConvertError.CreateFmt('%d-%d-%d is not a valid date specification',
  103. [Year,Month,Day]);
  104. end;
  105. { EncodeTime packs four variables Hour, Minute, Second and MilliSecond into
  106. a TDateTime value }
  107. function EncodeTime(Hour, Minute, Second, MilliSecond:word):TDateTime;
  108. begin
  109. If not TryEncodeTime(Hour,Minute,Second,MilliSecond,Result) then
  110. Raise EConvertError.CreateFmt('%d:%d:%d.%d is not a valid time specification',
  111. [Hour,Minute,Second,MilliSecond]);
  112. end;
  113. { DecodeDate unpacks the value Date into three values:
  114. Year, Month and Day }
  115. procedure DecodeDate(Date: TDateTime; out Year, Month, Day: word);
  116. var
  117. ly,ld,lm,j : cardinal;
  118. begin
  119. if Date <= -datedelta then // If Date is before 1-1-1 then return 0-0-0
  120. begin
  121. Year := 0;
  122. Month := 0;
  123. Day := 0;
  124. end
  125. else
  126. begin
  127. j := pred((Trunc(System.Int(Date)) + 693900) SHL 2);
  128. ly:= j DIV 146097;
  129. j:= j - 146097 * cardinal(ly);
  130. ld := j SHR 2;
  131. j:=(ld SHL 2 + 3) DIV 1461;
  132. ld:= (cardinal(ld) SHL 2 + 7 - 1461*j) SHR 2;
  133. lm:=(5 * ld-3) DIV 153;
  134. ld:= (5 * ld +2 - 153*lm) DIV 5;
  135. ly:= 100 * cardinal(ly) + j;
  136. if lm < 10 then
  137. inc(lm,3)
  138. else
  139. begin
  140. dec(lm,9);
  141. inc(ly);
  142. end;
  143. year:=ly;
  144. month:=lm;
  145. day:=ld;
  146. end;
  147. end;
  148. function DecodeDateFully(const DateTime: TDateTime; out Year, Month, Day, DOW: Word): Boolean;
  149. begin
  150. DecodeDate(DateTime,Year,Month,Day);
  151. DOW:=DayOfWeek(DateTime);
  152. Result:=IsLeapYear(Year);
  153. end;
  154. { DecodeTime unpacks Time into four values:
  155. Hour, Minute, Second and MilliSecond }
  156. procedure DecodeTime(Time: TDateTime; out Hour, Minute, Second, MilliSecond: word);
  157. Var
  158. l : cardinal;
  159. begin
  160. l := Round(abs(Frac(time)) * MSecsPerDay);
  161. Hour := l div 3600000;
  162. l := l mod 3600000;
  163. Minute := l div 60000;
  164. l := l mod 60000;
  165. Second := l div 1000;
  166. l := l mod 1000;
  167. MilliSecond := l;
  168. end;
  169. { DateTimeToSystemTime converts DateTime value to SystemTime }
  170. procedure DateTimeToSystemTime(DateTime: TDateTime; out SystemTime: TSystemTime);
  171. begin
  172. DecodeDate(DateTime, SystemTime.Year, SystemTime.Month, SystemTime.Day);
  173. DecodeTime(DateTime, SystemTime.Hour, SystemTime.Minute, SystemTime.Second, SystemTime.MilliSecond);
  174. end ;
  175. { SystemTimeToDateTime converts SystemTime to a TDateTime value }
  176. function SystemTimeToDateTime(const SystemTime: TSystemTime): TDateTime;
  177. begin
  178. result := ComposeDateTime(DoEncodeDate(SystemTime.Year, SystemTime.Month, SystemTime.Day),
  179. DoEncodeTime(SystemTime.Hour, SystemTime.Minute, SystemTime.Second, SystemTime.MilliSecond));
  180. end ;
  181. { DayOfWeek returns the Day of the week (sunday is day 1) }
  182. function DayOfWeek(DateTime: TDateTime): integer;
  183. begin
  184. Result := 1 + (Abs(Trunc(DateTime) - 1) mod 7);
  185. end ;
  186. { Date returns the current Date }
  187. function Date: TDateTime;
  188. var
  189. SystemTime: TSystemTime;
  190. begin
  191. GetLocalTime(SystemTime);
  192. result := DoEncodeDate(SystemTime.Year, SystemTime.Month, SystemTime.Day);
  193. end ;
  194. { Time returns the current Time }
  195. function Time: TDateTime;
  196. var
  197. SystemTime: TSystemTime;
  198. begin
  199. GetLocalTime(SystemTime);
  200. Result := DoEncodeTime(SystemTime.Hour,SystemTime.Minute,SystemTime.Second,SystemTime.MilliSecond);
  201. end ;
  202. { Now returns the current Date and Time }
  203. function Now: TDateTime;
  204. var
  205. SystemTime: TSystemTime;
  206. begin
  207. GetLocalTime(SystemTime);
  208. result := systemTimeToDateTime(SystemTime);
  209. end;
  210. { IncMonth increments DateTime with NumberOfMonths months,
  211. NumberOfMonths can be less than zero }
  212. function IncMonth(const DateTime: TDateTime; NumberOfMonths: integer = 1 ): TDateTime;
  213. var
  214. Year, Month, Day : word;
  215. begin
  216. DecodeDate(DateTime, Year, Month, Day);
  217. IncAMonth(Year, Month, Day, NumberOfMonths);
  218. result := ComposeDateTime(DoEncodeDate(Year, Month, Day), DateTime);
  219. end ;
  220. { IncAMonth is the same as IncMonth, but operates on decoded date }
  221. procedure IncAMonth(var Year, Month, Day: Word; NumberOfMonths: Integer = 1);
  222. var
  223. TempMonth, S: Integer;
  224. begin
  225. If NumberOfMonths>=0 then
  226. s:=1
  227. else
  228. s:=-1;
  229. inc(Year,(NumberOfMonths div 12));
  230. TempMonth:=Month+(NumberOfMonths mod 12)-1;
  231. if (TempMonth>11) or
  232. (TempMonth<0) then
  233. begin
  234. Dec(TempMonth, S*12);
  235. Inc(Year, S);
  236. end;
  237. Month:=TempMonth+1; { Months from 1 to 12 }
  238. If (Day>MonthDays[IsLeapYear(Year)][Month]) then
  239. Day:=MonthDays[IsLeapYear(Year)][Month];
  240. end;
  241. { IsLeapYear returns true if Year is a leap year }
  242. function IsLeapYear(Year: Word): boolean;
  243. begin
  244. Result := (Year mod 4 = 0) and ((Year mod 100 <> 0) or (Year mod 400 = 0));
  245. end;
  246. { DateToStr returns a string representation of Date using ShortDateFormat }
  247. function DateToStr(Date: TDateTime): string;
  248. begin
  249. result := FormatDateTime('ddddd', Date);
  250. end ;
  251. { TimeToStr returns a string representation of Time using LongTimeFormat }
  252. function TimeToStr(Time: TDateTime): string;
  253. begin
  254. result := FormatDateTime('tt', Time);
  255. end ;
  256. { DateTimeToStr returns a string representation of DateTime using LongDateTimeFormat }
  257. function DateTimeToStr(DateTime: TDateTime): string;
  258. begin
  259. result := FormatDateTime('c', DateTime);
  260. end ;
  261. { StrToDate converts the string S to a TDateTime value
  262. if S does not represent a valid date value
  263. an EConvertError will be raised }
  264. function StrToDate(const S: string): TDateTime;
  265. const SInvalidDateFormat = '"%s" is not a valid date format';
  266. var
  267. df:string;
  268. d,m,y,ly:word;
  269. n,i:longint;
  270. c:word;
  271. dp,mp,yp,which : Byte;
  272. s1:string[4];
  273. values:array[1..3] of longint;
  274. LocalTime:tsystemtime;
  275. YearMoreThenTwoDigits : boolean;
  276. begin
  277. if s = '' then
  278. Raise EConvertError.CreateFmt(SInvalidDateFormat,[s]);
  279. YearMoreThenTwoDigits := False;
  280. df := UpperCase(ShortDateFormat);
  281. { Determine order of D,M,Y }
  282. yp:=0;
  283. mp:=0;
  284. dp:=0;
  285. Which:=0;
  286. i:=0;
  287. while (i<Length(df)) and (Which<3) do
  288. begin
  289. inc(i);
  290. Case df[i] of
  291. 'Y' :
  292. if yp=0 then
  293. begin
  294. Inc(Which);
  295. yp:=which;
  296. end;
  297. 'M' :
  298. if mp=0 then
  299. begin
  300. Inc(Which);
  301. mp:=which;
  302. end;
  303. 'D' :
  304. if dp=0 then
  305. begin
  306. Inc(Which);
  307. dp:=which;
  308. end;
  309. end;
  310. end;
  311. if Which<>3 then
  312. Raise EConvertError.Create('Illegal format string');
  313. { Get actual values }
  314. for i := 1 to 3 do
  315. values[i] := 0;
  316. s1 := '';
  317. n := 0;
  318. for i := 1 to length(s) do
  319. begin
  320. if s[i] in ['0'..'9'] then
  321. s1 := s1 + s[i];
  322. { space can be part of the shortdateformat, and is defaultly in slovak
  323. windows, therefor it shouldn't be taken as separator (unless so specified)
  324. and ignored }
  325. if (DateSeparator <> ' ') and (s[i] = ' ') then
  326. Continue;
  327. if (s[i] = dateseparator) or ((i = length(s)) and (s[i] in ['0'..'9'])) then
  328. begin
  329. inc(n);
  330. if n>3 then
  331. Raise EConvertError.CreateFmt(SInvalidDateFormat,[s]);
  332. // Check if the year has more then two digits (if n=yp, then we are evaluating the year.)
  333. if (n=yp) and (length(s1)>2) then YearMoreThenTwoDigits := True;
  334. val(s1, values[n], c);
  335. if c<>0 then
  336. Raise EConvertError.CreateFmt(SInvalidDateFormat,[s]);
  337. s1 := '';
  338. end
  339. else if not (s[i] in ['0'..'9']) then
  340. Raise EConvertError.CreateFmt(SInvalidDateFormat,[s]);
  341. end ;
  342. // Fill in values.
  343. getLocalTime(LocalTime);
  344. ly := LocalTime.Year;
  345. If N=3 then
  346. begin
  347. y:=values[yp];
  348. m:=values[mp];
  349. d:=values[dp];
  350. end
  351. Else
  352. begin
  353. Y:=ly;
  354. If n<2 then
  355. begin
  356. d:=values[1];
  357. m := LocalTime.Month;
  358. end
  359. else
  360. If dp<mp then
  361. begin
  362. d:=values[1];
  363. m:=values[2];
  364. end
  365. else
  366. begin
  367. d:=values[2];
  368. m:=values[1];
  369. end;
  370. end;
  371. if (y >= 0) and (y < 100) and not YearMoreThenTwoDigits then
  372. begin
  373. ly := ly - TwoDigitYearCenturyWindow;
  374. Inc(Y, ly div 100 * 100);
  375. if (TwoDigitYearCenturyWindow > 0) and (Y < ly) then
  376. Inc(Y, 100);
  377. end;
  378. Result := EncodeDate(y, m, d);
  379. end ;
  380. { StrToTime converts the string S to a TDateTime value
  381. if S does not represent a valid time value an
  382. EConvertError will be raised }
  383. function StrToTime(const s: string): TDateTime;
  384. var
  385. Len, Current: integer; PM: integer;
  386. function GetElement: integer;
  387. var
  388. j, c: integer;
  389. begin
  390. result := -1;
  391. Inc(Current);
  392. while (result = -1) and (Current <= Len) do
  393. begin
  394. if S[Current] in ['0'..'9'] then
  395. begin
  396. j := Current;
  397. while (Current < Len) and (s[Current + 1] in ['0'..'9']) do
  398. Inc(Current);
  399. val(copy(S, j, 1 + Current - j), result, c);
  400. end
  401. else if ((TimeAMString<>'') and (S[Current] = TimeAMString[1])) or (S[Current] in ['a', 'A']) then
  402. begin
  403. pm:=1;
  404. Current := 1 + Len;
  405. end
  406. else if ((TimePMString<>'') and (S[Current] = TimePMString[1])) or (S[Current] in ['p', 'P']) then
  407. begin
  408. Current := 1 + Len;
  409. PM := 2;
  410. end
  411. else if (S[Current] = TimeSeparator) or (S[Current] = ' ') then
  412. Inc(Current)
  413. else
  414. raise EConvertError.Create('Invalid Time format');
  415. end ;
  416. end ;
  417. var
  418. i: integer;
  419. TimeValues: array[0..4] of integer;
  420. begin
  421. Current := 0;
  422. Len := length(s);
  423. PM := 0;
  424. for i:=0 to 4 do
  425. timevalues[i]:=0;
  426. i := 0;
  427. TimeValues[i] := GetElement;
  428. while (i < 5) and (TimeValues[i] <> -1) do
  429. begin
  430. i := i + 1;
  431. TimeValues[i] := GetElement;
  432. end ;
  433. If (i<5) and (TimeValues[I]=-1) then
  434. TimeValues[I]:=0;
  435. if PM=2 then
  436. begin
  437. if (TimeValues[0] <> 12) then
  438. Inc(TimeValues[0], 12);
  439. end
  440. else
  441. begin
  442. if (pm=1) and ((TimeValues[0]=12)) then
  443. TimeValues[0]:=0;
  444. end;
  445. result := EncodeTime(TimeValues[0], TimeValues[1], TimeValues[2], TimeValues[3]);
  446. end ;
  447. { StrToDateTime converts the string S to a TDateTime value
  448. if S does not represent a valid date and/or time value
  449. an EConvertError will be raised }
  450. function StrToDateTime(const s: string): TDateTime;
  451. var
  452. i, j, k, l: integer;
  453. sd, st: string;
  454. begin
  455. l := Length(s);
  456. i := 1;
  457. while (i <= l) and (s[i] = ' ') do
  458. Inc(i);
  459. j := i;
  460. while (j <= l) and (s[j] <> ' ') do
  461. Inc(j);
  462. k := j;
  463. while (k <= l) and (s[k] = ' ') do
  464. Inc(k);
  465. sd := Copy(s, i, j - i);
  466. st := Copy(s, k, l);
  467. if (st = '') and (Pos(TimeSeparator, sd) > 0) then
  468. begin
  469. st := sd;
  470. sd := '';
  471. end;
  472. if (sd <> '') and (st <> '') then
  473. Result := ComposeDateTime(StrToDate(sd), StrToTime(st))
  474. else if st = '' then
  475. Result := StrToDate(sd)
  476. else
  477. Result := StrToTime(st);
  478. end ;
  479. { FormatDateTime formats DateTime to the given format string FormatStr }
  480. function FormatDateTime(FormatStr: string; DateTime: TDateTime): string;
  481. var
  482. ResultLen: integer;
  483. ResultBuffer: array[0..255] of char;
  484. ResultCurrent: pchar;
  485. procedure StoreStr(Str: pchar; Len: integer);
  486. begin
  487. if ResultLen + Len < SizeOf(ResultBuffer) then begin
  488. StrMove(ResultCurrent, Str, Len);
  489. ResultCurrent := ResultCurrent + Len;
  490. ResultLen := ResultLen + Len;
  491. end ;
  492. end ;
  493. procedure StoreString(const Str: string);
  494. var Len: integer;
  495. begin
  496. Len := Length(Str);
  497. if ResultLen + Len < SizeOf(ResultBuffer) then begin // strmove not safe
  498. StrMove(ResultCurrent, pchar(Str), Len);
  499. ResultCurrent := ResultCurrent + Len;
  500. ResultLen := ResultLen + Len;
  501. end;
  502. end;
  503. procedure StoreInt(Value, Digits: integer);
  504. var S: string; Len: integer;
  505. begin
  506. S := IntToStr(Value);
  507. Len := Length(S);
  508. if Len < Digits then begin
  509. S := copy('0000', 1, Digits - Len) + S;
  510. Len := Digits;
  511. end ;
  512. StoreStr(pchar(@S[1]), Len);
  513. end ;
  514. var
  515. Year, Month, Day, DayOfWeek, Hour, Minute, Second, MilliSecond: word;
  516. procedure StoreFormat(const FormatStr: string);
  517. var
  518. Token,lastformattoken: char;
  519. FormatCurrent: pchar;
  520. FormatEnd: pchar;
  521. Count: integer;
  522. Clock12: boolean;
  523. P: pchar;
  524. tmp:integer;
  525. begin
  526. FormatCurrent := Pchar(pointer(FormatStr));
  527. FormatEnd := FormatCurrent + Length(FormatStr);
  528. Clock12 := false;
  529. P := FormatCurrent;
  530. while P < FormatEnd do begin
  531. Token := UpCase(P^);
  532. if Token in ['"', ''''] then begin
  533. P := P + 1;
  534. while (P < FormatEnd) and (P^ <> Token) do
  535. P := P + 1;
  536. end
  537. else if Token = 'A' then begin
  538. if (StrLIComp(P, 'A/P', 3) = 0) or
  539. (StrLIComp(P, 'AMPM', 4) = 0) or
  540. (StrLIComp(P, 'AM/PM', 5) = 0) then begin
  541. Clock12 := true;
  542. break;
  543. end ;
  544. end ;
  545. P := P + 1;
  546. end ;
  547. token:=#255;
  548. lastformattoken:=' ';
  549. while FormatCurrent < FormatEnd do
  550. begin
  551. Token := UpCase(FormatCurrent^);
  552. Count := 1;
  553. P := FormatCurrent + 1;
  554. case Token of
  555. '''', '"': begin
  556. while (P < FormatEnd) and (p^ <> Token) do
  557. P := P + 1;
  558. P := P + 1;
  559. Count := P - FormatCurrent;
  560. StoreStr(FormatCurrent + 1, Count - 2);
  561. end ;
  562. 'A': begin
  563. if StrLIComp(FormatCurrent, 'AMPM', 4) = 0 then begin
  564. Count := 4;
  565. if Hour < 12 then StoreString(TimeAMString)
  566. else StoreString(TimePMString);
  567. end
  568. else if StrLIComp(FormatCurrent, 'AM/PM', 5) = 0 then begin
  569. Count := 5;
  570. if Hour < 12 then StoreStr('am', 2)
  571. else StoreStr('pm', 2);
  572. end
  573. else if StrLIComp(FormatCurrent, 'A/P', 3) = 0 then begin
  574. Count := 3;
  575. if Hour < 12 then StoreStr('a', 1)
  576. else StoreStr('p', 1);
  577. end
  578. else
  579. Raise EConvertError.Create('Illegal character in format string');
  580. end ;
  581. '/': StoreStr(@DateSeparator, 1);
  582. ':': StoreStr(@TimeSeparator, 1);
  583. ' ', 'C', 'D', 'H', 'M', 'N', 'S', 'T', 'Y','Z' :
  584. begin
  585. while (P < FormatEnd) and (UpCase(P^) = Token) do
  586. P := P + 1;
  587. Count := P - FormatCurrent;
  588. case Token of
  589. ' ': StoreStr(FormatCurrent, Count);
  590. 'Y': begin
  591. if Count>2 then
  592. StoreInt(Year, 4)
  593. else
  594. StoreInt(Year mod 100, 2);
  595. end;
  596. 'M': begin
  597. if lastformattoken='H' then
  598. begin
  599. if Count = 1 then
  600. StoreInt(Minute, 0)
  601. else
  602. StoreInt(Minute, 2);
  603. end
  604. else
  605. begin
  606. case Count of
  607. 1: StoreInt(Month, 0);
  608. 2: StoreInt(Month, 2);
  609. 3: StoreString(ShortMonthNames[Month]);
  610. 4: StoreString(LongMonthNames[Month]);
  611. end;
  612. end;
  613. end;
  614. 'D': begin
  615. case Count of
  616. 1: StoreInt(Day, 0);
  617. 2: StoreInt(Day, 2);
  618. 3: StoreString(ShortDayNames[DayOfWeek]);
  619. 4: StoreString(LongDayNames[DayOfWeek]);
  620. 5: StoreFormat(ShortDateFormat);
  621. 6: StoreFormat(LongDateFormat);
  622. end ;
  623. end ;
  624. 'H': begin
  625. if Clock12 then begin
  626. tmp:=hour mod 12;
  627. if tmp=0 then tmp:=12;
  628. if Count = 1 then StoreInt(tmp, 0)
  629. else StoreInt(tmp, 2);
  630. end
  631. else begin
  632. if Count = 1 then StoreInt(Hour, 0)
  633. else StoreInt(Hour, 2);
  634. end ;
  635. end ;
  636. 'N': begin
  637. if Count = 1 then StoreInt(Minute, 0)
  638. else StoreInt(Minute, 2);
  639. end ;
  640. 'S': begin
  641. if Count = 1 then StoreInt(Second, 0)
  642. else StoreInt(Second, 2);
  643. end ;
  644. 'Z': begin
  645. if Count = 1 then StoreInt(MilliSecond, 0)
  646. else StoreInt(MilliSecond, 3);
  647. end ;
  648. 'T': begin
  649. if Count = 1 then StoreFormat(ShortTimeFormat)
  650. else StoreFormat(LongTimeFormat);
  651. end ;
  652. 'C':
  653. begin
  654. StoreFormat(ShortDateFormat);
  655. if (Hour<>0) or (Minute<>0) or (Second<>0) then
  656. begin
  657. StoreString(' ');
  658. StoreFormat(LongTimeFormat);
  659. end;
  660. end;
  661. end;
  662. lastformattoken:=token;
  663. end;
  664. else
  665. StoreStr(@Token, 1);
  666. end ;
  667. FormatCurrent := FormatCurrent + Count;
  668. end ;
  669. end ;
  670. begin
  671. DecodeDateFully(DateTime, Year, Month, Day, DayOfWeek);
  672. DecodeTime(DateTime, Hour, Minute, Second, MilliSecond);
  673. ResultLen := 0;
  674. ResultCurrent := @ResultBuffer[0];
  675. StoreFormat(FormatStr);
  676. ResultBuffer[ResultLen] := #0;
  677. result := StrPas(@ResultBuffer[0]);
  678. end ;
  679. { DateTimeToString formats DateTime to the given format in FormatStr }
  680. procedure DateTimeToString(out Result: string; const FormatStr: string; const DateTime: TDateTime);
  681. begin
  682. Result := FormatDateTime(FormatStr, DateTime);
  683. end ;
  684. Function DateTimeToFileDate(DateTime : TDateTime) : Longint;
  685. Var YY,MM,DD,H,m,s,msec : Word;
  686. begin
  687. Decodedate (DateTime,YY,MM,DD);
  688. DecodeTime (DateTime,h,m,s,msec);
  689. {$ifndef unix}
  690. If (YY<1980) or (YY>2099) then
  691. Result:=0
  692. else
  693. begin
  694. Result:=(s shr 1) or (m shl 5) or (h shl 11);
  695. Result:=Result or longint(DD shl 16 or (MM shl 21) or (word(YY-1980) shl 25));
  696. end;
  697. {$else unix}
  698. Result:=LocalToEpoch(yy,mm,dd,h,m,s);
  699. {$endif unix}
  700. end;
  701. function CurrentYear:Word;
  702. var yy,mm,dd : word;
  703. begin
  704. Decodedate(now,yy,mm,dd);
  705. Result:=yy;
  706. end;
  707. Function FileDateToDateTime (Filedate : Longint) : TDateTime;
  708. {$ifndef unix}
  709. Var Date,Time : Word;
  710. begin
  711. Date:=FileDate shr 16;
  712. Time:=FileDate and $ffff;
  713. Result:=ComposeDateTime(EncodeDate((Date shr 9) + 1980,(Date shr 5) and 15, Date and 31),
  714. EncodeTime(Time shr 11, (Time shr 5) and 63, (Time and 31) shl 1,0));
  715. end;
  716. {$else unix}
  717. var
  718. y, mon, d, h, min, s: word;
  719. begin
  720. EpochToLocal(FileDate,y,mon,d,h,min,s);
  721. Result:=ComposeDateTime(EncodeDate(y,mon,d),EncodeTime(h,min,s,0));
  722. end;
  723. {$endif unix}
  724. // ieuw. These should be written to work without exceptions?
  725. function TryStrToDate(const S: string; out Value: TDateTime): Boolean;
  726. begin
  727. result:=true;
  728. try
  729. value:=StrToDate(s);
  730. except
  731. on EConvertError do
  732. result:=false
  733. end;
  734. end;
  735. // function TryStrToDate(const S: string; out Value: TDateTime; const FormatSettings: TFormatSettings): Boolean;
  736. function TryStrToTime(const S: string; out Value: TDateTime): Boolean;
  737. begin
  738. result:=true;
  739. try
  740. value:=StrToTime(s);
  741. except
  742. on EConvertError do
  743. result:=false
  744. end;
  745. end;
  746. // function TryStrToTime(const S: string; out Value: TDateTime; const FormatSettings: TFormatSettings): Boolean;
  747. function TryStrToDateTime(const S: string; out Value: TDateTime): Boolean;
  748. begin
  749. result:=true;
  750. try
  751. value:=StrToDateTime(s);
  752. except
  753. on EConvertError do
  754. result:=false
  755. end;
  756. end;
  757. // function TryStrToDateTime(const S: string; out Value: TDateTime; const FormatSettings: TFormatSettings): Boolean;
  758. function StrToDateDef(const S: string; const Defvalue : TDateTime): TDateTime;
  759. begin
  760. if not TryStrToDate(s,Result) Then
  761. result:=defvalue;
  762. end;
  763. function StrToTimeDef(const S: string; const Defvalue : TDateTime): TDateTime;
  764. begin
  765. if not TryStrToTime(s,Result) Then
  766. result:=defvalue;
  767. end;
  768. function StrToDateTimeDef(const S: string; const Defvalue : TDateTime): TDateTime;
  769. begin
  770. if not TryStrToDateTime(s,Result) Then
  771. result:=defvalue;
  772. end;
  773. procedure ReplaceTime(var dati:TDateTime; NewTime : TDateTime);inline;
  774. begin
  775. dati:= ComposeDateTime(dati, newtime);
  776. end;
  777. procedure ReplaceDate(var DateTime: TDateTime; const NewDate: TDateTime); inline;
  778. var
  779. tmp : TDateTime;
  780. begin
  781. tmp:=NewDate;
  782. ReplaceTime(tmp,DateTime);
  783. DateTime:=tmp;
  784. end;