Post by Stefan Koschkeeine Abweichung von 2 sec :-((((
Muß ich denn wirklich mein gesamtes Programm vom Typ TDatetime auf integer
umstellen (Zeitstempel generell als Sekunden seit Zeitpunkt x) oder gibt es
doch einen Weg um diese "Ungenauigkeiten zu eliminieren?
Ich verwende seit jeher diese Methode. Auf jedem OS, mit jeder
Sprache und ich finde es gibt nichts Besseres. Das jeweilige
Wandeln in den ab und zu benötigten TDateTime ist dann ein Klacks.
Ok, Du musst die Grenzen kennen. D.h. bei den heute noch üblichen
32 Bit Integern deckt Du eben nur einen Zeitraum von einigen Jahr-
zehnten ab. Wer seine Routinen zu gegebener Zeit auf 64 Bit auf-
bohrt, hat dann erst mal wieder etwas Ruhe :-)
Darf ich Dir gleich mal meine Delphi 5 Unit "SysTime.pas" zeigen?
Diese enthält auch die Berechnungsmöglichkeit für alle beweglichen
Feiertage.
Gruß, Jens
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
unit SysTime;
interface
type
str31 = string[31];
IsoFormat = (IsoShort, IsoLong);
const
SecsPerDay = 86400;
Wochentage: array[0..6] of str31 = ('Sonntag', 'Montag', 'Dienstag',
'Mittwoch', 'Donnerstag', 'Freitag', 'Samstag');
Monate: array[1..12] of str31 = ('Januar', 'Februar', 'März', 'April', 'Mai',
'Juni', 'Juli', 'August', 'September', 'Oktober', 'November', 'Dezember');
WeekDays: array[0..6] of str31 = ('Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri',
'Sat');
Months: array[1..12] of str31 = ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun',
'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec');
type
DTRec = record
Year: word;
Month: word;
Day: word;
Hour: word;
Minute: word;
Second: word;
WeekDay: word;
end;
procedure GetDateTime(var DTR: DTRec);
procedure NormalizeDate(var DTR: DTRec);
procedure Date2Secs(Date: DTRec; var Secs: longint);
procedure Secs2Date(Secs: longint; var Date: DTRec);
procedure PackDate(Date: DTRec; var Time: integer);
procedure PackSecs(Secs: longint; var Time: integer);
procedure UnpackDate(Time: integer; var Date: DTRec);
procedure UnpackSecs(Time: integer; var Secs: longint);
function ShortYear(Year: integer): byte;
function LongYear(Year: integer): integer;
function DayOfYear(Date: DTRec): integer;
function QuarterOfYear(Date: DTRec): integer;
function WeekOfYear(Date: DTRec; WeekDay: byte): integer;
function DTS(Date: DTRec; D, T: byte; Gap: string): string;
{ Format D Format T }
{ ------------------------------------------------------}
{ 1: 1980-01-01 01:02:03 }
{ 2: 1980-01 01:02 }
{ 3: 1980 01 }
{ 4: 198001 0102 }
{ 5: 19800101 010203 }
{ 6: 01-01 01:02:03 am }
{ 7: 0101 01:02 am }
{ 8: 01.01.1980 01.02.03 }
{ 9: 01.01.80 01.02 }
{10: 1. Januar 1980 1 Uhr 02 }
{11: Dienstag, 1. Januar 1980 1 Uhr 02 und 03 Sekunden }
{ }
{ Wenn D=0 und T=0 kann Gap folgende Formate enthalten }
{ ------------------------------------------------------}
{ %YYYY Jahreszahl vierstellig }
{ %YY Jahreszahl zweistellig }
{ %MMM Monatsname 3-stellig (englische Bezeichnung ) }
{ %MM Monate zweistellig }
{ %M Monate ein- oder zweistellig }
{ %DD Tage zweistellig }
{ %D Tage ein- oder zweistellig }
{ %Q Quartal }
{ %WW Kalenderwoche zweistellig }
{ %W Kalenderwoche ein- oder zweistellig }
{ %CCC Tag des Jahres dreistellig }
{ %C Tag des Jahres ein- bis dreistellig }
{ %NNN Wochentag 3-stellig (englische Bezeichnung ) }
{ }
{ %hh Stunden zweistellig }
{ %h Stunden ein- oder zweistellig }
{ %HH Stunden (12 h-Format) zweistellig }
{ %H Stunden (12 h-Format) ein- oder zweistellig }
{ %mm Minuten zweistellig }
{ %m Minuten ein- oder zweistellig }
{ %ss Sekunden zweistellig }
{ %s Sekunden ein- oder zweistellig }
function CurrDTS(D, T: byte; Gap: string): string;
function GetSecs: longint;
function GetSecsUTC: longint;
function Utc2Local(Secs: longint): longint;
function Local2Utc(Secs: longint): longint;
function GetHoliday(Year, Holiday: integer): longint;
function Secs2Time(Secs: longint): TDateTime;
function Time2Secs(Time: TDateTime): longint;
function Date2Iso(Date: DTRec; Format: IsoFormat): string;
function Secs2Iso(Secs: longint; Format: IsoFormat): string;
function Iso2Date(S: string): DTRec;
function Iso2Secs(S: string): longint;
implementation
uses
Windows, SysUtils;
const
DaysPerYear = 365.24267;
DaysPerMonth = 30.60001;
var
DlstYear: integer;
DlstStart: longint;
DlstEnd: longint;
function Zin(Value: string): longint;
var i: integer;
begin
if (Value = '') then Value := '0';
val(Value, Result, i);
end;
function Zout(Zahl: longint; VK: byte): ShortString;
var temp: ShortString;
begin
str(zahl: VK, temp);
Result := temp;
end;
function ZoutZero(Zahl: longint; VK: byte): ShortString;
var
i: byte;
temp: ShortString;
begin
str(zahl: VK, temp);
for i := 1 to length(temp) do if temp[i] = ' ' then temp[i] := '0';
Result := temp;
end;
{------------------------------------------------------------}
procedure GetDateTime(var DTR: DTRec);
var
DT: TDateTime;
MSec: word;
begin
DT := Now;
with DTR do
begin
DecodeDate(DT, Year, Month, Day);
DecodeTime(DT, Hour, Minute, Second, MSec);
WeekDay := DayOfWeek(DT) - 1;
end;
end;
procedure NormalizeDate(var DTR: DTRec);
var Secs: longint;
begin
Date2Secs(DTR, Secs);
Secs2Date(Secs, DTR);
end;
procedure Date2Secs(Date: DTRec; var Secs: longint);
var Tage: longint;
begin
with Date do
begin
Year := (LongYear(Year) mod 1900) + 1900;
if (Month < 3) then
begin
inc(Month, 12);
dec(Year);
end;
Tage := (Year div 4) - (Year div 100) + (Year div 400);
Tage := Tage + trunc(DaysPerMonth * (Month + 1)) + Day;
Secs := (longint(Year) * 365) + Tage - 723243;
Secs := (Secs * SecsPerDay) + (longint(Hour) * 3600) + (Minute * 60) +
Second;
end;
end;
procedure Secs2Date(Secs: longint; var Date: DTRec);
var
Tage: longint;
Zeit: longint;
begin
with Date do
begin
Zeit := (Secs mod SecsPerDay);
Secs := (Secs div SecsPerDay) + 723121;
WeekDay := (Secs + 2) mod 7;
Year := trunc(Secs / DaysPerYear);
Tage := (Year div 4) - (Year div 100) + (Year div 400);
Secs := (Secs - ((longint(Year) * 365) + Tage - 122));
Month := pred(trunc(Secs / DaysPerMonth));
Day := Secs - trunc(DaysPerMonth * succ(Month));
if (Month > 12) then
begin
dec(Month, 12);
inc(Year);
end;
if (Day = 29) and (Month = 2) and ((Year mod 4) > 0) then
begin
Day := 1;
Month := 3;
end;
Hour := Zeit div 3600;
Minute := (Zeit - (longint(Hour) * 3600)) div 60;
Second := Zeit - (longint(Hour) * 3600) - (Minute * 60);
end;
end;
procedure PackDate(Date: DTRec; var Time: integer);
var DT: TDateTime;
begin
NormalizeDate(Date);
DT := EncodeDate(Date.Year, Date.Month, Date.Day);
DT := DT + EncodeTime(Date.Hour, Date.Minute, Date.Second, 0);
Time := DateTimeToFileDate(DT);
end;
procedure PackSecs(Secs: longint; var Time: integer);
var Date: DTRec;
begin
Secs2Date(Secs, Date);
PackDate(Date, Time);
end;
procedure UnpackDate(Time: integer; var Date: DTRec);
var
DT: TDateTime;
MSec: word;
begin
DT := FileDateToDateTime(Time);
with Date do
begin
DecodeDate(DT, Year, Month, Day);
DecodeTime(DT, Hour, Minute, Second, MSec);
end;
NormalizeDate(Date);
end;
procedure UnpackSecs(Time: integer; var Secs: longint);
var Date: DTRec;
begin
UnpackDate(Time, Date);
Date2Secs(Date, Secs);
end;
function ShortYear(Year: integer): byte;
begin
Result := Year mod 100;
end;
function LongYear(Year: integer): integer;
begin
Year := ShortYear(Year);
if (Year < 80)
then inc(Year, 2000)
else inc(Year, 1900);
Result := Year;
end;
function DayOfYear(Date: DTRec): integer;
var S1, S2: longint;
begin
Date.Hour := 0;
Date.Minute := 0;
Date.Second := 0;
Date2Secs(Date, S1);
Date.Day := 1;
Date.Month := 1;
Date2Secs(Date, S2);
Result := ((S1 - S2) div SecsPerDay) + 1;
end;
function QuarterOfYear(Date: DTRec): integer;
begin
Result := ((Date.Month - 1) div 3) + 1;
end;
function FirstWeek(Year, WeekDay: word): longint;
var Date: DTRec;
begin
fillchar(Date, SizeOf(Date), #0);
Date.Day := 0;
Date.Month := 1;
Date.Year := Year;
Date2Secs(Date, Result);
repeat
Result := Result + SecsPerDay;
Secs2Date(Result, Date);
until (Date.WeekDay = WeekDay);
if (Date.Day > 4) then dec(Result, 7 * SecsPerDay);
end;
function WeekOfYear(Date: DTRec; WeekDay: byte): integer;
var S1, S2: longint;
begin
Date.Hour := 0;
Date.Minute := 0;
Date.Second := 0;
Date2Secs(Date, S1);
S2 := FirstWeek(Date.Year, WeekDay);
if (S1 < S2)
then Result := 0
else Result := ((abs(S1 - S2) div SecsPerDay) div 7) + 1;
end;
function DTS(Date: DTRec; D, T: byte; Gap: string): string;
var S1, S2: string;
function Replace(Mark: string; Code: string): integer;
begin
Result := pos(Mark, Gap);
if (Result > 0) then
begin
delete(Gap, Result, length(Mark));
insert(Code, Gap, Result);
end
end;
procedure LoopReplace(Mark: string; Code: string);
var i: integer;
begin
repeat
i := Replace(Mark, Code);
until (i = 0);
end;
procedure GapFormat;
begin
LoopReplace('%YYYY', ZoutZero(LongYear(Date.Year), 4));
LoopReplace('%YY', ZoutZero(ShortYear(Date.Year), 2));
LoopReplace('%MMM', Months[Date.Month]);
LoopReplace('%MM', ZoutZero(Date.Month, 2));
LoopReplace('%M', ZoutZero(Date.Month, 1));
LoopReplace('%DD', ZoutZero(Date.Day, 2));
LoopReplace('%D', ZoutZero(Date.Day, 1));
LoopReplace('%Q', ZoutZero(QuarterOfYear(Date), 1));
LoopReplace('%WW', ZoutZero(WeekOfYear(Date, 1), 2));
LoopReplace('%W', ZoutZero(WeekOfYear(Date, 1), 1));
LoopReplace('%CCC', ZoutZero(DayOfYear(Date), 3));
LoopReplace('%C', ZoutZero(DayOfYear(Date), 1));
LoopReplace('%NNN', WeekDays[Date.WeekDay]);
LoopReplace('%hh', ZoutZero(Date.Hour, 2));
LoopReplace('%h', ZoutZero(Date.Hour, 1));
LoopReplace('%HH', ZoutZero(Date.Hour mod 12, 2));
LoopReplace('%H', ZoutZero(Date.Hour mod 12, 1));
LoopReplace('%mm', ZoutZero(Date.Minute, 2));
LoopReplace('%m', ZoutZero(Date.Minute, 1));
LoopReplace('%ss', ZoutZero(Date.Second, 2));
LoopReplace('%s', ZoutZero(Date.Second, 1));
end;
begin
NormalizeDate(Date);
with Date do
begin
case D of
1: S1 := ZoutZero(LongYear(Year), 4) + '-' + ZoutZero(Month, 2) + '-' +
ZoutZero(Day, 2);
2: S1 := ZoutZero(LongYear(Year), 4) + '-' + ZoutZero(Month, 2);
3: S1 := ZoutZero(LongYear(Year), 4);
4: S1 := ZoutZero(LongYear(Year), 4) + ZoutZero(Month, 2);
5: S1 := ZoutZero(LongYear(Year), 4) + ZoutZero(Month, 2) + ZoutZero(Day,
2);
6: S1 := ZoutZero(Month, 2) + '-' + ZoutZero(Day, 2);
7: S1 := ZoutZero(Month, 2) + ZoutZero(Day, 2);
8: S1 := ZoutZero(Day, 2) + '.' + ZoutZero(Month, 2) + '.' +
ZoutZero(LongYear(Year), 4);
9: S1 := ZoutZero(Day, 2) + '.' + ZoutZero(Month, 2) + '.' +
ZoutZero(ShortYear(Year), 2);
10: S1 := Zout(Day, 1) + '. ' + Monate[Month] + ' ' +
ZoutZero(LongYear(Year), 4);
11: S1 := Wochentage[WeekDay] + ', ' + Zout(Day, 1) + '. ' + Monate[Month]
+ ' ' + ZoutZero(LongYear(Year), 4);
end;
case T of
1: S2 := ZoutZero(Hour, 2) + ':' + ZoutZero(Minute, 2) + ':' +
ZoutZero(Second, 2);
2: S2 := ZoutZero(Hour, 2) + ':' + ZoutZero(Minute, 2);
3: S2 := ZoutZero(Hour, 2);
4: S2 := ZoutZero(Hour, 2) + ZoutZero(Minute, 2);
5: S2 := ZoutZero(Hour, 2) + ZoutZero(Minute, 2) + ZoutZero(Second, 2);
6:
begin
S2 := ZoutZero(Hour mod 12, 2) + ':' + ZoutZero(Minute, 2) + ':' +
ZoutZero(Second, 2);
if (Hour < 12) then S2 := S2 + ' am' else S2 := S2 + ' pm';
end;
7:
begin
S2 := ZoutZero(Hour mod 12, 2) + ':' + ZoutZero(Minute, 2);
if (Hour < 12) then S2 := S2 + ' am' else S2 := S2 + ' pm';
end;
8: S2 := ZoutZero(Hour, 2) + '.' + ZoutZero(Minute, 2) + '.' +
ZoutZero(Second, 2);
9: S2 := ZoutZero(Hour, 2) + '.' + ZoutZero(Minute, 2);
10: S2 := Zout(Hour, 1) + ' Uhr ' + ZoutZero(Minute, 2);
11: S2 := Zout(Hour, 1) + ' Uhr ' + ZoutZero(Minute, 2) + ' und ' +
ZoutZero(Second, 2) + ' Sekunden';
end;
end;
if (D = 0) and (T = 0) then
begin
GapFormat;
Result := Gap;
end
else if (D <> 0) and (T = 0) then Result := S1
else if (D = 0) and (T <> 0) then Result := S2
else Result := S1 + Gap + S2;
end;
function CurrDTS(D, T: byte; Gap: string): string;
var DTR: DTRec;
begin
GetDateTime(DTR);
Result := DTS(DTR, D, T, Gap);
end;
{
function GetSecs: longint;
var
DTR: DTRec;
Secs: longint;
begin
GetDateTime(DTR);
Date2Secs(DTR, Secs);
Result := Secs;
end;
}
function GetSecs: longint;
begin
Result := Trunc((Now - 29221) * SecsPerDay);
end;
function GetSecsUTC: longint;
var
Date: TDateTime;
Time: TSystemTime;
begin
GetSystemTime(Time);
Date := SystemTimeToDateTime(Time);
Result := Trunc((Date - 29221) * SecsPerDay);
end;
function NextSunday(Day, Month, Year: integer): longint;
var Date: DTRec;
begin
fillchar(Date, SizeOf(Date), #0);
Date.Day := Day;
Date.Month := Month;
Date.Year := Year;
Date2Secs(Date, Result);
repeat
Result := Result + SecsPerDay;
Secs2Date(Result, Date);
until (Date.WeekDay = 0);
end;
function Utc2Local(Secs: longint): longint;
var Date: DTRec;
begin
Secs2Date(Secs, Date);
if (Date.Year <> DlstYear) then
begin
DlstYear := Date.Year;
DlstStart := NextSunday(24, 3, DlstYear);
DlstEnd := NextSunday(24, 10, DlstYear);
end;
if (Secs >= DlstStart) and (Secs <= DlstEnd)
then Result := Secs + 7200
else Result := Secs + 3600;
end;
function Local2Utc(Secs: longint): longint;
var Date: DTRec;
begin
Secs2Date(Secs, Date);
if (Date.Year <> DlstYear) then
begin
DlstYear := Date.Year;
DlstStart := NextSunday(24, 3, DlstYear);
DlstEnd := NextSunday(24, 10, DlstYear);
end;
if (Secs >= DlstStart) and (Secs <= DlstEnd)
then Result := Secs - 7200
else Result := Secs - 3600;
end;
function EasterSunday(Year: integer): longint;
var Date: DTRec;
begin
fillchar(Date, SizeOf(Date), #0);
case (Year mod 19) of
0: Date.Day := 14;
1: Date.Day := 3;
2: Date.Day := 23;
3: Date.Day := 11;
4: Date.Day := 31;
5: Date.Day := 18;
6: Date.Day := 8;
7: Date.Day := 28;
8: Date.Day := 16;
9: Date.Day := 5;
10: Date.Day := 25;
11: Date.Day := 13;
12: Date.Day := 2;
13: Date.Day := 22;
14: Date.Day := 10;
15: Date.Day := 30;
16: Date.Day := 17;
17: Date.Day := 7;
18: Date.Day := 27;
end;
if (Date.Day > 20) then Date.Month := 3 else Date.Month := 4;
Date.Year := Year;
Date2Secs(Date, Result);
repeat
Result := Result + SecsPerDay;
Secs2Date(Result, Date);
until (Date.WeekDay = 0);
end;
function GetHoliday(Year, Holiday: integer): longint;
begin
Result := 0;
case Holiday of
0: Result := EasterSunday(Year); { Ostersonntag }
1: begin { Muttertag }
Result := NextSunday(7, 5, Year);
if (Result = EasterSunday(Year) + (49 * SecsPerDay)) then Result :=
Result + (7 * SecsPerDay);
end;
2: Result := NextSunday(29, 9, Year); { Erntedankfest }
3: Result := NextSunday(19, 11, Year); { Totensonntag }
4: Result := NextSunday(24, 12, Year) - (7 * SecsPerDay); { 4. Advent }
end;
end;
function Secs2Time(Secs: longint): TDateTime;
begin
Result := (Secs / SecsPerDay) + 29221;
end;
function Time2Secs(Time: TDateTime): longint;
begin
Result := Trunc((Time - 29221) * SecsPerDay);
end;
function Date2Iso(Date: DTRec; Format: IsoFormat): string;
begin
if (Format = IsoShort) then Result := DTS(Date, 5, 5, 'T') else Result :=
DTS(Date, 1, 1, ' ');
end;
function Secs2Iso(Secs: longint; Format: IsoFormat): string;
var Date: DTRec;
begin
Secs2Date(Secs, Date);
Result := Date2Iso(Date, Format);
end;
function Iso2Date(S: string): DTRec;
var i: integer;
begin
fillchar(Result, SizeOf(Result), #0);
if (length(S) = 15) and (pos('T', S) = 9) then
begin
Result.Year := Zin(copy(S, 1, 4));
Result.Month := Zin(copy(S, 5, 2));
Result.Day := Zin(copy(S, 7, 2));
Result.Hour := Zin(copy(S, 10, 2));
Result.Minute := Zin(copy(S, 12, 2));
Result.Second := Zin(copy(S, 14, 2));
end
else begin
i := pos('-', S);
if (i > 0) then
begin
Result.Year := Zin(copy(S, 1, i - 1));
if (Result.Year < 100) then inc(Result.Year, 2000);
delete(S, 1, i);
i := pos('-', S);
Result.Month := Zin(copy(S, 1, i - 1));
delete(S, 1, i);
i := pos(' ', S);
Result.Day := Zin(copy(S, 1, i - 1));
delete(S, 1, i);
i := pos(':', S);
Result.Hour := Zin(copy(S, 1, i - 1));
delete(S, 1, i);
i := pos(':', S);
Result.Minute := Zin(copy(S, 1, i - 1));
delete(S, 1, i);
Result.Second := Zin(S);
end;
end;
NormalizeDate(Result);
end;
function Iso2Secs(S: string): longint;
var Date: DTRec;
begin
Date := Iso2Date(S);
Date2Secs(Date, Result);
end;
initialization
DlstYear := -1;
end.