[fpc-pascal]squid date convert help

greim greim at schleibinger.com
Wed Oct 3 10:39:15 CEST 2001


Hi Gabor, 

some month ago I sent a unit i often use to this list. 
A copy of my old mail below
Regards
Markus Greim



ghorvath at minolta.hu wrote:
> 
> Dear Members,
> 
> I have the following problem. I would like to convert squid's unix date to
> TDateTime. How can I do it?
> squid's date is e.g. 999270845.163.
> It must be interpreted as elapsed seconds from 1970-01-01.
> In Unix I can use "date --date '1970-01-01 99270845 sec'" command but
> calling bash from a pascal prog is veryyyy slow.
> 
> Please help me !
> 
> Sincerely yours,
> 
> Gabor Horvath
> ghorvath at minolta.hu
> 
> _______________________________________________
> fpc-pascal maillist  -  fpc-pascal at lists.freepascal.org
> http://lists.freepascal.org/mailman/listinfo/fpc-pascal
-----------------------------------------------------------------------------------------------
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




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; {leapyear}

         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; {number of day}

         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; {seconds since 1980}

         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); {sec
2 day}

          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