Kein Streß mehr mit Datum & Zeit

[mz23]

Guten Morgen liebe DP-Gemeinde,

mutig geworden durch lesen dieses Beitrages
http://www.delphipraxis.net/141399-d...unktionen.html

werde ich auch einiges hier reinsetzen, das ich mal in
Bezug auf Datum und Uhrzeit mir zusmmengeschrieben habe:)

Delphi-Quellcode:

unit FileDateTimeUnit;
{ written by Manfred Zenns Oct 2008 }
{ example values }
{ fTime = 33083, fDate = 14681 }
{ fDateTime = 962167099 }
{ Time: 16:09:54 }
{ Date: 25.10.08 }
{ DateTime: 25.10.08  16:09:54 }

interface

function _FileDateAndTime2Longint(fDate,fTime:word):longint;
function _FileLongint2TimeStr(fDateTime:longint):string;
function _FileLongint2DateStr(fDateTime:longint):string;
function _FileLongint2DateTimeStr(fDateTime:longint):string;

implementation
uses SysUtils;

function _FileDateAndTime2Longint(fDate,fTime:word):longint;
begin
try result:=(longint(fDate) shl 16)+longint(fTime);
except
    on EConvertError do result:=0;
end; {except}
end;

function _FileLongint2TimeStr(fDateTime:longint):string;
begin
try result:=TimeToStr(FileDateToDateTime(fDateTime));
except
    on EConvertError do result:='hh:mm:ss';
end; {except}
end;

function _FileLongint2DateStr(fDateTime:longint):string;
begin
try result:=DateToStr(FileDateToDateTime(fDateTime));
except
    on EConvertError do result:='dd.mm.yy';
end; {except}
end;

function _FileLongint2DateTimeStr(fDateTime:longint):string;
begin
try result:=DateTimeToStr(FileDateToDateTime(fDateTime));
except
    on EConvertError do result:='dd.mm.yy hh:mm:ss';
end; {except}
end;

end.

Eine vorherige Format-Angabe wäre nicht schlecht, um
Übereinstimmung zur Rückgabe der Funktionen mit den
vom Betriebssystem eingestelltem Zeitformat zu erreichen.

Delphi-Quellcode:

unit ProcedureDateTime;
{ ---------------------------------- }
{ written by Manfred Zenns 2008-2012 }
{ ---------------------------------- }
{ these f's and p's works from 1.1.0000 till 31.12.65535 }
{ note: year 02 means 0002 and not 2002, as 96 means 0096 and not 1996 }
{       the 1.st week of a year starts with a week have at least 4 days }
{       the 1.st day of a week is the monday }
{       some smileys if you try to calc ColumbusDay before 1492... }
{       or Christian holidays before 311... }
{ main target of this unit is NOT to use any other unit for its work - okay }
{---------------------------------------------------------------------------}
interface
// uses ProcedureUnit;

type __s2  = string[2];
     __s9  = string[9];
     __s11 = string[11];

// on date, days, months, years
function  isLeapYear(Y:word):boolean;
function  getMonthDays(M,Y:word):longint;
function  getYearDays(Y:word):longint;
function  getTotalYearDays(D,M,Y:word):longint;
function  getDaysSinceZero(D,M,Y:word):longint;
procedure getDateOfZeroDays(Days:longint; var D,M,Y:word);
function  getDate1BeforeDate2(D1,M1,Y1,D2,M2,Y2:word):boolean;
function  getDaysBetweenDates(D1,M1,Y1,D2,M2,Y2:word):longint;
procedure getDateAfterAddDMY(Days,Months,Years:longint; var D,M,Y:word);
procedure getDateAfterSubDMY(Days,Months,Years:longint; var D,M,Y:word);
// on time, hours, minutes, seconds
function  getSecsSinceZero(H,M,S:word):longint;
procedure getTimeOfZeroSecs(Secs:longint; var H,M,S:word);
function  getSecsBetweenTimes(H1,M1,S1,H2,M2,S2:word):longint;
procedure getTimeAfterAddHMS(Hours,Minutes,Secs:longint; var H,M,S,Ovf:word);
procedure getTimeAfterSubHMS(Hours,Minutes,Secs:longint; var H,M,S,Ovf:word);
// on weekdays, weeknumbers
function  getDayOfWeek(D,M,Y:word):__s9;
function  getIndexOfWeek(D,M,Y:word):longint;
procedure getDateFromWeekNumber(WeekNumber,Year:longint; var D,M,Y:word);
function  getWeekNumberFromDate(D,M,Y:word):longint;
// on specials
function  getZodiacSign(D,M,Y:word):__s11;
// on holidays
procedure getEastern(Year:word; var D,M,Y:word);
procedure getEasternAddDays(Year,AddDays:longint; var D,M,Y:word);
procedure getAshWednesday(Year:word; var D,M,Y:word);
procedure getGoodFriday(Year:word; var D,M,Y:word);
procedure getChristiAscension(Year:word; var D,M,Y:word);
procedure getWhitSunday(Year:word; var D,M,Y:word);
procedure getCorpusChristi(Year:word; var D,M,Y:word);
function  getGermanHolidays:string;
procedure getXthWeekDayOfMonthYear(X:byte;WeekDay:__s2;Month,Year:word; var D,M,Y:word);
procedure getMartinLutherKingDay(Year:word; var D,M,Y:word);
procedure getPresidentsDay(Year:word; var D,M,Y:word);
procedure getMemorialDay(Year:word; var D,M,Y:word);
procedure getLabourDay(Year:word; var D,M,Y:word);
procedure getColumbusDay(Year:word; var D,M,Y:word);
procedure getThanksgivingDay(Year:word; var D,M,Y:word);
function  getUSAHolidays:string;

implementation

function isLeapYear(Y:word):boolean;
begin
result:=False;
if (Y mod 4 = 0) then begin
   result:=True;
   if (Y mod 100 = 0) then begin
      result:=False;
      if (Y mod 400 = 0) then result:=True;
   end;
end;
end;

function getMonthDays(M,Y:word):longint;
begin
result:=-1;
case M of
  1,3,5,7,8,10,12: result:=31;
         4,6,9,11: result:=30;
                2: if isLeapYear(Y) then result:=29
                                    else result:=28;
end; {case}
end;

function getYearDays(Y:word):longint;
begin
result:=365-28+getMonthDays(2,Y);
end;

function getTotalYearDays(D,M,Y:word):longint;
var i, r : longint;
begin
r:=0;
for i:=1 to M-1 do inc(r,getMonthDays(i,Y));
inc(r,D);
result:=r;
end;

function getDaysSinceZero(D,M,Y:word):longint;
var i, r : longint;
begin
r:=getTotalYearDays(D,M,Y);
for i:=0 to Y-1 do inc(r,getYearDays(i));
result:=r;
end;

procedure getDateOfZeroDays(Days:longint; var D,M,Y:word);
var hD, hM, hY : longint;
begin
hY:=-1;
while (Days > 0) do begin
      inc(hY);
      dec(Days,getYearDays(hY));
end; {while}
inc(Days,getYearDays(hY));
hM:=0; Y:=hY;
while (Days > 0) do begin
      inc(hM);
      if (hM > 12) then break;
      dec(Days,getMonthDays(hM,Y));
end; {while}
if (hM <= 12) then inc(Days,getMonthDays(hM,Y));
hD:=Days;
D:=hD; M:=hM;
end;

function getDate1BeforeDate2(D1,M1,Y1,D2,M2,Y2:word):boolean;
begin {-is Date1 before Date2 then return true-}
result:=(getDaysSinceZero(D1,M1,Y1) > getDaysSinceZero(D2,M2,Y2));
end;

function getDaysBetweenDates(D1,M1,Y1,D2,M2,Y2:word):longint;
var dsz1, dsz2 : longint;
begin
dsz1:=getDaysSinceZero(D1,M1,Y1);
dsz2:=getDaysSinceZero(D2,M2,Y2);
result:=abs(dsz1-dsz2);
end;

procedure getDateAfterAddDMY(Days,Months,Years:longint; var D,M,Y:word);
var dsz, hM : longint;
begin
dsz:=getDaysSinceZero(D,M,Y);
inc(dsz,Days);
getDateOfZeroDays(dsz,D,M,Y);
hM:=M; inc(hM,Months); inc(Y,Years);
while (hM > 12) do begin inc(Y); dec(hM,12); end;
M:=hM;
end;

procedure getDateAfterSubDMY(Days,Months,Years:longint; var D,M,Y:word);
var dsz, hM, hY : longint;
begin
dsz:=getDaysSinceZero(D,M,Y);
dec(dsz,Days);
if (dsz > 0) then begin
   getDateOfZeroDays(dsz,D,M,Y);
   hM:=M; hY:=Y; dec(hM,Months); dec(hY,Years);
   while (hM < 1) do begin dec(hY); inc(hM,12); end;
   if (hM > 0) then M:=hM else M:=0;
   if (hY > 0) then Y:=hY else Y:=0;
end else begin
   D:=0; M:=0; Y:=0;
end;
end;

//

function getSecsSinceZero(H,M,S:word):longint;
begin
result:=longint(H)*3600+
        longint(M)*60+
        longint(S);
end;

procedure getTimeOfZeroSecs(Secs:longint; var H,M,S:word);
var hH, hM : longint;
begin
Secs:=Secs mod 86400;
hH:=(Secs div 3600);  dec(Secs,hH*3600);  H:=hH;
hM:=(Secs div 60);    dec(Secs,hM*60);    M:=hM;
S:=Secs;
end;

function getSecsBetweenTimes(H1,M1,S1,H2,M2,S2:word):longint;
var ssz1, ssz2 : longint;
begin
ssz1:=getSecsSinceZero(H1,M1,S1);
ssz2:=getSecsSinceZero(H2,M2,S2);
result:=abs(ssz1-ssz2);
end;

procedure getTimeAfterAddHMS(Hours,Minutes,Secs:longint; var H,M,S,Ovf:word);
var ssz : longint;
begin
ssz:=getSecsSinceZero(H,M,S);
inc(ssz,Secs+Minutes*60+Hours*3600);
Ovf:=ssz div 86400;
ssz:=ssz mod 86400;
getTimeOfZeroSecs(ssz,H,M,S);
end;

procedure getTimeAfterSubHMS(Hours,Minutes,Secs:longint; var H,M,S,Ovf:word);
var ssz : longint;
begin
ssz:=getSecsSinceZero(H,M,S);
dec(ssz,Secs+Minutes*60+Hours*3600); Ovf:=0;
while (ssz < 0) do begin inc(Ovf); inc(ssz,86400); end;
getTimeOfZeroSecs(ssz,H,M,S);
end;

//

function getDayOfWeek(D,M,Y:word):__s9;
var dsz : longint;
begin
dsz:=getDaysSinceZero(D,M,Y);
dsz:=dsz mod 7;
case dsz of
  0: result:='Friday';     1: result:='Saturday';
  2: result:='Sunday';     3: result:='Monday';
  4: result:='Tuesday';    5: result:='Wednesday';
  6: result:='Thursday';
end; {case}
end;

function getIndexOfWeek(D,M,Y:word):longint;
var dsz : longint;
begin
dsz:=getDaysSinceZero(D,M,Y);
result:=dsz mod 7; {0='Friday' .. 6='Thursday'}
end;

procedure getDateFromWeekNumber(WeekNumber,Year:longint; var D,M,Y:word);
var dow : string[2];
    days : longint;
begin
{first day of a week is the Monday}
{first week is a min 4 days week}
dec(WeekNumber); D:=1; M:=1; Y:=Year;
dow:=copy(getDayOfWeek(1,1,Year),1,2);
{the 1.1.year is monday...}
if (dow='Mo') then days:=7*WeekNumber else
   if (dow='Tu') then begin
      if (WeekNumber = 0) then begin
         D:=31; M:=12; dec(Y); exit;
      end else
         days:=7*WeekNumber-1;
   end else
      if (dow='We') then begin
         if (WeekNumber = 0) then begin
            D:=30; M:=12; dec(Y); exit;
         end else
            days:=7*WeekNumber-2;
      end else
         if (dow='Th') then begin
            if (WeekNumber = 0) then begin
               D:=29; M:=12; dec(Y); exit;
            end else
               days:=7*WeekNumber-3;
         end else
            {the 1.1.year is friday... now we have not longer a 4 days week}
            if (dow='Fr') then begin
               if (WeekNumber = 0) then begin
                  D:=4; exit;
               end else
                  days:=7*WeekNumber+3;
            end else
               if (dow='Sa') then begin
                  if (WeekNumber = 0) then begin
                     D:=3; exit;
                  end else
                     days:=7*WeekNumber+2;
               end else
                  if (dow='Su') then begin
                     if (WeekNumber = 0) then begin
                        D:=2; exit;
                     end else
                        days:=7*WeekNumber+1;
                  end;
getDateAfterAddDMY(days,0,0,D,M,Y);
end;

function getWeekNumberFromDate(D,M,Y:word):longint;
var dow : string[2];
    days, sub : longint;
begin
dow:=copy(getDayOfWeek(1,1,Y),1,2);
days:=getTotalYearDays(D,M,Y);
{the 1.1.year is monday...}
if (dow='Mo') then sub:=1 else
   if (dow='Tu') then sub:=0 else
      if (dow='We') then sub:=-1 else
         if (dow='Th') then sub:=-2 else
            {the 1.1.year is friday... now we have not longer a 4 days week}
            if (dow='Fr') then begin
               if ((M=1) and (D<4)) then begin
                  result:=getWeekNumberFromDate(28,12,Y-1); exit;
               end else
                  sub:=+4
            end else
               if (dow='Sa') then begin
                  if ((M=1) and (D<3)) then begin
                     result:=getWeekNumberFromDate(27,12,Y-1); exit;
                  end else
                     sub:=+3
               end else
                  if (dow='Su') then begin
                     if ((M=1) and (D<2)) then begin
                        result:=getWeekNumberFromDate(26,12,Y-1); exit;
                     end else
                        sub:=+2;
                  end;
{possible values 1..52, 53 -> 1}
result:=1+((days-sub) div 7);
if (result > 52) then result:=1;
end;

function getZodiacSign(D,M,Y:word):__s11;
var days : longint;
begin
days:=getTotalYearDays(D,M,Y);
if (days>= 21) and (days<= 49) then result:='Aquarius';
if (days>= 50) and (days<= 79) then result:='Pisces';
if (days>= 80) and (days<=111) then result:='Aries';
if (days>=112) and (days<=141) then result:='Taurus';
if (days>=142) and (days<=172) then result:='Gemini';
if (days>=173) and (days<=203) then result:='Cancer';
if (days>=204) and (days<=235) then result:='Leo';
if (days>=236) and (days<=266) then result:='Virgo';
if (days>=267) and (days<=296) then result:='Libra';
if (days>=297) and (days<=326) then result:='Scorpio';
if (days>=327) and (days<=355) then result:='Sagittarius';
if (days>=355) or  (days<= 20) then result:='Capricorn';
end;

procedure getEastern(Year:word; var D,M,Y:word);
var a,b,c,v4,e,hD,hM,days : longint;
    dow : string[2];
begin
Y:=Year;
a:=y mod 19;  b:=y mod 4;  c:=y mod 7;  v4:=(19*a+24) mod 30;
e:=(2*b+4*c+6*v4+5) mod 7;  hD:=22+v4+e;  hM:=3;
if (hD>31) then begin hD:=v4+e-9; hM:=4; end;
if ((hD=26) and (hM=4)) then hD:=19;
if ((hD=25) and (hM=4) and (v4=28) and (e=6) and (a>10)) then hD:=18;
D:=hD; M:=hM;
days:=getDaysSinceZero(D,M,Y);
dow:=copy(getDayOfWeek(D,M,Y),1,2);
if (dow='Su') then {okay} else
   if (dow='Mo') then dec(days) else
      if (dow='Tu') then dec(days,2) else
         if (dow='We') then dec(days,3) else
            if (dow='Th') then inc(days,3) else
               if (dow='Fr') then inc(days,2) else
                  if (dow='Sa') then inc(days);
getDateOfZeroDays(days,D,M,Y);
end;

procedure getEasternAddDays(Year,AddDays:longint; var D,M,Y:word);
var days : longint;
begin
getEastern(Year,D,M,Y);
days:=getDaysSinceZero(D,M,Y)+AddDays;
getDateOfZeroDays(days,D,M,Y);
end;

procedure getAshWednesday(Year:word; var D,M,Y:word);
begin {AscherMittwoch -46}
getEasternAddDays(Year,-46,D,M,Y);
end;

procedure getGoodFriday(Year:word; var D,M,Y:word);
begin {KarFreitag -2}
getEasternAddDays(Year,-2,D,M,Y);
end;

procedure getChristiAscension(Year:word; var D,M,Y:word);
begin {Christi Himmelfahrt +39}
getEasternAddDays(Year,+39,D,M,Y);
end;

procedure getWhitSunday(Year:word; var D,M,Y:word);
begin {PfingstSonntag +49}
getEasternAddDays(Year,+49,D,M,Y);
end;

procedure getCorpusChristi(Year:word; var D,M,Y:word);
begin {Fronleichnam +60}
getEasternAddDays(Year,+60,D,M,Y);
end;

function getGermanHolidays:string;
begin {}
result:='NeuJahr=1.1.,'+
        'MaiFeiertag=1.5.,'+
        'TagDerDeutschenEinheit=3.10.,'+
        'Reformationstag=31.10.,'+
        'Weihnachten=24-26.12.';
end;

procedure getXthWeekDayOfMonthYear(X:byte;WeekDay:__s2;Month,Year:word; var D,M,Y:word);
var f,lastf,i: byte;
    dow : __s2;
begin
f:=0; lastf:=0; M:=Month; Y:=Year;
for i:=1 to 31 do begin
    dow:=copy(getDayOfWeek(i,M,Y),1,2);
    if (dow=WeekDay) then begin inc(f); lastf:=i; end;
    if (f=X) then begin D:=i; break; end;
end;
D:=lastf; {force to return the last WeekDay for X > 5}
end;

procedure getMartinLutherKingDay(Year:word; var D,M,Y:word);
begin {MartinLutherKingDay is 3rd Monday in Jan}
getXthWeekDayOfMonthYear(3,'Mo',1,Year,D,M,Y);
end;

procedure getPresidentsDay(Year:word; var D,M,Y:word);
begin {PresidentsDay is 3rd Monday in Feb}
getXthWeekDayOfMonthYear(3,'Mo',2,Year,D,M,Y);
end;

procedure getMemorialDay(Year:word; var D,M,Y:word);
begin {PresidentsDay is LAST(255) Monday in May}
getXthWeekDayOfMonthYear(255,'Mo',5,Year,D,M,Y);
end;

procedure getLabourDay(Year:word; var D,M,Y:word);
begin {LabourDay is 1st Monday in Sep}
getXthWeekDayOfMonthYear(1,'Mo',9,Year,D,M,Y);
end;

procedure getColumbusDay(Year:word; var D,M,Y:word);
begin {ColumbusDay is 2nd Monday in Oct}
getXthWeekDayOfMonthYear(2,'Mo',10,Year,D,M,Y);
end;

procedure getThanksgivingDay(Year:word; var D,M,Y:word);
begin {ThanksgivingDay is 4th Thursday in Nov}
getXthWeekDayOfMonthYear(4,'Th',11,Year,D,M,Y);
end;

function getUSAHolidays:string;
begin {}
result:='NewYearsDay=1.1.,'+
        'VeteransDay=11.11.,'+
        'ChristmasDay=25.12.';
end;

end.

So, das war's auch schon - von meiner Seite:)

Viele Grüße von Manfred