← Back to branch summary

~ubuntu-branches/debian/lenny/fpc/lenny

« back to all changes in this revision

Viewing changes to rtl/objpas/sysutils/dati.inc

  • Committer: Bazaar Package Importer
  • Author(s): Mazen Neifer, Torsten Werner, Mazen Neifer
  • Date: 2008-05-17 17:12:11 UTC
  • mfrom: (3.1.9 intrepid)
  • Revision ID: james.westby@ubuntu.com-20080517171211-9qi33xhd9evfa0kg
Tags: 2.2.0-dfsg1-9
http://bugs.debian.org/477743
[ Torsten Werner ]
* Add Mazen Neifer to Uploaders field.

[ Mazen Neifer ]
* Moved FPC sources into a version dependent directory from /usr/share/fpcsrc
  to /usr/share/fpcsrc/${FPCVERSION}. This allow installing more than on FPC
  release.
* Fixed far call issue in compiler preventing building huge binearies.
  (closes: #477743)
* Updated building dependencies, recomennded and suggested packages.
* Moved fppkg to fp-utils as it is just a helper tool and is not required by
  compiler.

Show diffs side-by-side

added added

removed removed

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