Announcement

Collapse

Maintenance

The forum could be offline for 30-60 minutes in the very near future for maintenance (said 3pm Pacific). I was behind on getting this notice. I do apologize.
See more
See less

PB/DOS - Date/Time-Functions

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • PB/DOS - Date/Time-Functions

    Code:
    '-------------------------------------------------------------------------------
    '
    '      Unit: datetime.pbl
    '     Zweck: Standardisierte Funktion zur Datums- und Zeitverwaltung, die
    '            bisher in den Programmen verstreut benutzt wurden. Teile dieser
    '            Routinen wurden aus der PowerBASIC-'Dateunit' entnommen und
    '            teilweise modifiziert.
    '   Version: 1.07
    '     Stand: 24.02.97
    '   Sprache: PowerBASIC 3.2
    '     Autor: (C) M.Hoffmann, Wedeler Landstr.139, 22559 Hamburg.
    '  Historie:
    '      1.02: Funktion dtFormatDate() zugefügt, Argument für dtNewDate()
    '            LONG statt INT.
    '      1.03: Kommentare überarbeitet; Funktion dtNewTime ergänzt.
    '      1.04: Funktionen dtHour(), dtMinute(), dtSecond() ergänzt.
    '      1.05: Funktion dtValTime%() ergänzt.
    '      1.06: Funktion dtFormatTime$() ergänzt.
    '      1.07: ":" ist immer als Uhrzeit-Trennzeichen zulässig (dtSplitTime())
    '
    ' c: datetime.pbu     13752   1.02.97  13:49   \pgm\pb3\unit 1.02
    ' c: datetime.pbu     13967   7.02.97  14:01   \pgm\pb3\unit 1.03
    ' c: datetime.pbu     14602  20.02.97  20:35   \pgm\pb3\unit 1.04
    ' c: datetime.pbu     14810  21.02.97  21:18   \pgm\pb3\unit 1.05
    ' c: datetime.pbu     15174  23.02.97  22:51   \pgm\pb3\unit 1.06
    ' c: datetime.pbu     15213  24.02.97  18:23   \pgm\pb3\unit 1.07
    '
    ' ┌─────────────────┬──────&#947 2;─────────────────────────&#9 472;──────────────────┐
    ' │dtVersion%       │Liefert die Version dieser Unit zurück             │
    ' ├─────────────────┼──────&#947 2;─────────────────────────&#9 472;──────────────────┤
    ' │dtBetween&       │Liefert Anzahl Tage zwischen zwei Daten            │
    ' │dtDate$          │Liefert aktuelles Datum im landespezifischen Format│
    ' │dtDateEs$        │Alternative zu DtDate                              │
    ' │dtDateEl$        │Alternative zu DtDate                              │
    ' │dtDateFormat%    │Bestimmt oder liefert landesspezifisches Format    │
    ' │dtDateToDays&    │Rechnet Datum in absolute Tageszahl um             │
    ' │dtDay%           │Gibt von einem Datum den Tag zurück                │
    ' │dtDayName$       │Gibt den Namen eines Wochentages zurück            │
    ' │dtDaysInMonth%   │Liefert Anzahl Tage eines Monats zurück            │
    ' │dtDaysToDate$    │Rechnet absolute Tageszahl in Datum um             │
    ' │dtDOSCountryInfo%│Holt landesspezifische Informationen               │
    ' │dtDOW%           │Gibt zu einem Datum den Wochentag zurück           │
    ' │dtDOY%           │Gibt zu einem Datum den Tag des Jahres zurück      │
    ' │dtFormatDate$    │Gibt ein Datum formatiert zurück                   │
    ' │dtLeap%          │Prüft, ob ein Schaltjahr vorliegt                  │
    ' │dtMakeDate$      │Kombiniert Tag,Monat,Jahr zu einem Datumsstring    │
    ' │dtMonth%         │Gibt von einem Datum den Monat zurück              │
    ' │dtMonthName$     │Gibt den Namen eines Monats zurück                 │
    ' │dtNewDate$       │Liefert Datum nach Addition/Subtraktion von x Tag. │
    ' │dtSortDate$      │Gibt ein Datum im sortierbaren Format zurück       │
    ' │dtSplitDate%     │Zerlegt Datumsstring in seine Bestandteile         │
    ' │dtValDate%       │Prüft Gültigkeit eines Datums                      │
    ' │dtYear%          │Gibt von einem Datum das Jahr zurück               │
    ' ├─────────────────┼──────&#947 2;─────────────────────────&#9 472;──────────────────┤
    ' │dtFormatTime$    │Gibt eine Uhrzeit formatiert zurück                │
    ' │dtElapsed&       │Berechnet Anzahl Sekunden zwischen zwei Uhrzeiten  │
    ' │dtHour%          │Gibt von einer Uhrzeit den Stundenteil zurück      │
    ' │dtMakeTime$      │Kombiniert Stunde,Minute,Sekunde zu einem Zeitstrg.│
    ' │dtMinute%        │Gibt von einer Uhrzeit den Minutenteil zurück      │
    ' │dtNewTime$       │Liefert Zeit nach Addition/Subtr. von Sekunden     │
    ' │dtSecond%        │Gibt von einer Uhrzeit den Sekundenteil zurück     │
    ' │dtSplitTime%     │Zerlegt Zeitstring in seine Bestandteile           │
    ' │dtTicks&         │Liefert Anzahl Timerticks seit Mitternacht         │
    ' │dtTime$          │Liefert aktuelle Zeit im landesspezifischen Format │
    ' │dtTime0$         │Alternative zu dtTime                              │
    ' │dtTimeToSeconds  │Rechnet Uhrzeit in Sekunden seit Mitternacht um    │
    ' │dtSecondsToTime  │Rechnet Sekunden seit Mitternacht in Uhrzeit um    │
    ' │dtValTime%       │Prüft Gültigkeit einer Uhrzeitangabe               │
    ' └─────────────────┴──────&#947 2;─────────────────────────&#9 472;──────────────────┘
    
    '---Compiler--------------------------------------------------------------------
    
    $compile  unit
    $cpu      80386
    $debug    map-,pbdebug-,path-,unit-
    $dim      all
    $error    all-
    $event    off
    $float    emulate
    $lib      all-
    $optimize size
    $static
    $option   gosub-,signed-
    
    defint a-z
    
    %Version  = 106
    
    %flags    = 0
    %ax       = 1
    %dx       = 4
    %ds       = 8
    
    '===============================================================================
    ' Datenstrukturen für DOS-Funktion Get Country Info (ab DOS Version 3).
    '
    type CountryInfoType
       DateFormat as word
       CurrSymbol as string*5
       Sep1000    as string*1
       dummy1     as string*1
       SepDecimal as string*1
       dummy2     as string*1
       SepDate    as string*1
       dummy3     as string*1
       SepTime    as string*1
       dummy4     as string*1
       CurrFormat as byte
       SigDigits  as byte
       TimeFormat as byte
       UpcaseProc as dword
       SepList    as string*1
       dummy5     as string*1
       Reserved   as string*10
    end type
    union CountryInfoUnion
       s as CountryInfoType
       b as string*34
    end union
    
    '===============================================================================
    ' Globale Variable, wird einmalig gefüllt für die interne Verwendung
    ' durch verschiedene Unit-Routinen.
    '
    dim CI as shared CountryInfoUnion
    
    '===============================================================================
    ' Unitversion zurückliefern. Programme könnten sich durch eine Prüfung dieser
    ' Version vor späteren Versionsänderungen dieser Unit absichern, in dem sie
    ' bei falscher Version einen Hinweis anzeigen, anstatt stillschweigend
    ' möglicherweise mit falschen Annahmen falsche Ergebnisse zu berechnen.
    '
    function dtVersion local public as integer
       function = %Version
    end function
    
    '===============================================================================
    ' Prüfen, ob angebene Jahreszahl einem SCHALTJAHR entspricht (Ja=1, 0=Nein).
    ' ACHTUNG: Keinerlei Überprüfung der Angabe YEAR! Das Jahr muß VOLL angegeben
    ' werden.
    '
    function dtLeap (byval Year as integer) local public as integer
      if (Year mod 400) = 0 then      ' Durch 400, also AUCH durch 4 teilbar
         function = 1                 ' -> in jedem Falle Ok
      elseif (Year mod 100) = 0 then  ' Volles Jahrhundert, nicht durch 400 teil-
         function = 0                 ' bar ist kein Schaltjahr
      elseif (Year mod 4) = 0 then    ' Durch 4 teilbar ist Schaltjahr (Ausnahme
         function = 1                 ' siehe oben)
      end if
    end function
    
    '===============================================================================
    ' Anzahl TAGE IM MONAT unter Berücksichtigung von Schaltjahren.
    ' 0 = ungültiger Monat/ungültiges Jahr, n = Ok.
    '
    function dtDaysInMonth (byval Month as integer, byval Year as integer)_
                            local public as integer
       dim dadd as local integer
       if Year > 1581 and Year < 3001 then
          dadd = &b1010110101010
                '  DNOSAJJMAMFJ-
          if Month = 2 then
             function = 28+dtLeap(Year)
          elseif Month > 0 and Month < 13 then
             function = 30+bit(dadd,Month)
          end if
       end if
    end function
    
    '===============================================================================
    ' Holt landesspezifische Informationen über die DOS-Funktion 38h.
    ' 0 = Fehler, 1 = Ok.
    '
    function dtDOSCountryInfo (buf as string) local public as integer
       dim dosver as local byte
       ! mov ax,&h3306 ; Get TRUE DOS Version
       ! int &h21      ;
       ! cmp ax,&h3306 ; zeigt Ok an
       ! mov dosver,bl ;
       ! jz dtDOSCountryInfoL1
       ! mov ah,&h30   ; Get DOS Version
       ! int &h21      ;
       ! mov dosver,al ;
      dtDOSCountryInfoL1:
       if dosver < 3 then
          exit function
       end if
       buf = string$(34,47)
       reg %ax,&h3800
       reg %ds,strseg(buf)
       reg %dx,strptr(buf)
       call interrupt &h21
       function = reg(%flags) xor 1
    end function
    
    '===============================================================================
    ' Ermittelt das Standard-Datumsformat anhand der DOS-Funktion 38h,
    ' oder setzt optional eine neues Standardformat. Liefert das Format VOR
    ' einer Änderung zurück.
    '   1 = USA    mm-dd-yyyy
    '   2 = Europa dd-mm-yyyy
    '   3 = Japan  yyyy-mm-dd
    '  Das Format wird intern nur einmalig ermittelt.
    '
    function dtDateFormat (byval NewFormat as integer) local public as integer
       dim df as static integer
       dim t  as local  string
       if df = 0 then
          if dtDOSCountryInfo(t) then
             CI.b = t
             df = CI.s.DateFormat+1
          else ' wenn DOS-Funktion scheitert, ist MM/DD/YYYY Vorgabe
             df = 1
          end if
       end if
       function = df
       if newFormat > 0 and newFormat < 4 then
          df = newFormat
       end if
    end function
    
    '===============================================================================
    ' Liefert das AKTUELLE Datum unter Kenntnis des System-Datumsformats zurück
    ' (jeweils mit führenden Nullen).
    '
    function dtDate local public as string
       dim df as local integer
       df = dtDateFormat(0)
       if df = 1 then
          ' würde man das Separatorformat ignorieren, genügte 'function = DATE$'
          function = mid$(DATE$,1,2)+CI.s.SepDate+mid$(DATE$,4,2)+CI.s.SepDate+mid$(DATE$,7,4)
       elseif df = 2 then
          function = mid$(DATE$,4,2)+CI.s.SepDate+mid$(DATE$,1,2)+CI.s.SepDate+mid$(DATE$,7,4)
       elseif df = 3 then
          function = mid$(DATE$,7,4)+CI.s.SepDate+mid$(DATE$,1,2)+CI.s.SepDate+mid$(DATE$,4,2)
       end if
    end function
    
    '===============================================================================
    ' Schnelle Alternative zu dtDate. Liefert immer im Format tt.mm.jj.
    ' Sollte nur in Ausnahmefällen benutzt werden.
    '
    function dtDateEs local public as string
       function = mid$(DATE$,4,2)+"."+mid$(DATE$,1,2)+"."+mid$(DATE$,9,4)
    end function
    
    '===============================================================================
    ' Schnelle Alternative zu dtDate. Liefert immer im Format tt.mm.jjjj.
    ' Sollte nur in Ausnahmefällen benutzt werden.
    '
    function dtDateEl local public as string
       function = mid$(DATE$,4,2)+"."+mid$(DATE$,1,2)+"."+mid$(DATE$,7,4)
    end function
    
    '===============================================================================
    ' Zerlegt ein gegebenes Datum (im aktuellen Datumsformat). Führende Nullen
    ' können i.G. zum Standardformat fehlen. Wird kein Datum übergeben, gilt das
    ' aktuelle Datum.
    ' 0 = Datum ungültig, 1 = Ok.
    '
    function dtSplitDate (InDate as string,  Day as integer, Month as integer,_
                          Year as integer) local public as integer
       dim df as local integer
       dim p1 as local integer
       dim p2 as local integer
       dim t  as local string
       df = dtDateFormat(0) ' sicherstellen, das Struktur geladen ist
       if len(inDate) = 0 then
          t = dtDate
       else
          t = InDate
          if len(t) < 6 or len(t) > 10 then ' 1.1.jj bis 31.12.jjjj
             exit function
          end if
       end if
       p1 = instr(     t,CI.s.SepDate)
       p2 = instr(p1+1,t,CI.s.SepDate)
       if p1 = 0 or p2 = 0 then
          exit function
       end if
       incr p1: incr p2
       if df = 1 then
          Day   = val(mid$(t,p1,p2-p1-1))
          Month = val(mid$(t, 1,p1-1))
          Year  = val(mid$(t,p2,4))
       elseif df = 2 then
          Day   = val(mid$(t, 1,p1-1))
          Month = val(mid$(t,p1,p2-p1-1))
          Year  = val(mid$(t,p2,4))
       elseif df = 3 then
          Day   = val(mid$(t,p2,2))
          Month = val(mid$(t,p1,p2-p1-1))
          Year  = val(mid$(t, 1,p1-1))
       end if
       if Year < 100 then
          incr Year,val(mid$(DATE$,7,2)+"00")
       end if
       if Year > 1581 and Year < 3001 then
          if Month > 0 and Month < 13 then
             if Day > 0 and Day <= dtDaysInMonth(Month,Year) then
                function = 1
             end if
          end if
       end if
    end function
    
    '===============================================================================
    ' Kombiniert Tag, Monat und Jahr zu einer Datumsangabe im aktuellen Format
    ' (jeweils mit führenden Nullen). Ungültige Werte liefern Leerstring.
    '
    function dtMakeDate (byval Day as integer, byval Month as integer,_
                         byval Year as integer) local public as string
       dim t  as local string
       dim df as local integer
       df = dtDateFormat(0) ' sicherstellen, das Struktur geladen ist
       if Year < 100 then
          incr Year,val(mid$(DATE$,7,2)+"00")
       end if
       if df = 1 then
          t = right$(str$(Month),2) + CI.s.SepDate + _
              right$(str$(Day)  ,2) + CI.s.SepDate + _
              right$(str$(Year) ,4)
       elseif df = 2 then
          t = right$(str$(Day)  ,2) + CI.s.SepDate + _
              right$(str$(Month),2) + CI.s.SepDate + _
              right$(str$(Year) ,4)
       elseif df = 3 then
          t = right$(str$(Year) ,4) + CI.s.SepDate + _
              right$(str$(Month),2) + CI.s.SepDate + _
              right$(str$(Day)  ,2)
       end if
       replace " " with "0" in t
       if dtSplitDate(t,0,0,0) then
          function = t
       end if
    end function
    
    '===============================================================================
    ' Validiert das angegebene Datum und bedient sich dabei SPLITDATE.
    ' (Der Programmierer erspart sich die Angabe von Dummy-Parametern.)
    ' 0 = ungültig, 1 = Ok.
    '
    function dtValDate (inDate as string) local public as integer
       function = dtSplitDate(inDate,0,0,0)
    end function
    
    '===============================================================================
    ' Liefern Tag, Monat, Jahr des angegebenen/aktuellen Datums zurück.
    ' 0 = Fehler, n = Ok.
    function dtDay (inDate as string) local public as integer
       dim Day as local integer
       if dtSplitDate(inDate,Day,0,0) then
          function = Day
       end if
    end function
    function dtMonth (inDate as string) local public as integer
       dim Month as local integer
       if dtSplitDate(inDate,0,Month,0) then
          function = Month
       end if
    end function
    function dtYear (inDate as string) local public as integer
       dim Year as local integer
       if dtSplitDate(inDate,0,0,Year) then
          function = Year
       end if
    end function
    
    '===============================================================================
    ' Liefert das im Standardformat angegebene Datum im sortierbaren Format zurück.
    ' Wird kein Datum übergeben, wird das aktuelle Datum angenommen.
    ' Bei ungültigem Datum wird ein Leerstring zurückgegeben.
    '
    function dtSortDate (inDate as string) local public as string
       dim Day   as local integer
       dim Month as local integer
       dim Year  as local integer
       dim t     as local string
       if dtSplitDate(inDate,Day,Month,Year) then
          t = right$(str$(Year), 4)+right$(str$(Month),2)+right$(str$(Day),2)
          replace " " with "0" in t
          function = t
       end if
    end function
    
    '===============================================================================
    ' Liefert das Datum standardisiert zurück.
    ' Bei ungültigem Datum wird ein Leerstring zurückgegeben.
    ' Diese Konstruktion wäre durch dtNewDate(inDate,0) ersetzbar, jedoch würden
    ' dadurch die zeitintensiven Routinen dtDateToDays/DaysToDate involviert.
    '
    function dtFormatDate (inDate as string) local public as string
       dim Day   as local integer
       dim Month as local integer
       dim Year  as local integer
       if dtSplitDate(inDate,Day,Month,Year) then
          function = dtMakeDate(Day,Month,Year)
       end if
    end function
    
    '===============================================================================
    ' Umrechnen einer Datumsangabe im Standardformat in eine ABSOLUTE TAGESZAHL
    ' relativ zum 1.1.1582 (=577813). 0 = Fehler aufgetreten, n = Ok.
    '
    function dtDateToDays (inDate as string) local public as long
       ' Grundlagen dieser Routine aus:
       '  Standard Software Modul TI-58/58C/59 (C) Texas Instruments 1977,1979
      dim Month as local integer
      dim Day   as local integer
      dim Year  as local integer
      dim y     as local integer
      dim m     as local integer
      dim t     as local long
      if dtSplitDate(inDate,Day,Month,Year) = 0 then
         exit function ' 0 -> Fehler!
      end if
      m = Month-1
      if Month < 3 then
         y = Year-1
         function = 365*Year+day+31*m                +y\4   -y\100   +y\400
      else
         function = 365*Year+day+31*m-(Month*4+23)\10+Year\4-Year\100+Year\400
      end if
      ' Umrechung durch decr 577813& lohnt nicht, da sowieso LONG erforderlich.
      ' es sei denn, man schränkte den Zeitraum stark ein.
      ' (Die Formel (Month*4+23)\10 errechnet die Differenz zischen MONATx31 und
      ' den tatsächlichen Tagen, da ja einige Monate nur 30 Tage haben.)
    end function
    
    '===============================================================================
    ' Umrechnen einer absoluten Tageszahl in ein Datum.
    '
    function dtDaysToDate(byval numdays as long) local public as string
       ' Übergabe BYVAL ist auch bei LONGs schneller
       dim Month      as local integer
       dim Year       as local integer
       dim DaysInMnth as local integer
       dim l          as local integer
       Year = fix(numdays/365.2425)
       ' Der Ausdruck 'numdays*400\146097' ist gleichbedeutend und sieht irgendwie
       ' eleganter aus, erzeugt aber etwas mehr Code und ist seltsamerweise slower.
       l = dtLeap(Year)
       decr numdays,dtDateToDays(dtMakeDate(1,1,Year))+l-1
       if numdays = 366 then
          month = 1
          numdays = 1
          incr Year
          goto dtDaysToDateSkip
       elseif l then
          incr numdays
       end if
       for Month = 1 to 12
          DaysInMnth = dtDaysInMonth(Month,Year)
          if NumDays <= DaysInMnth then
             exit for
          end if
          decr NumDays, DaysInMnth
       next
       if NumDays = 0 then
          Month = 12
          NumDays = 31
          decr Year
       end if
    dtDaysToDateSkip:
       function = dtMakeDate(NumDays,Month,Year)
    end function
    
    '===========================================================================
    ' Gibt zu einem gegebenen Datum den WOCHENTAG als Ziffer zurück, 1=Samstag
    ' bis 7=Freitag. 0 = Fehler.
    '
    function dtDOW(InDate as string) local public as integer
      dim t as local long
      t = dtDateToDays(InDate)
      if t then
         function = t mod 7 + 1
      end if
    end function
    
    '===========================================================================
    ' Gibt zu einer Tagesziffer von 1=Samstag bis 7=Freitag den NAMEN zurück
    ' "" = Fehler.
    
    function dtDayName(byval DOW as integer) local public as string
      dim t as string
      if DOW > 0 and DOW < 8 then
         t = "Samstag   Sonntag   Montag    Dienstag  Mittwoch  DonnerstagFreitag"
         function = rtrim$(mid$(t,(DOW-1)*10+1,10))
      end if
    end function
    
    '===========================================================================
    ' Gibt zu einer Monatszahl den NAMEN zurück, Leerstring = Fehler.
    '
    function dtMonthName(byval Month as integer) local public as string
      dim t as string
      if Month > 0 and Month < 13 then
         t = "Januar   Februar  März     April    Mai      Juni     Juli     August   "+_
             "SeptemberOktober  November Dezember"
         function = rtrim$(mid$(t,(Month-1)*9+1,9))
      end if
    end function
    
    '===========================================================================
    ' Berechnet aus dem angegeben Datum den TAG SEIT JAHRESBEGINN als Zahl
    ' 0 = Fehler. n = Ok.
    '
    function dtDOY(InDate as string) local public as integer
       dim Month as local integer
       dim Day   as local integer
       dim Year  as local integer
       if dtSplitDate(InDate,Day,Month,Year) then
          if Month < 3 then
             function = Day+31*(Month-1)
          else
             function = Day+31*(Month-1)-(Month*4+23)\10+dtleap(Year)
          end if
       end if
    end function
    
    '===========================================================================
    ' Neues Datum nach Addition/Subtraktion von Tagen. Fehlt das Datum, wird das
    ' aktuelle Datum angenommen.
    '
    function dtNewDate (inDate as string, byval dif as long) local public as string
       function = dtDaysToDate(dtDateToDays(InDate)+Dif)
    end function
    
    '===========================================================================
    ' Berechnet die Anzahl von Tagen zwischen zwei Daten.
    '
    function dtBetween (Date1 as string, Date2 as string) local public as long
       function = abs(dtDateToDays(Date2)-dtDateToDays(Date1))
    end function
    
    '- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    
    '===============================================================================
    ' Liefert die aktuelle Uhrzeit im gültigen Systemformat zurück (jeweils mit
    ' führenden Nullen). Ist das übergebene Argument <> 0, werden auch die
    ' Sekunden ausgegeben.
    ' Ist aufgrund der Logik wesentlich langsamer als TIME$, welches ebenfalls
    ' immer im 24-Stundenformat und mit ':'-Trennzeichen zurückliefert
    ' (Merkwürdigerweise ist der deutsche TimeSep '.', und nicht ':').
    '
    function dtTime (byval ShowSecs as integer) local public as string
       dim t as local string
       dim h as local integer
       dim s as local string
       dim z as local string
       dtDateFormat 0 ' sicherstellen, das Struktur geladen ist
       z = TIME$
       ' CI.s.TimeFormat = 0 ' DEBUG
       if CI.s.TimeFormat = 0 then
          h = val(mid$(z,1,2))
          s = "a"
          if h > 12 then
             decr h,12
             s = "p"
          end if
          t = str$(h)+CI.s.SepDate+mid$(z,4,2)
          replace " " with "0" in t
          if ShowSecs then
             t = t+CI.s.SepTime+mid$(z,7,2)
          end if
          function = t+s
       elseif CI.s.TimeFormat = 1 then
          t = mid$(z,1,2)+CI.s.SepTime+mid$(z,4,2)
          if ShowSecs then
             t = t+CI.s.SepTime+mid$(z,7,2)
          end if
          function = t
       end if
    end function
    
    '===============================================================================
    ' Schnellere Alternative zu dtTime(0), liefert immer 'hh:mm' im 24Stundenformat.
    ' Anstelle von dtTime(1) kann man TIME$ benutzen.
    ' Sollte nur in Ausnahmefällen benutzt werden.
    '
    function dtTime0 local public as string
       function = left$(time$,5)
    end function
    
    '===============================================================================
    ' Zerlegt eine gegebene Zeit (im aktuellen Datumsformat). Führende Nullen
    ' können i.G. zum Standardformat fehlen. Wird keine Zeit übergeben, gilt die
    ' aktuelle Uhrzeit. ACHTUNG: Liefert Stunden IMMER im 24-Stunden-format!
    ' Die Sekundenangabe kann fehlen. Die Trennzeichen richten sich nach dem
    ' Landesformat; ":" ist jedoch immer gültig.
    ' 0 = Uhrzeit ungültig, 1 = Ok.
    '
    function dtSplitTime (InTime as string, Hours as integer, Minutes as integer,_
                          Seconds as integer) local public as integer
       dim p1 as local integer
       dim p2 as local integer
       dim t  as local string
       dtDateFormat 0  ' sicherstellen, das Struktur geladen ist
       if len(inTime) = 0 then
          t = dtTime(1)
       else
          t = InTime
          if len(t) < 5 or len(t) > 9 then
             exit function
          end if
       end if
       p1 = instr(     t,any CI.s.SepTime+":")
       p2 = instr(p1+1,t,any CI.s.SepTime+":")
       if p1 = 0 then
          exit function
       end if
       if p2=0 then
          p2=len(t)+1
       end if
       incr p1: incr p2
       Hours   = val(mid$(t, 1,p1-1))
       Minutes = val(mid$(t,p1,p2-p1-1))
       if p2 then
          Seconds = val(mid$(t,p2,4))
       end if
       if CI.s.TimeFormat = 0 then
          if instr(right$(inTime,1), any "pP") then
             incr Hours,12
          end if
       end if
       if Hours => 0 and Hours < 24 then
          if Minutes => 0 and Minutes < 60 then
             if Seconds => 0 and Seconds < 60 then
                function = 1
             end if
          end if
       end if
    end function
    
    '===============================================================================
    ' Kombiniert Stunde, Minute und Sekunde zu einer Datumsangabe im aktuellen
    ' Format (jeweils mit führenden Nullen). Ungültige Werte liefern Leerstring.
    ' Wird für Sekunden -1 übergeben, werden diese nicht zurückgegeben.
    ' ACHTUNG: Die Stunden müssen immer im 24-Stunden-Format angegeben werden!
    '
    function dtMakeTime (byval Hours as integer, byval Minutes as integer,_
                         byval Seconds as integer) local public as string
       dim t as local string
       dim s as local string
       dim h as local integer
       dtDateFormat 0  ' sicherstellen, das Struktur geladen ist
       if CI.s.TimeFormat = 0 then
          h = Hours
          s = "a"
          if h > 12 then
             decr h,12
             s = "p"
          end if
          t = right$(str$(h),2)
       else
          t = right$(str$(Hours),2)
       end if
       t = t+CI.s.SepTime+right$(str$(Minutes),2)
       if seconds <> -1 then
          t = t+CI.s.SepTime+right$(str$(Seconds),2)
       end if
       replace " " with "0" in t
       t = t+s
       if dtSplitTime(t,0,0,0) then
          function = t
       end if
    end function
    
    '===========================================================================
    ' Berechnet für übergebene Zeit die Anzahl von Sekunden seit Mitternacht.
    ' -1 Uhrzeit ungültig, n = Ok.
    '
    function dtTimeToSeconds (InTime as string) local public as long
       dim Hour   as local integer
       dim Minute as local integer
       dim Second as local integer
       if dtSplitTime(InTime,Hour,Minute,Second) then
          function = Hour*3600+Minute*60+Second
       else
          function = -1
       end if
    end function
    
    '===========================================================================
    ' Rechnet eine Sekunden- in eine Uhrzeitangabe im Systemformat um.
    '
    function dtSecondsToTime (byval Secs as long) local public as string
       dim Hour   as local integer
       dim Minute as local integer
       dim Second as local integer
       Hour   = Secs \ 3600
       Minute = (Secs mod 3600) \ 60
       Second = (Secs mod 3600) mod 60
       function = dtMakeTime(Hour, Minute, Second)
    end function
    
    '===========================================================================
    ' Berechnet die Anzahl von Sekunden zwischen zwei Zeiten. Wenn die zweite
    ' Zeit früher als die erste ist, wird von EINEM Mitternachtsdurchgang
    ' ausgegangen (mehrere werden nicht erkannt, da Datumsangaben fehlen).
    ' -1 Uhrzeit ungültig, n = Ok.
    '
    function dtElapsed(time1 as string, time2 as string) local public as long
       dim t1 as local long
       dim t2 as local long
       t1 = dtTimeToSeconds(time1)
       t2 = dtTimeToSeconds(Time2)
       if t2 < t1 then ' neuer Tag
          incr t2,86400&
       end if
       function = t2-t1
    end function
    
    '===========================================================================
    ' Liefert Anzahl BIOS-Timerticks seit Mitternacht.
    '
    function dtTicks local public as long
       dim p as local long ptr
       p = 1132
       function = @p
    end function
    
    '===========================================================================
    ' Neue Zeit nach Addition/Subtraktion von Sekunden. Fehlt die Zeit, wird die
    ' aktuelle Zeit zugrundegelegt.
    '
    function dtNewTime (inTime as string, byval dif as long) local public as string
       function = dtSecondsToTime(dtTimeToSeconds(InTime)+Dif)
    end function
    
    '===============================================================================
    ' Liefern Stunde, Minute, Sekunde der angegebenen/aktuellen Zeit zurück.
    ' 0 = Fehler, n = Ok.
    function dtHour (inTime as string) local public as integer
       dim Hour as local integer
       if dtSplitTime(inTime,Hour,0,0) then
          function = Hour
       end if
    end function
    function dtMinute (inTime as string) local public as integer
       dim Minute as local integer
       if dtSplitTime(inTime,0,Minute,0) then
          function = Minute
       end if
    end function
    function dtSecond (inTime as string) local public as integer
       dim Second as local integer
       if dtSplitTime(inTime,0,0,Second) then
          function = Second
       end if
    end function
    
    '===============================================================================
    ' Validiert die angegebene Uhrzeit und bedient sich dabei SPLITTIME.
    ' (Der Programmierer erspart sich die Angabe von Dummy-Parametern.)
    ' 0 = ungültig, 1 = Ok.
    '
    function dtValTime (inTime as string) local public as integer
       function = dtSplitTime(inTime,0,0,0)
    end function
    
    '===============================================================================
    ' Liefert die Uhrzeit im Standardformat, inkl. Sekunden, zurück.
    ' Bei ungültiger Eingabezeit wird ein Leerstring zurückgegeben.
    ' Diese Konstruktion ist eine Kurzform von dtNewTime(inTime,0).
    '
    function dtFormatTime (inTime as string) local public as string
       dim Hour   as local integer
       dim Minute as local integer
       dim Second as local integer
       if dtSplitTime(inTime,Hour,Minute,Second) then
          function = dtMakeTime(Hour,Minute,Second)
       end if
    end function
    
    '***Ende der Unit***************************************************************
    '*******************************************************************************
    ------------------
Working...
X