PB/DOS - Date/Time-Functions

[Matthias Hoffmann]

'-------------------------------------------------------------------------------
'
'      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***************************************************************
'*******************************************************************************

------------------