[fpc-pascal]Question about DATE handling...
greim
greim at schleibinger.com
Thu Mar 22 17:18:02 CET 2001
Hi Rainer,
enclosed a unit i often use. Its quite old, based on some
C-code published in the c't magazine years ago.
I hope thats not a (c) violation.
I use the time from 01.01.1980 becaus longint
has only half the time as epoch time...
Regards
Markus Greim
Rainer Hantsch wrote:
>
> Hello, everybody!
>
> For a CGI program (Linux), I need some date conversions/calculations, but I
> have some difficulties.
>
> All of the remaining project is compiled in TurboPascal Mode (no options
> like ObjFPC or Delphi specified in FPC 1.0.4).
>
> Here my problems:
> -----------------
> If I convert a date string (dd.mm.yyyy) into a numeric value, StrToDate() has
> difficulties and causes an EConvertError, if the data are not right. Michawl
> suggested to add an "except ... end;" part to this conversion, but then my
> compiler sais that it needs either ObjFPC or Delphi mode. (But this compiles
> the while stuff of the remaining project differently!) So i cannot use this.
> --> Any idea on how to overcome this?
>
> Next, the result of StrToDate() is tDateTime. I can basically live with this,
> but: How can I add a specific number of days to this date? (I must calculate a
> end date from start-date plus num of days!)
> Normally, I use EpochTime as internal date format for all of that, so I
> can simply add/subtract seconds -- and this is perfect.
> --> But how can I get an epoch time out from tDateTime?
>
> Please, leave me an urgent note on that, I stuck.
>
> Ing. Rainer Hantsch
>
> \\|// Ing. Rainer HANTSCH - Hardware + Software
> (o o) Your Partner - Your Supplier - Your Friend!
> --oOOo-(_)-oOOo--------------------------------------------------
> Ing. Rainer HANTSCH | e-Mail: office at hantsch.co.at
> Khunngasse 21/20 | www : http://www.hantsch.co.at
> A-1030 Vienna | Tel. : ++43 - 1 - 7988538 0
> ---------------------| Fax : ++43 - 1 - 7988538 18
> ** AUSTRIA ** | Mobile: ++43 - 663 - 9194382
> -----------------------------------------------------------------
>
> _______________________________________________
> fpc-pascal maillist - fpc-pascal at lists.freepascal.org
> http://lists.freepascal.org/mailman/listinfo/fpc-pascal
-------------- next part --------------
UNIT stime;
INTERFACE
USES dos, rtstdhdr;
FUNCTION gerade(x : RealType) : RealType;
PROCEDURE zeit(start : longint; VAR d, h, m, s : RealType; VAR diffzeit : longint);
FUNCTION sekunden_seit_1980(jahr, monat, tag, stunden, minuten, sekunden : word) : longint;
FUNCTION sekunden_seit_1980_2(datum, zeit : string) : longint;
FUNCTION sek_seit_80 : longint;
FUNCTION isvaliddate(s : string) : boolean;
FUNCTION isvalidtime(s : string) : boolean;
PROCEDURE mydelay(i : integer);
FUNCTION mygetdate : string;
FUNCTION mygettime : string;
FUNCTION sek2date(i : longint) : string;
FUNCTION sek2shortdate(i : longint) : string;
FUNCTION sek2time(i : longint) : string;
IMPLEMENTATION
PROCEDURE mydelay(i : integer);
VAR x, y : double;
lauf, lauf2 : integer;
BEGIN
y := 0.5;
x := 0.5;
FOR lauf := 1 TO i DO
BEGIN
For lauf2 := 1 TO 143 DO
BEGIN
x:= sin(y);
y := sin(x);
END;
END;
END;
FUNCTION gerade(x : RealType) : RealType;
VAR y, g : RealType;
BEGIN
y := frac(x);
g := y;
IF (y > 0.24) AND (y < 0.26) THEN g := 0.25;
IF (y > 0.99) AND (y < 1.00) THEN g := 0.0;
IF (y > 0.49) AND (y < 0.51) THEN g := 0.5;
gerade := trunc(x) + g;
END;
FUNCTION schaltjahr(jahr : word) : integer;
BEGIN
schaltjahr := 0;
IF ((jahr MOD 4) = 0) AND ((jahr MOD 100) <> 0) OR ((jahr MOD 400) = 0) THEN schaltjahr := 1;
END;
FUNCTION tagesnummer(jahr, monat, tag : word) : word;
VAR d, e : word;
BEGIN
d := (monat + 10) DIV 13;
e := tag + (611 * (monat + 2)) DIV 20 - 2 * d - 91;
tagesnummer := e + schaltjahr(jahr) * d;
END;
FUNCTION sekunden_seit_1980(jahr, monat, tag, stunden, minuten, sekunden : word) : longint;
VAR tage : longint;
lauf : integer;
BEGIN
tage := 0;
FOR lauf := 1980 TO pred(jahr) DO
BEGIN
tage := tage + 365 + schaltjahr(lauf);
END;
tage := tage + pred(tagesnummer(jahr, monat, tag));
sekunden_seit_1980 := tage * (24*3600) + longint(stunden) * 3600 + longint(minuten) * 60 + longint(sekunden);
END;
FUNCTION sekunden_seit_1980_2(datum, zeit : string) : longint;
VAR d1, d2, d3 : integer;
jahr, monat, tag, stunden, minuten, sekunden : word;
i : longint;
s : string;
BEGIN
i := 2100;
IF isvaliddate(datum) THEN
BEGIN
IF isvalidtime(zeit) THEN
BEGIN
s := datum;
val(copy(s,1,2),tag, d1);
val(copy(s,4,2), monat, d2);
val(copy(s,7,4), jahr, d3);
s := zeit;
val(copy(s,1,2), stunden, d1);
val(copy(s,4,2), minuten, d2);
sekunden := 0;
i := sekunden_seit_1980(jahr, monat, tag, stunden, minuten, sekunden);
END;
END;
sekunden_seit_1980_2 := i;
END;
PROCEDURE sek2tag(sekunden : longint ; VAR d, h, m, s : RealType);
BEGIN
d := sekunden DIV 86400;
h := (sekunden MOD 86400) DIV 3600;
m := ((sekunden MOD 86400) MOD 3600) DIV 60;
s := ((sekunden MOD 86400) MOD 3600) MOD 60;
END;
PROCEDURE zeit(start : longint; VAR d, h, m, s : RealType; VAR diffzeit : longint);
TYPE myDateTimety = RECORD
year, month, day, dow_n,
hour, min, sec, s100_n : word;
END;
VAR dt : myDateTimety;
zeitakt : longint;
dow_n, s100_n : word;
BEGIN
WITH DT DO
BEGIN
getdate(year, month, day, dow_n);
gettime(hour, min, sec, s100_n);
zeitakt := sekunden_seit_1980(year, month, day,hour, min, sec);
END;
diffzeit := zeitakt - start;
sek2tag(diffzeit, d, h, m, s);
END;
PROCEDURE d2y(d : longint; VAR y, yd : longint);
BEGIN
y := 1980;
WHILE d > 0 DO
BEGIN
d := d - 365 - schaltjahr(y);
y := y + 1;
END;
dec(y);
d := d + 365 + schaltjahr(y);
yd := d;
END;
PROCEDURE d2m(d, y : longint; VAR m, md : longint);
VAR tage : ARRAY[1..13] OF longint;
BEGIN
tage[1] :=31;
tage[2] := 28 + schaltjahr(y);
tage[3] :=31;
tage[5] :=31;
tage[7] :=31;
tage[8] :=31;
tage[10] :=31;
tage[12] :=31;
tage[4] :=30;
tage[6] :=30;
tage[9] :=30;
tage[11] :=30;
tage[13] := 31;
m := 1;
md := 0;
WHILE (d > 0) AND (m < 14) DO
BEGIN
d := d - tage[m];
inc(m);
END;
dec(m);
d:= d + tage[m];
md := d;
END;
function LeadingZero(w : Word) : String;
var
s : String;
begin
Str(w:0,s);
if Length(s) = 1 then
s := '0' + s;
LeadingZero := s;
end;
FUNCTION sek2date(i : longint) : string;
VAR d, h, min, sec: RealType;
y, yd, m, md : longint;
BEGIN
sek2tag(i, d, h, min, sec);
d2y(round(d+1), y, yd);
d2m(yd, y, m, md);
sek2date := LeadingZero(md) + '.' + LeadingZero(m) + '.' + LeadingZero(y);
END;
FUNCTION sek2shortdate(i : longint) : string;
VAR d, h, min, sec: RealType;
y, yd, m, md : longint;
BEGIN
sek2tag(i, d, h, min, sec);
d2y(round(d+1), y, yd);
d2m(yd, y, m, md);
sek2shortdate := LeadingZero(md) + '.' + LeadingZero(m);
END;
FUNCTION sek2time(i : longint) : string;
VAR d, h, m, s: RealType;
BEGIN
sek2tag(i, d, h, m, s);
sek2time := LeadingZero(round(h))+ ':' + LeadingZero(round(m));
END;
FUNCTION sek_seit_80 : longint;
VAR dt : DateTime;
diffzeit, zeitakt : longint;
dow_n, s100_n : word;
BEGIN
WITH DT DO
BEGIN
getdate(year, month, day, dow_n);
gettime(hour, min, sec, s100_n);
zeitakt := sekunden_seit_1980(year, month, day,hour, min, sec);
END;
sek_seit_80 := zeitakt;
END;
FUNCTION isvaliddate(s : string) : boolean;
VAR d1, d2, d3 : integer;
d4, d5, d6, d7, d8, d9 : Boolean;
tag, monat, jahr : word;
BEGIN
val(copy(s,1,2),tag, d1);
val(copy(s,4,2), monat, d2);
val(copy(s,7,4), jahr, d3);
IF (jahr < 100) AND (jahr > 79) THEN jahr := jahr + 1900;
IF (jahr <= 79) THEN jahr := jahr + 2000;
d4 := (tag > 0) AND (tag <= 31);
d5 := (monat > 0) AND (monat <= 12);
d6 := (jahr > 1979) AND (jahr < 2020);
CASE monat OF
1,3,5,7,8,10,12 : d7:= (tag <= 31);
4,6,9,11 : d7 := (tag <= 30);
2 : BEGIN
IF (schaltjahr(jahr) = 1) THEN
BEGIN
d7 := (tag <= 29);
END
ELSE
BEGIN
d7 := (tag <= 28);
END;
END;
END;
isvaliddate := ((d1 + d2 + d3)=0) AND (d4 AND d5 AND d6 AND d7);
END;
FUNCTION isvalidtime(s : string) : Boolean;
VAR d1, d2 : integer;
d3, d4 : Boolean;
stunden, minuten : word;
BEGIN
val(copy(s,1,2), stunden, d1);
val(copy(s,4,2), minuten, d2);
d3 := (stunden >= 0) AND (stunden < 25);
d4 := (minuten >= 0) AND (minuten <= 59);
isvalidtime := ((d1 + d2) = 0) AND (d3 AND d4);
END;
FUNCTION mygetdate : string;
VAR
y, m, d, dow : Word;
BEGIN
getdate(y, m, d, dow);
mygetdate := LeadingZero(d) + '.' + LeadingZero(m) + '.' + LeadingZero(y);
END;
FUNCTION mygettime : string;
var
h, m, s, hund : Word;
begin
GetTime(h,m,s,hund);
mygettime := LeadingZero(h)+ ':' + LeadingZero(m);
end;
BEGIN
END.
More information about the fpc-pascal
mailing list