dati.inc 24 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843
  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) - frac(Time)
  42. else Result := trunc(Date) + 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:= comp(msecs-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. S : Integer;
  216. begin
  217. If NumberOfMonths>=0 then
  218. s:=1
  219. else
  220. s:=-1;
  221. DecodeDate(DateTime, Year, Month, Day);
  222. inc(Year,(NumberOfMonths div 12));
  223. inc(Month,(NumberOfMonths mod 12)-1); // Mod result always positive
  224. if Month>11 then
  225. begin
  226. Dec(Month, S*12);
  227. Inc(Year, S);
  228. end;
  229. Inc(Month); { Months from 1 to 12 }
  230. If (Day>MonthDays[IsLeapYear(Year)][Month]) then
  231. Day:=MonthDays[IsLeapYear(Year)][Month];
  232. result := Frac(DateTime) + DoEncodeDate(Year, Month, Day);
  233. end ;
  234. { IsLeapYear returns true if Year is a leap year }
  235. function IsLeapYear(Year: Word): boolean;
  236. begin
  237. Result := (Year mod 4 = 0) and ((Year mod 100 <> 0) or (Year mod 400 = 0));
  238. end;
  239. { DateToStr returns a string representation of Date using ShortDateFormat }
  240. function DateToStr(Date: TDateTime): string;
  241. begin
  242. result := FormatDateTime('ddddd', Date);
  243. end ;
  244. { TimeToStr returns a string representation of Time using ShortTimeFormat }
  245. function TimeToStr(Time: TDateTime): string;
  246. begin
  247. result := FormatDateTime('t', Time);
  248. end ;
  249. { DateTimeToStr returns a string representation of DateTime using ShortDateTimeFormat }
  250. function DateTimeToStr(DateTime: TDateTime): string;
  251. begin
  252. result := FormatDateTime('c', DateTime);
  253. end ;
  254. { StrToDate converts the string S to a TDateTime value
  255. if S does not represent a valid date value
  256. an EConvertError will be raised }
  257. function StrToDate(const S: string): TDateTime;
  258. var
  259. df:string;
  260. d,m,y,ly:word;
  261. n,i:longint;
  262. c:word;
  263. dp,mp,yp,which : Byte;
  264. s1:string[4];
  265. values:array[1..3] of longint;
  266. LocalTime:tsystemtime;
  267. YearMoreThenTwoDigits : boolean;
  268. begin
  269. YearMoreThenTwoDigits := False;
  270. df := UpperCase(ShortDateFormat);
  271. { Determine order of D,M,Y }
  272. yp:=0;
  273. mp:=0;
  274. dp:=0;
  275. Which:=0;
  276. i:=0;
  277. while (i<Length(df)) and (Which<3) do
  278. begin
  279. inc(i);
  280. Case df[i] of
  281. 'Y' :
  282. if yp=0 then
  283. begin
  284. Inc(Which);
  285. yp:=which;
  286. end;
  287. 'M' :
  288. if mp=0 then
  289. begin
  290. Inc(Which);
  291. mp:=which;
  292. end;
  293. 'D' :
  294. if dp=0 then
  295. begin
  296. Inc(Which);
  297. dp:=which;
  298. end;
  299. end;
  300. end;
  301. if Which<>3 then
  302. Raise EConvertError.Create('Illegal format string');
  303. { Get actual values }
  304. for i := 1 to 3 do
  305. values[i] := 0;
  306. s1 := '';
  307. n := 0;
  308. for i := 1 to length(s) do
  309. begin
  310. if (s[i] in ['0'..'9']) then
  311. s1 := s1 + s[i];
  312. if (s[i] in [dateseparator,' ']) or ((i = length(s)) and (s[i] in ['0'..'9'])) then
  313. begin
  314. inc(n);
  315. if n>3 then
  316. Raise EConvertError.Create('Invalid date format');
  317. // Check if the year has more then two digits (if n=yp, then we are evaluating the year.)
  318. if (n=yp) and (length(s1)>2) then YearMoreThenTwoDigits := True;
  319. val(s1, values[n], c);
  320. if c<>0 then
  321. Raise EConvertError.Create('Invalid date format');
  322. s1 := '';
  323. end
  324. else if not (s[i] in ['0'..'9']) then
  325. Raise EConvertError.Create('Invalid date format');
  326. end ;
  327. // Fill in values.
  328. getLocalTime(LocalTime);
  329. ly := LocalTime.Year;
  330. If N=3 then
  331. begin
  332. y:=values[yp];
  333. m:=values[mp];
  334. d:=values[dp];
  335. end
  336. Else
  337. begin
  338. Y:=ly;
  339. If n<2 then
  340. begin
  341. d:=values[1];
  342. m := LocalTime.Month;
  343. end
  344. else
  345. If dp<mp then
  346. begin
  347. d:=values[1];
  348. m:=values[2];
  349. end
  350. else
  351. begin
  352. d:=values[2];
  353. m:=values[1];
  354. end;
  355. end;
  356. if (y >= 0) and (y < 100) and not YearMoreThenTwoDigits then
  357. begin
  358. ly := ly - TwoDigitYearCenturyWindow;
  359. Inc(Y, ly div 100 * 100);
  360. if (TwoDigitYearCenturyWindow > 0) and (Y < ly) then
  361. Inc(Y, 100);
  362. end;
  363. Result := EncodeDate(y, m, d);
  364. end ;
  365. { StrToTime converts the string S to a TDateTime value
  366. if S does not represent a valid time value an
  367. EConvertError will be raised }
  368. function StrToTime(const s: string): TDateTime;
  369. var
  370. Len, Current: integer; PM: boolean;
  371. function GetElement: integer;
  372. var
  373. j, c: integer;
  374. begin
  375. result := -1;
  376. Inc(Current);
  377. while (result = -1) and (Current < Len) do begin
  378. if S[Current] in ['0'..'9'] then begin
  379. j := Current;
  380. while (Current < Len) and (s[Current + 1] in ['0'..'9']) do
  381. Inc(Current);
  382. val(copy(S, j, 1 + Current - j), result, c);
  383. end
  384. else if ((TimeAMString<>'') and (S[Current] = TimeAMString[1])) or (S[Current] in ['a', 'A']) then begin
  385. Current := 1 + Len;
  386. end
  387. else if ((TimePMString<>'') and (S[Current] = TimePMString[1])) or (S[Current] in ['p', 'P']) then begin
  388. Current := 1 + Len;
  389. PM := True;
  390. end
  391. else if (S[Current] = TimeSeparator) or (S[Current] = ' ') then
  392. Inc(Current)
  393. else
  394. raise EConvertError.Create('Invalid Time format');
  395. end ;
  396. end ;
  397. var
  398. i: integer;
  399. TimeValues: array[0..4] of integer;
  400. begin
  401. Current := 0;
  402. Len := length(s);
  403. PM := False;
  404. for i:=0 to 4 do
  405. timevalues[i]:=0;
  406. i := 0;
  407. TimeValues[i] := GetElement;
  408. while (i < 5) and (TimeValues[i] <> -1) do begin
  409. i := i + 1;
  410. TimeValues[i] := GetElement;
  411. end ;
  412. If (i<5) and (TimeValues[I]=-1) then
  413. TimeValues[I]:=0;
  414. if PM and (TimeValues[0] <> 12) then Inc(TimeValues[0], 12);
  415. result := EncodeTime(TimeValues[0], TimeValues[1], TimeValues[2], TimeValues[3]);
  416. end ;
  417. { StrToDateTime converts the string S to a TDateTime value
  418. if S does not represent a valid date and time value
  419. an EConvertError will be raised }
  420. function StrToDateTime(const s: string): TDateTime;
  421. var i: integer;
  422. begin
  423. i := pos(' ', s);
  424. if i > 0 then result := ComposeDateTime(StrToDate(Copy(S, 1, i - 1)), StrToTime(Copy(S, i + 1, length(S))))
  425. else result := StrToDate(S);
  426. end ;
  427. { FormatDateTime formats DateTime to the given format string FormatStr }
  428. function FormatDateTime(FormatStr: string; DateTime: TDateTime): string;
  429. var
  430. ResultLen: integer;
  431. ResultBuffer: array[0..255] of char;
  432. ResultCurrent: pchar;
  433. procedure StoreStr(Str: pchar; Len: integer);
  434. begin
  435. if ResultLen + Len < SizeOf(ResultBuffer) then begin
  436. StrMove(ResultCurrent, Str, Len);
  437. ResultCurrent := ResultCurrent + Len;
  438. ResultLen := ResultLen + Len;
  439. end ;
  440. end ;
  441. procedure StoreString(const Str: string);
  442. var Len: integer;
  443. begin
  444. Len := Length(Str);
  445. if ResultLen + Len < SizeOf(ResultBuffer) then begin
  446. StrMove(ResultCurrent, pchar(Str), Len);
  447. ResultCurrent := ResultCurrent + Len;
  448. ResultLen := ResultLen + Len;
  449. end;
  450. end;
  451. procedure StoreInt(Value, Digits: integer);
  452. var S: string; Len: integer;
  453. begin
  454. S := IntToStr(Value);
  455. Len := Length(S);
  456. if Len < Digits then begin
  457. S := copy('0000', 1, Digits - Len) + S;
  458. Len := Digits;
  459. end ;
  460. StoreStr(pchar(@S[1]), Len);
  461. end ;
  462. Function TimeReFormat(Const S : string) : string;
  463. // Change m into n for time formatting.
  464. Var i : longint;
  465. begin
  466. Result:=S;
  467. For I:=1 to Length(Result) do
  468. If Result[i]='m' then
  469. result[i]:='n';
  470. end;
  471. var
  472. Year, Month, Day, DayOfWeek, Hour, Minute, Second, MilliSecond: word;
  473. procedure StoreFormat(const FormatStr: string);
  474. var
  475. Token,lastformattoken: char;
  476. FormatCurrent: pchar;
  477. FormatEnd: pchar;
  478. Count: integer;
  479. Clock12: boolean;
  480. P: pchar;
  481. tmp:integer;
  482. begin
  483. FormatCurrent := Pchar(FormatStr);
  484. FormatEnd := FormatCurrent + Length(FormatStr);
  485. Clock12 := false;
  486. P := FormatCurrent;
  487. while P < FormatEnd do begin
  488. Token := UpCase(P^);
  489. if Token in ['"', ''''] then begin
  490. P := P + 1;
  491. while (P < FormatEnd) and (P^ <> Token) do
  492. P := P + 1;
  493. end
  494. else if Token = 'A' then begin
  495. if (StrLIComp(P, 'A/P', 3) = 0) or
  496. (StrLIComp(P, 'AMPM', 4) = 0) or
  497. (StrLIComp(P, 'AM/PM', 5) = 0) then begin
  498. Clock12 := true;
  499. break;
  500. end ;
  501. end ;
  502. P := P + 1;
  503. end ;
  504. token:=#255;
  505. lastformattoken:=' ';
  506. while FormatCurrent < FormatEnd do
  507. begin
  508. Token := UpCase(FormatCurrent^);
  509. Count := 1;
  510. P := FormatCurrent + 1;
  511. case Token of
  512. '''', '"': begin
  513. while (P < FormatEnd) and (p^ <> Token) do
  514. P := P + 1;
  515. P := P + 1;
  516. Count := P - FormatCurrent;
  517. StoreStr(FormatCurrent + 1, Count - 2);
  518. end ;
  519. 'A': begin
  520. if StrLIComp(FormatCurrent, 'AMPM', 4) = 0 then begin
  521. Count := 4;
  522. if Hour < 12 then StoreString(TimeAMString)
  523. else StoreString(TimePMString);
  524. end
  525. else if StrLIComp(FormatCurrent, 'AM/PM', 5) = 0 then begin
  526. Count := 5;
  527. if Hour < 12 then StoreStr('am', 2)
  528. else StoreStr('pm', 2);
  529. end
  530. else if StrLIComp(FormatCurrent, 'A/P', 3) = 0 then begin
  531. Count := 3;
  532. if Hour < 12 then StoreStr('a', 1)
  533. else StoreStr('p', 1);
  534. end
  535. else
  536. Raise EConvertError.Create('Illegal character in format string');
  537. end ;
  538. '/': StoreStr(@DateSeparator, 1);
  539. ':': StoreStr(@TimeSeparator, 1);
  540. ' ', 'C', 'D', 'H', 'M', 'N', 'S', 'T', 'Y','Z' :
  541. begin
  542. while (P < FormatEnd) and (UpCase(P^) = Token) do
  543. P := P + 1;
  544. Count := P - FormatCurrent;
  545. case Token of
  546. ' ': StoreStr(FormatCurrent, Count);
  547. 'Y': begin
  548. if Count>2 then
  549. StoreInt(Year, 4)
  550. else
  551. StoreInt(Year mod 100, 2);
  552. end;
  553. 'M': begin
  554. if lastformattoken='H' then
  555. begin
  556. if Count = 1 then
  557. StoreInt(Minute, 0)
  558. else
  559. StoreInt(Minute, 2);
  560. end
  561. else
  562. begin
  563. case Count of
  564. 1: StoreInt(Month, 0);
  565. 2: StoreInt(Month, 2);
  566. 3: StoreString(ShortMonthNames[Month]);
  567. 4: StoreString(LongMonthNames[Month]);
  568. end;
  569. end;
  570. end;
  571. 'D': begin
  572. case Count of
  573. 1: StoreInt(Day, 0);
  574. 2: StoreInt(Day, 2);
  575. 3: StoreString(ShortDayNames[DayOfWeek]);
  576. 4: StoreString(LongDayNames[DayOfWeek]);
  577. 5: StoreFormat(ShortDateFormat);
  578. 6: StoreFormat(LongDateFormat);
  579. end ;
  580. end ;
  581. 'H': begin
  582. if Clock12 then begin
  583. tmp:=hour mod 12;
  584. if tmp=0 then tmp:=12;
  585. if Count = 1 then StoreInt(tmp, 0)
  586. else StoreInt(tmp, 2);
  587. end
  588. else begin
  589. if Count = 1 then StoreInt(Hour, 0)
  590. else StoreInt(Hour, 2);
  591. end ;
  592. end ;
  593. 'N': begin
  594. if Count = 1 then StoreInt(Minute, 0)
  595. else StoreInt(Minute, 2);
  596. end ;
  597. 'S': begin
  598. if Count = 1 then StoreInt(Second, 0)
  599. else StoreInt(Second, 2);
  600. end ;
  601. 'Z': begin
  602. if Count = 1 then StoreInt(MilliSecond, 0)
  603. else StoreInt(MilliSecond, 3);
  604. end ;
  605. 'T': begin
  606. if Count = 1 then StoreFormat(timereformat(ShortTimeFormat))
  607. else StoreFormat(TimeReformat(LongTimeFormat));
  608. end ;
  609. 'C':
  610. begin
  611. StoreFormat(ShortDateFormat);
  612. if (Hour<>0) or (Minute<>0) or (Second<>0) then
  613. begin
  614. StoreString(' ');
  615. StoreFormat(TimeReformat(ShortTimeFormat));
  616. end;
  617. end;
  618. end;
  619. lastformattoken:=token;
  620. end;
  621. else
  622. StoreStr(@Token, 1);
  623. end ;
  624. FormatCurrent := FormatCurrent + Count;
  625. end ;
  626. end ;
  627. begin
  628. DecodeDateFully(DateTime, Year, Month, Day, DayOfWeek);
  629. DecodeTime(DateTime, Hour, Minute, Second, MilliSecond);
  630. ResultLen := 0;
  631. ResultCurrent := @ResultBuffer[0];
  632. StoreFormat(FormatStr);
  633. ResultBuffer[ResultLen] := #0;
  634. result := StrPas(@ResultBuffer[0]);
  635. end ;
  636. { DateTimeToString formats DateTime to the given format in FormatStr }
  637. procedure DateTimeToString(out Result: string; const FormatStr: string; const DateTime: TDateTime);
  638. begin
  639. Result := FormatDateTime(FormatStr, DateTime);
  640. end ;
  641. Function DateTimeToFileDate(DateTime : TDateTime) : Longint;
  642. Var YY,MM,DD,H,m,s,msec : Word;
  643. begin
  644. Decodedate (DateTime,YY,MM,DD);
  645. DecodeTime (DateTime,h,m,s,msec);
  646. {$ifndef unix}
  647. If (YY<1980) or (YY>2099) then
  648. Result:=0
  649. else
  650. begin
  651. Result:=(s shr 1) or (m shl 5) or (h shl 11);
  652. Result:=Result or DD shl 16 or (MM shl 21) or ((YY-1980) shl 25);
  653. end;
  654. {$else unix}
  655. Result:=LocalToEpoch(yy,mm,dd,h,m,s);
  656. {$endif unix}
  657. end;
  658. function CurrentYear:Word;
  659. var yy,mm,dd : word;
  660. begin
  661. Decodedate(now,yy,mm,dd);
  662. Result:=yy;
  663. end;
  664. Function FileDateToDateTime (Filedate : Longint) : TDateTime;
  665. {$ifndef unix}
  666. Var Date,Time : Word;
  667. begin
  668. Date:=FileDate shr 16;
  669. Time:=FileDate and $ffff;
  670. Result:=ComposeDateTime(EncodeDate((Date shr 9) + 1980,(Date shr 5) and 15, Date and 31),
  671. EncodeTime(Time shr 11, (Time shr 5) and 63, (Time and 31) shl 1,0));
  672. end;
  673. {$else unix}
  674. var
  675. y, mon, d, h, min, s: word;
  676. begin
  677. EpochToLocal(FileDate,y,mon,d,h,min,s);
  678. Result:=ComposeDateTime(EncodeDate(y,mon,d),EncodeTime(h,min,s,0));
  679. end;
  680. {$endif unix}
  681. // ieuw. These should be written to work without exceptions?
  682. function TryStrToDate(const S: string; out Value: TDateTime): Boolean;
  683. begin
  684. result:=true;
  685. try
  686. value:=StrToDate(s);
  687. except
  688. on EConvertError do
  689. result:=false
  690. end;
  691. end;
  692. // function TryStrToDate(const S: string; out Value: TDateTime; const FormatSettings: TFormatSettings): Boolean;
  693. function TryStrToTime(const S: string; out Value: TDateTime): Boolean;
  694. begin
  695. result:=true;
  696. try
  697. value:=StrToTime(s);
  698. except
  699. on EConvertError do
  700. result:=false
  701. end;
  702. end;
  703. // function TryStrToTime(const S: string; out Value: TDateTime; const FormatSettings: TFormatSettings): Boolean;
  704. function TryStrToDateTime(const S: string; out Value: TDateTime): Boolean;
  705. begin
  706. result:=true;
  707. try
  708. value:=StrToDateTime(s);
  709. except
  710. on EConvertError do
  711. result:=false
  712. end;
  713. end;
  714. // function TryStrToDateTime(const S: string; out Value: TDateTime; const FormatSettings: TFormatSettings): Boolean;
  715. function StrToDateDef(const S: string; const Defvalue : TDateTime): TDateTime;
  716. begin
  717. if not TryStrToDate(s,Result) Then
  718. result:=defvalue;
  719. end;
  720. function StrToTimeDef(const S: string; const Defvalue : TDateTime): TDateTime;
  721. begin
  722. if not TryStrToTime(s,Result) Then
  723. result:=defvalue;
  724. end;
  725. function StrToDateTimeDef(const S: string; const Defvalue : TDateTime): TDateTime;
  726. begin
  727. if not TryStrToDateTime(s,Result) Then
  728. result:=defvalue;
  729. end;
  730. procedure ReplaceTime(var dati:TDateTime; NewTime : TDateTime);inline;
  731. begin
  732. dati:=trunc(dati)+frac(newtime);
  733. end;