dati.inc 25 KB

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