XProfan

Source wurde am 15.07.2007 aus der MMJ-Quellcodesammlung (Dietmar Horn) in die Babyklappe auf XProfan.Com abgelegt:
Zeitunterschied zwischen zwei Datumsangaben
Ein PROFAN-Beispiel Quelltext von Achim Engelhardt
Profan-Vers.: 6.5 oder höher
Prozedur zum Ermitteln der Zeitdifferenz zweier Datümer und Zeiten
Volksmündliche, nicht mathematische Berechnung, das heißt:
Der Unterschied wird in Sekunden ausgerechnet, ein Ausgabejahr ist genau die Zeit vom Datum zum gleichen Datum des nächsten Jahres
unabhängig davon, ob Schaltjahr, oder nicht. Die Resttage aber nehmen darauf rücksicht.
Benötigt die prfdat32.dll, die auf jeder 32Bit-Profan CD drauf ist
Arbeitet zw. 1.1.1600 und weißnich.
Decimals 0
DECLARE JAHRE%,TAGE%,STUNDEN%,MINUTEN%,SEKUNDEN%Die zu errechnenden Differenzwerte
DECLARE TEMP1$,TEMPSEK1&,TEMPSEK2&,TEMPSEK3&,JAH4%
DECLARE JAH1%,MON1%,TAG1%,STUN1%,MINUT1%,SEKUND1%Einzelteile der früheren Zeit
DECLARE JAH2%,MON2%,TAG2%,STUN2%,MINUT2%,SEKUND2%Einzelteile der späteren Zeit
DECLARE JAH3%,MON3%,TAG3%,STUN3%,MINUT3%,SEKUND3%Einzelteile der Differenz-Zeit
Declare Spaeter&,Frueher&
Declare SCHALTJ%
DEF DToN(1)  !PRFDAT32.DLL,DToN
DEF NToD(1)  !PRFDAT32.DLL,NToD
DEF DOW(1)   !PRFDAT32.DLL,DOW
DEF Day(1)   !PRFDAT32.DLL,Day
DEF Month(1) !PRFDAT32.DLL,Month
DEF Year(1)  !PRFDAT32.DLL,Year
DEF IsLeap%(1) @if(@OR(@AND(@EQU(mod(val($(1)),4),0),@NOT(@EQU(mod(val($(1)),100),0))),@EQU(mod(val($(1)),400),0)),1,0)Schaltjahr?

Proc TIMEDIFF

    Parameters DATE1$,TIME1$,DATE2$,TIME2$
    Let JAHRE%=0
    Let TAGE%=0
    Let STUNDEN%=0
    Let MINUTEN%=0
    Let SEKUNDEN%=0
    Let TEMP1$=0
    Let TEMPSEK1&=0
    Let TEMPSEK2&=0
    Let TEMPSEK3&=0
    Let JAH1%=0
    Let MON1%=0
    Let TAG1%=0
    Let STUN1%=0
    Let MINUT1%=0
    Let SEKUND1%=0
    Let JAH2%=0
    Let MON2%=0
    Let TAG2%=0
    Let STUN2%=0
    Let MINUT2%=0
    Let SEKUND2%=0
    Let JAH3%=0
    Let MON3%=0
    Let TAG3%=0
    Let STUN3%=0
    Let MINUT3%=0
    Let SEKUND3%=0
    Let Spaeter&=0
    Let Frueher&=0
    CASE @EQU$(@upper$(DATE1$),HEUTE) : Let DATE1$=Date$(3)
    CASE @EQU$(@upper$(DATE2$),HEUTE) : Let DATE2$=Date$(3)
    CASE @EQU$(@upper$(TIME1$),JETZT) : Let TIME1$=@ADD$(@Translate$(@Time$(0),:,),@Translate$(@Time$(1),.,))
    CASE @EQU$(@upper$(TIME2$),JETZT) : Let TIME2$=@ADD$(@Translate$(@Time$(0),:,),@Translate$(@Time$(1),.,))

    Proc DIFFUNTERPROC1 Zerlege Zeiten

        Let STUN1% = @VAL(@Left$(TIME1$,2))
        Let MINUT1% = @VAL(@MID$(TIME1$,3,2))
        Let SEKUND1% = @VAL(@RIGHT$(TIME1$,2))
        Let STUN2% = @VAL(@Left$(TIME2$,2))
        Let MINUT2% = @VAL(@MID$(TIME2$,3,2))
        Let SEKUND2% = @VAL(@RIGHT$(TIME2$,2))

    EndProc

    Proc DIFFUNTERPROC2 Zeiten umdrehen

        Let TEMP1$=TIME1$
        Let TIME1$=TIME2$
        Let TIME2$=TEMP1$

    EndProc

    Proc DIFFUNTERPROC3 berechne Zeitunterschied

        Let STUNDEN%=@INT(@DIV&(TEMPSEK3&,3600))
        Let MINUTEN%=@INT(@DIV&(@SUB(TEMPSEK3&,@MUL(STUNDEN%,3600)),60))
        Let SEKUNDEN%=@INT(@SUB(@SUB(TEMPSEK3&,@MUL(STUNDEN%,3600)),@MUL(MINUTEN%,60)))

        If @Gt(STUNDEN%,23)Stundenüberlauf

            Let TAGE%=@DIV&(STUNDEN%,24)
            Let STUNDEN%=@SUB(STUNDEN%,@MUL(TAGE%,24))

        EndIf

    EndProc

    Proc DIFFUNTERPROC4 Datümer umdrehen

        Let TEMP1$=DATE1$
        Let DATE1$=DATE2$
        Let DATE2$=TEMP1$

    EndProc

    Proc DIFFUNTERPROC5 Strings zerlegen:

        Let JAH1% = @VAL(@Left$(DATE1$,4))
        Let MON1% = @VAL(@MID$(DATE1$,5,2))
        Let TAG1% = @VAL(@MID$(DATE1$,7,2))
        Let JAH2% = @VAL(@Left$(DATE2$,4))
        Let MON2% = @VAL(@MID$(DATE2$,5,2))
        Let TAG2% = @VAL(@MID$(DATE2$,7,2))

    EndProc

    Let TIME1$=@Left$(TIME1$,6)Hundertstel Sek. kürzen
    Let TIME2$=@Left$(TIME2$,6)Hundertstel Sek. kürzen
    Früheres Datum immer auf DATE1$:

    If @Lt(@Val(DATE2$),@Val(DATE1$))

        DIFFUNTERPROC4 Datümer umdrehen
        DIFFUNTERPROC2 Zeiten umdrehen

    EndIf

    DIFFUNTERPROC5 Strings zerlegen
    DIFFUNTERPROC1 Zerlege Zeiten
    Print JAH1%,MON1%,TAG1%,STUN1%,MINUT1%,SEKUND1%,   = ,DToC$(Str$(NToD(DToN(Val(DATE1$)))))
    Print
    Print JAH2%,MON2%,TAG2%,STUN2%,MINUT2%,SEKUND2%,   = ,DToC$(Str$(NToD(DToN(Val(DATE2$)))))
    Print

    If @EQU$(DATE1$,DATE2$)Wenn Datum gleich, nur Uhrzeit auswerten:

        If @Lt(@Val(TIME2$),@Val(TIME1$))Wär ja dann möglich

            DIFFUNTERPROC2 Zeiten umdrehen
            DIFFUNTERPROC1 Zerlege Zeiten

        EndIf

        TIME1$ als Gesamtzahl ist jetzt immer kleiner, Minuswerte werden ausgeschlossen, bei Stunden dürfte es keine Probs mehr geben
        TIME1 in Sek umrechnen:
        Let TEMPSEK1&=@ADD(@ADD(@MUL(STUN1%,3600),@MUL(MINUT1%,60)),SEKUND1%)
        TIME2 in Sek umrechnen:
        Let TEMPSEK2&=@ADD(@ADD(@MUL(STUN2%,3600),@MUL(MINUT2%,60)),SEKUND2%)
        Let TEMPSEK3&=@SUB(TEMPSEK2&,TEMPSEK1&)
        Let JAHRE%=0
        Let TAGE%=0
        DIFFUNTERPROC3 berechne Zeitunterschied
        Else =Wenn Datum ungleich:
        1. Zeit bis zum Datumswechsel errechnen und Zeit im späteren Tag dazu addieren:
        Let TEMPSEK1&=@ADD(@ADD(@MUL(STUN1%,3600),@MUL(MINUT1%,60)),SEKUND1%)=abgel Sek. im früheren Tag
        Let TEMPSEK2&=@ADD(@ADD(@MUL(STUN2%,3600),@MUL(MINUT2%,60)),SEKUND2%)=abgel Sek. im späteren Tag
        Let TEMPSEK3&=@SUB(86400,TEMPSEK1&)=abzulauf. Sek. im früheren Tag bis zum Datumswechsel
        Let TEMPSEK3&=@Add(TEMPSEK3&,TEMPSEK2&)=alle Sek. Unterschied, ohne die dazw. liegenden ganzen Tage
        Print 1:  ,JAHRE%,Jahr(e)  ,TAGE%,Tag(e)  ,STUNDEN%,Stunde(n)  ,MINUTEN%,Minute(n)  ,SEKUNDEN%,Sekunde(n)
        DIFFUNTERPROC3
        Print 2:  ,JAHRE%,Jahr(e)  ,TAGE%,Tag(e)  ,STUNDEN%,Stunde(n)  ,MINUTEN%,Minute(n)  ,SEKUNDEN%,Sekunde(n)
        2. Datumsunterschied dann auf die Tage anrechnen und einen abziehen:
        Let Spaeter& = DToN(Val(DATE2$))       In internes Formatumwandeln
        Let Frueher& = DToN(Val(DATE1$))       In internes Formatumwandeln
        Print 3:  ,@SUB(Spaeter&,Frueher&)
        Let TAGE%=@ADD(TAGE%,@SUB(@SUB(Spaeter&,Frueher&),1))
        Print 4:  ,JAHRE%,Jahr(e)  ,TAGE%,Tag(e)  ,STUNDEN%,Stunde(n)  ,MINUTEN%,Minute(n)  ,SEKUNDEN%,Sekunde(n)

        If @Gt(TAGE%,364)Jahre extrahieren, Schaltj. erst mal ignorieren

            Let JAHRE%=@DIV&(TAGE%,365)
            Let TAGE%=@SUB(TAGE%,@MUL(JAHRE%,365))

        EndIf

        Print Vor Schaltjahr-Berechnung:  ,JAHRE%,Jahr(e)  ,TAGE%,Tag(e)  ,STUNDEN%,Stunde(n)  ,MINUTEN%,Minute(n)  ,SEKUNDEN%,Sekunde(n)
        Pro beinhaltetes Schaltjahr einen Tag abziehen
        Let JAH4%=@ADD(JAH1%,1)Startjahr und Endjahr selbst nicht miteinbeziehen

        While @Lt(JAH4%,JAH2%)

            if isleap%(JAH4%)  Schaltjahr?

                Print JAH3%,ist ein Schaltjahr
                DEC TAGE% zieh für jedes Schaltjahr einen Tag ab
                INC SCHALTJ%

            else

                Print JAH3%,ist kein Schaltjahr

            endif

            Inc JAH4%

        Wend

        If @Lt(TAGE%,0) Tage-Unterlauf

            DEC JAHRE%
            LET TAGE%=@Add(365,TAGE%)+- gibt -

        EndIf

        Print Nach Schaltjahr-Berechnung:  ,JAHRE%,Jahr(e)  ,TAGE%,Tag(e)  ,STUNDEN%,Stunde(n)  ,MINUTEN%,Minute(n)  ,SEKUNDEN%,Sekunde(n)
        Print Zahl der Schaltjahre:,SCHALTJ%

        If @GT(JAH3%,0)

            CASE @AND(@Lt(MON1%,3),isleap%(JAH1%)) : INC TAGE%wenn älteres Jahr ein Schaltj und Datum vor dem 01.03.
            CASE @AND(@Gt(MON2%,2),isleap%(JAH2%)) : INC TAGE%wenn neueres Jahr ein Schaltj und Datum nach dem 28.02.

        EndIf

    EndIf

    Print Früherer Zeitpunkt : ,DATE1$,TIME1$
    Print Späterer Zeitpunkt : ,DATE2$,TIME2$
    Print ERGEBNIS:
    Print JAHRE%,Jahr(e)  ,TAGE%,Tag(e)
    Print STUNDEN%,Stunde(n)  ,MINUTEN%,Minute(n)  ,SEKUNDEN%,Sekunde(n)
    Print Zeitunterschied.

EndProc

*******************
Tests:
Declare a%
Let a%=1990
Eingabe in JJJJMMTT und ssmmss
TIMEDIFF 16050202,164700,heute,jetzt
WaitInput

While 1

    CLS
    TIMEDIFF 16050202,164700,@ADD$(@Str$(a%),0302),jetzt
    WaitInput
    inc a%

Wend

End