PureBoard

Das deutsche PureBasic-Forum
https://www.purebasic.fr/german/

Date()-Funktionen mit Millisekunden-Präzision [Win only]

https://www.purebasic.fr/german/viewtopic.php?t=30340

Seite 1 von 1

Date()-Funktionen mit Millisekunden-Präzision [Win only]

Verfasst: 28.08.2017 18:41
von PureLust
Hi, .... da ja nicht jeder hier das englische Forum verfolgt, poste ich hier auch mal meine kleine Funktionssammlung für hochpräzise Date()-Funktionen:

Ich brauchte ein paar TimeStamp-Funktionen mit Millisekunden-Präzision und hab dazu mal ein paar Funktionen gebastelt.

Die Vorteile gegenüber den vorhandenen Funktionen, die auf das Date()-Format von PB aufsetzen, sind:
- Millisekunden Präzision
- Jahreszahlen < 1970 und >2037 werden unterstützt
- zusätzliche Funktionen zur Ermittlung des Wochentags (Sonntag, Montag, ... sowie So, Mo, ...)
- unterstützt zusätzliche Tokens in msFormatDate() - %ms = Millisekunden, %wday = Wochentag (ausgeschrieben), %wd = Wochentag (abkürzung)

Enthaltene Funktionen (Beschreibung hab ich jetzt nicht aus dem Englischen übersetzt ... sorry):

Code: Alles auswählen

msDate([Year, Month, Day, Hour, Minute, Second, Millisecond])  -  returns the Millisecond-TimeStamp for the actual or the given date/time   -  equivalent To PBs Date()
	
msYear(msDate)           - returns the Year        of the given msDate()-TimeStamp   -  equivalent To PBs Year(Date)
msMonth(msDate)          - returns the Month       of the given msDate()-TimeStamp   -  equivalent To PBs Month(Date)
msDay(msDate)            - returns the Day         of the given msDate()-TimeStamp   -  equivalent To PBs Day(Date)
msHour(msDate)           - returns the Hour        of the given msDate()-TimeStamp   -  equivalent To PBs Hour(Date)
msMinute(msDate)         - returns the Minute      of the given msDate()-TimeStamp   -  equivalent To PBs Minute(Date)
msSecond(msDate)         - returns the Second      of the given msDate()-TimeStamp   -  equivalent To PBs Second(Date)
msMilliSeconds(msDate)   - returns the Millisecond of the given msDate()-TimeStamp

msDate_to_Date(msDate)         - konverts msDate()-TimeStamp into   Date()-Format
Date_to_msDate(Date)           - converts   Date()-Format    into msDate()-TimeStamp

msDayOfWeek(msDate)            - returns Day of the Week   -  equivalent To PBs DayOfWeek(Date)
msDayOfYear(msDate)            - returns Day of the Year   -  equivalent To PBs DayOfYear(Date)

msWeekday(msDate)              - returns the Weekday in short form (first 3 characters - e.g. Sun, Mon, Thu, ...)
msWeekdayLong(msDate)          - returns the Weekday in long  form (e.g. Sunday, Monday, Thuesday, ...)
msWeekdayGER(msDate)           - returns short Weekday in german language (first 2 characters - e.g. So, Mo, Di, ...)
msWeekdayGERLong(msDate)       - returns long  Weekday in german language (e.g. Sonntag, Montag, Dienstag, ...)

msFormatDate(Mask$, msDate)    - equivalent To PBs FormatDate(), but With additional Tokens:
                                 %ms    - milliseconds With 3 digits
                                 %wday  - Weekday  (long  Version)
                                 %wd    - Weekday  (short Version)
Code:

Code: Alles auswählen

Enumeration    msDate_Parts
   #msDate_MilliSeconds
   #msDate_Seconds
   #msDate_Minutes
   #msDate_Hours
   #msDate_Day
   #msDate_Month
   #msDate_Year
EndEnumeration

CompilerIf   #False   ; Procedure msDate()
   Procedure.q msDate([Year, Month, Day, Hour, Minute, Second, Millisecond])            ; Dummy-Declaration to get a better Help-Text in Status-Line for this Procedure
CompilerElse   ;}
   Procedure.q msDate(_Year=#PB_Ignore, _Month=#PB_Ignore, _Day=#PB_Ignore, _Hour=#PB_Ignore, _Minute=#PB_Ignore, _Second=#PB_Ignore, _MilliSecond=#PB_Ignore)
CompilerEndIf

   Protected d.SYSTEMTIME
   GetLocalTime_(@d)
   
   Protected mMilliseconds   =   1
   Protected mSecond         =   mMilliseconds   * 1000
   Protected mMinute         =   mSecond         * 60
   Protected mHour           =   mMinute         * 60
   Protected mDay            =   mHour           * 24
   Protected mMonth          =   mDay            * 32
   Protected mYear           =   mMonth          * 13
   
   Protected msTimeSTamp
   
   If _Year          = #PB_Ignore   : msTimeSTamp   +   d\wYear           * mYear    : Else : msTimeSTamp   +   _Year          * mYear    : EndIf
   If _Month         = #PB_Ignore   : msTimeSTamp   +   d\wMonth          * mMonth   : Else : msTimeSTamp   +   _Month         * mMonth   : EndIf
   If _Day           = #PB_Ignore   : msTimeSTamp   +   d\wDay            * mDay     : Else : msTimeSTamp   +   _Day           * mDay     : EndIf
   If _Hour          = #PB_Ignore   : msTimeSTamp   +   d\wHour           * mHour    : Else : msTimeSTamp   +   _Hour          * mHour    : EndIf
   If _Minute        = #PB_Ignore   : msTimeSTamp   +   d\wMinute         * mMinute  : Else : msTimeSTamp   +   _Minute        * mMinute  : EndIf
   If _Second        = #PB_Ignore   : msTimeSTamp   +   d\wSecond         * mSecond  : Else : msTimeSTamp   +   _Second        * mSecond  : EndIf
   If _MilliSecond   = #PB_Ignore   : msTimeSTamp   +   d\wMilliseconds              : Else : msTimeSTamp   +   _MilliSecond              : EndIf
   
   ProcedureReturn msTimeSTamp
   
EndProcedure
Procedure   GetmsDatePart(msDate.q, msDate_Part)
   
   Protected mMilliseconds   =   1
   Protected mSecond         =   mMilliseconds   * 1000
   Protected mMinute         =   mSecond         * 60
   Protected mHour           =   mMinute         * 60
   Protected mDay            =   mHour           * 24
   Protected mMonth          =   mDay            * 32
   Protected mYear           =   mMonth          * 13
   
   Protected TimeStamp       =   msDate
   
   Protected _Year           =   Int(TimeStamp   / mYear)     : TimeStamp - mYear        * _Year      : If msDate_Part   = #msDate_Year          : ProcedureReturn _Year          : EndIf
   Protected _Month          =   Int(TimeStamp   / mMonth)    : TimeStamp - mMonth       * _Month     : If msDate_Part   = #msDate_Month         : ProcedureReturn _Month         : EndIf
   Protected _Day            =   Int(TimeStamp   / mDay)      : TimeStamp - mDay         * _Day       : If msDate_Part   = #msDate_Day           : ProcedureReturn _Day           : EndIf
   Protected _Hour           =   Int(TimeStamp   / mHour)     : TimeStamp - mHour        * _Hour      : If msDate_Part   = #msDate_Hours         : ProcedureReturn _Hour          : EndIf
   Protected _Minute         =   Int(TimeStamp   / mMinute)   : TimeStamp - mMinute      * _Minute    : If msDate_Part   = #msDate_Minutes       : ProcedureReturn _Minute        : EndIf
   Protected _Second         =   Int(TimeStamp   / mSecond)   : TimeStamp - mSecond      * _Second    : If msDate_Part   = #msDate_Seconds       : ProcedureReturn _Second        : EndIf
   Protected _MilliSeconds   =   TimeStamp                                                            : If msDate_Part   = #msDate_MilliSeconds  : ProcedureReturn _MilliSeconds  : EndIf
   
EndProcedure

Procedure     msMilliSeconds(msDate.q)    :   ProcedureReturn GetmsDatePart(msDate, #msDate_MilliSeconds)    : EndProcedure
Procedure     msSecond(msDate.q)          :   ProcedureReturn GetmsDatePart(msDate, #msDate_Seconds)         : EndProcedure
Procedure     msMinute(msDate.q)          :   ProcedureReturn GetmsDatePart(msDate, #msDate_Minutes)         : EndProcedure
Procedure     msHour(msDate.q)            :   ProcedureReturn GetmsDatePart(msDate, #msDate_Hours)           : EndProcedure
Procedure     msDay(msDate.q)             :   ProcedureReturn GetmsDatePart(msDate, #msDate_Day)             : EndProcedure
Procedure     msMonth(msDate.q)           :   ProcedureReturn GetmsDatePart(msDate, #msDate_Month)           : EndProcedure
Procedure     msYear(msDate.q)            :   ProcedureReturn GetmsDatePart(msDate, #msDate_Year)            : EndProcedure

Procedure     msDate_to_Date(msDate.q)    :   ProcedureReturn Date(msYear(msDate) , msMonth(msDate)  , msDay(msDate)   , msHour(msDate)  , msMinute(msDate)  , msSecond(msDate))  : EndProcedure
Procedure.q   Date_to_msDate(Date)        :   ProcedureReturn msDate(Year(Date)   , Month(Date)      , Day(Date)       , Hour(Date)      , Minute(Date)      , Second(Date))      : EndProcedure

Procedure     msDayOfWeek(msDate.q)       :   ProcedureReturn DayOfWeek(msDate_to_Date(msDate))                                                        : EndProcedure     ; only supports years >= 1970 and <= 2037
Procedure     msDayOfYear(msDate.q)       :   ProcedureReturn DayOfYear(msDate_to_Date(msDate))                                                        : EndProcedure     ; only supports years >= 1970 and <= 2037
Procedure.s   msWeekdayLong(msDate.q)     :   ProcedureReturn StringField("Sun|Mon|Tues|Wednes|Thurs|Fri|Satur", msDayOfWeek(msDate.q)+1, "|")+"day"   : EndProcedure     ; only supports years >= 1970 and <= 2037
Procedure.s   msWeekday(msDate.q)         :   ProcedureReturn Left(msWeekdayLong(msDate),3)                                                            : EndProcedure     ; only supports years >= 1970 and <= 2037
Procedure.s   msWeekdayGERLong(msDate.q)  :   ProcedureReturn StringField("Sonntag|Montag|Dienstag|Mittwoch|Donnerstag|Freitag|Samstag", msDayOfWeek(msDate.q)+1, "|")  : EndProcedure     ; only supports years >= 1970 and <= 2037
Procedure.s   msWeekdayGER(msDate.q)      :   ProcedureReturn Left(msWeekdayGERLong(msDate),2)                                                         : EndProcedure     ; only supports years >= 1970 and <= 2037

Procedure.s   msFormatDate(Mask$, msDate.q, GermanWeekday=#False)
   
   ; Equivalent to FormatDate() for Date()-Values, but does support Years < 1970 and > 2037
   ; further it supports additional Tokens:
   ;   -  %ms    -  milliseconds with 3 digits
   ;   -  %wday  -  weekday - in long  form
   ;   -  %wd    -  weekday - in short form (3 Chars)
   
   Protected   msMask$   = ReplaceString(Mask$        , "%yyyy"   , Right(Str(msYear( msDate)+10000),4)         , #PB_String_NoCase)
               msMask$   = ReplaceString(msMask$      , "%yy"     , Right(Str(msYear( msDate)+10000),2)         , #PB_String_NoCase)
               msMask$   = ReplaceString(msMask$      , "%mm"     , Right(Str(msMonth(msDate)+100),2)           , #PB_String_NoCase)
               msMask$   = ReplaceString(msMask$      , "%dd"     , Right(Str(msDay(  msDate)+100),2)           , #PB_String_NoCase)
               msMask$   = ReplaceString(msMask$      , "%ms"     , Right(Str(msMilliSeconds(msDate)+1000),3)   , #PB_String_NoCase)
               If GermanWeekday = #True
                  msMask$   = ReplaceString(msMask$   , "%wday"   , msWeekdayGERLong(msDate.q)                  , #PB_String_NoCase)
                  msMask$   = ReplaceString(msMask$   , "%wd"     , msWeekdayGER(msDate.q)                      , #PB_String_NoCase)
               Else
                  msMask$   = ReplaceString(msMask$   , "%wday"   , msWeekdayLong(msDate.q)                    , #PB_String_NoCase)
                  msMask$   = ReplaceString(msMask$   , "%wd"     , msWeekday(msDate.q)                        , #PB_String_NoCase)
               EndIf
               If msYear(msDate) * msMonth(msDate) * msDay(msDate) <= 0 : Debug "msFormatDate()-Warning: Year, Month or Date is zero or negative - maybe wrong calculated msDate-Value?" : EndIf
               msMask$   = FormatDate(msMask$, Date(2000, 01, 01, msHour(msDate), msMinute(msDate), msSecond(msDate)))  ; use orig. FormatDate to replace Times only
   ProcedureReturn msMask$
EndProcedure


; --- msDate() Examples

CompilerIf #PB_Compiler_IsMainFile
   
   Define Act_Date.q         =   msDate()
   Define Custom_Date.q      =   msDate(2035,05,24,12,00,37,347)
   Define Future_Date.q      =   msDate(2158,09,11,08,52,00,120)
   
   Debug msFormatDate("Actual Date/Time"+#TAB$+":   %dd.%MM.%yyyy   -   %hh:%ii:%ss.%ms   -  %wd / %wday", Act_Date)
   Debug ""
   Debug msFormatDate("Custom Date/Time"+#TAB$+":   %dd.%mm.%yyyy   -   %hh:%ii:%ss.%ms   -  %wd / %wday", Custom_Date)
   Debug msFormatDate("German Date/Time"+#TAB$+":   %dd.%mm.%yyyy   -   %hh:%ii:%ss.%ms   -  %wd / %wday", Custom_Date, #True)
   Debug ""
   Debug msFormatDate("Future Date/Time"+#TAB$+":   %dd.%mm.%yyyy   -   %hh:%ii:%ss.%ms", Future_Date)                     ;  WeekDay not supported, because Year > 2037
   
CompilerEndIf
Vielleicht kann's je noch jemand von Euch brauchen. :wink:


[Edit] Hab noch die Funktionen msWeekdayGER() und msWeekdayGERLong() sowie einen optionalen Parameter in msFormatDate() hinzugefügt, um Wochentage in deutscher Sprache zu unterstützen.

[Edit2] Debug-Warnung hinzugefügt, falls sehr niedrige oder negative Datumswerte übergeben wurden.

Re: Date()-Funktionen mit Millisekunden-Präzision [Win only]

Verfasst: 29.04.2020 10:02
von Chregu
Du hast noch die Bugfixes vergessen:
You have to declare all variables with .q in msDate() and GetmsDatePart()

Code: Alles auswählen

Protected mMilliseconds.q   =   1
Protected mSecond.q         =   mMilliseconds   * 1000
Protected mMinute.q         =   mSecond         * 60
Protected mHour.q           =   mMinute         * 60
Protected mDay.q            =   mHour           * 24
Protected mMonth.q          =   mDay            * 32
Protected mYear.q           =   mMonth          * 13

Protected msTimeSTamp.q
Also the procedures should be defined as procedure.q

Bernd

Re: Date()-Funktionen mit Millisekunden-Präzision [Win only]

Verfasst: 29.04.2020 18:41
von PureLust
Chregu hat geschrieben:Du hast noch die Bugfixes vergessen:
Hi Chregu,
danke für den Hinweis ... hatte gar nicht mitbekommen, dass im englischen Forum jemand auf den Thread geantwortet hatte.

Bzgl. Berns Problemen mit 'strange Results' und seiner Bug-Fix Empfehlung:
Die seltsamen Resultate resultierten nicht aus falsch definierten Variablentypen (diese sind alle in Ordnung), sondern aus den Werten die Bernd übergeben hatte.

Diese zeigten (im msDate-Format) auf ein Datum im Jahr "0" oder b.C., welche bislang nicht unterstützt werden.

Einen Support für das Jahr 'Null' habe ich nun eingebaut, aber negative Datumswerte (also b.C.) werden nach wie vor nicht unterstützt.

In beiden Fällen wird aber nun eine Debug-Meldung ausgegeben, um darauf hin zu weisen, dass hier evtl. aus versehen falsche Werte übergeben wurden.

Kannst die msDate-Funktionen also nach wie vor benutzen - naja zumindest ab dem Jahr 0 nach Christus. :wink:

Grüße, PL.

Re: Date()-Funktionen mit Millisekunden-Präzision [Win only]

Verfasst: 01.05.2020 11:42
von juergenkulow
Hallo PureLust,

hast Du mal darüber nach gedacht, den Zeitstempel des Prozessors für noch genauere Zeitmessung zu nutzen? (RDTSC)

Gruß

Re: Date()-Funktionen mit Millisekunden-Präzision [Win only]

Verfasst: 01.05.2020 11:48
von PureLust
Hi Jürgen,

da ich ja keine super exakte 'Zeitmessung' , sondern nur 'Zeit Stempel' für rund 20-30 Einzelereignisse pro Sekunde brauchte, war eine Genauigkeit von Millisekunden für meinen Zweck mehr als ausreichend.

Diese werden zusammen mit den Messwerten in einer Datenbank gespeichert und später unabhängig ausgewertet.

Grüße, PL
Alle Zeiten sind UTC+02:00
Seite 1 von 1

Powered by phpBB® Forum Software © phpBB Limited

Deutsche Übersetzung durch phpBB.de