0

I forgot to add motivation for this question..the obvious solution of using FileTimeToSystemTime is horribly slow, this function is more than 3X faster that a slow API call. As part of a precision timing project, I developed VBA code to extract the YEAR information from FILETIME (FT) data. Can I improve on testing this code? The algorithm is:

  1. Extract whole number of days from FT data
  2. Estimate the year dividing the days by the average days per year ((365*400+100-3)/400=365.2425 days per year). This is the correct answer +/- one year.
  3. Calculate the exact number of whole days for this year as of Jan1 and Dec31, taking into account leap years.
  4. If the actual whole days (1) is between these two numbers, the estimate in 2) is correct. If not correct, then add or subtract a year to get the correct year that will include the days from 1).

To test the code, I created a random SYSTEMTIME (ST) date/time, use SystemTimeToFileTime to convert this date to FT ticks, and ran the extraction function. I know the input year, so I can verify the extracted year is equal to the input year. I ran the test code in a loop. I can look at about 12K ST tests per second on my laptop when it is not getting throttled. I’ve run it for a million random samples, got no errors.

I'm worried this is not good enough testing since I have read so much about working with dates is so problematic with so many time zone, country, arbitrary local changes issues etc. Is this good enough testing, or should I do something else, like try to do some leap year testing or daylight savings time testing (which I have no idea how to do). Code for extraction and testing:


     Option Explicit

Private Declare PtrSafe Function SystemTimeToFileTime Lib "kernel32" (lpSystemTime As SYSTEMTIME, lpFileTime As LongLong) As Long
'A file time is a 64-bit value that represents the number of 100-nanosecond intervals that have elapsed since
'                                                                   12:00 A.M. January 1, 1601 Coordinated Universal Time (UTC).
'I use LongLong data type for lpFileTime, seems to work fine instead of unsigned integer two dwords/high/low

Public Type SYSTEMTIME 'ALLOWED YEAR RANGE IS 1601 through 30827
    stYear As Integer
    stMonth As Integer
    stDayOfWeek As Integer
    stDay As Integer
    stHour As Integer
    stMin As Integer
    stSec As Integer
    stMilliSec As Integer
End Type


Function funcExtractYearFromFileTimeTicks(LL_Ticks As LongLong) As Integer

        Dim LL_Days As LongLong, liFTYear As Long, liFTYearsFrom1600 As Long, liJan1OfYearFrom1600 As Long, liDec31OfYearFrom1600 As Long, bIsLeapYear As Boolean
        
        'get number of whole days from ticks,   24 * 60 * 60 * 10000000 = 864000000000 nSec per day
        LL_Days = Int(CDbl(LL_Ticks) / 864000000000#)  'not completely sure I did data type conversions best practice, but seems to work
        'LL_Days is number of whole days from Jan1/1601, need from Jan1/1600, a leap year, for easier algebra
        LL_Days = LL_Days + 366^
        'there are exactly an average of (365*400+100-3)/400=365.2425 days per year
        liFTYearsFrom1600 = Int(CDbl(LL_Days) / 365.2425)      'First estimate of years since 1/1/1600, actual year is +/- 1 worst case different than this estimate
        liFTYear = liFTYearsFrom1600 + 1600
        bIsLeapYear = isLeapYear(CInt(liFTYear))
        liJan1OfYearFrom1600 = liFTYearsFrom1600 * 365 + Int(liFTYearsFrom1600 / 4) - Int(liFTYearsFrom1600 / 100) + Int(liFTYearsFrom1600 / 400)
        If Not (bIsLeapYear) Then liJan1OfYearFrom1600 = liJan1OfYearFrom1600 + 1    'exact whole days from Jan1/1600 to Jan1 of liFTYears
        If bIsLeapYear Then liDec31OfYearFrom1600 = liJan1OfYearFrom1600 + 365 Else liDec31OfYearFrom1600 = liJan1OfYearFrom1600 + 364 'exact whole days from Jan1/1600 to Dec31 of liFTYears

        If LL_Days < liJan1OfYearFrom1600 Then  'if FT days do not fit into the min/max of the estimated year, correct the year up or down as needed
                liFTYear = liFTYear - 1
        ElseIf LL_Days > liDec31OfYearFrom1600 Then
                liFTYear = liFTYear + 1
        End If
        
        funcExtractYearFromFileTimeTicks = liFTYear
End Function


Sub TEST_ExtractYearFromFileTimeTicks()

    Dim stUTCSystemTime As SYSTEMTIME, LL_UTC_FTTicks As LongLong
    Dim iFTYear As Integer, iSTYear As Integer, iMonth As Integer, iDay As Integer, dTimeStart As Double, dTimeElapsed As Double
 '#################################
    Dim liLoop As Long, liMaxLoops As Long:    liMaxLoops = 120000   '120K loops takes about 10 seconds on my machine  80microSec per loop , best case
'#################################
    dTimeStart = Timer
    For liLoop = 1 To liMaxLoops
            'Generate Random SYSTEMTIME to get random FILETIME Ticks, verify extracted FILETIME year is identical to SYSTEMTIME Year
                                iSTYear = Application.RandBetween(1601, 9999)     'weeKday function can't handle to the max 30827 YEAR that SYSTEMTIME can handle, only up to 9999
                                stUTCSystemTime.stYear = iSTYear
                                iMonth = Application.RandBetween(1, 12)                 'MONTH
                                stUTCSystemTime.stMonth = iMonth
                                                                                                                'DAY OF THE MONTH, RANGE DEPENDS ON WHICH MONTH
                                If (iMonth = 1 Or iMonth = 3 Or iMonth = 5 Or iMonth = 7 Or iMonth = 8 Or iMonth = 10 Or iMonth = 12) Then
                                            iDay = Application.RandBetween(1, 31)
                                ElseIf iMonth = 4 Or iMonth = 6 Or iMonth = 9 Or iMonth = 11 Then
                                            iDay = Application.RandBetween(1, 30)
                                ElseIf isLeapYear(iSTYear) Then  'is February
                                            iDay = Application.RandBetween(1, 29)  'leap year so 29 days
                                Else
                                            iDay = Application.RandBetween(1, 28)  'Feb is not leap year
                                End If
                                stUTCSystemTime.stDay = iDay
                                stUTCSystemTime.stDayOfWeek = Weekday(iMonth & "/" & iDay & "/" & iSTYear) 'DAY OF WEEK
                                stUTCSystemTime.stHour = Application.RandBetween(0, 23)         'HOUR
                                stUTCSystemTime.stMin = Application.RandBetween(0, 59)            'MIN
                                stUTCSystemTime.stSec = Application.RandBetween(0, 59)             'SEC
                                stUTCSystemTime.stMilliSec = Application.RandBetween(0, 999)      'milliSEC

            
            Call SystemTimeToFileTime(stUTCSystemTime, LL_UTC_FTTicks)  'get the FILETIME ticks for this SYSTEMTIME
           ' LL_UTC_FTTicks = funcU64toLL(U64UTCFileTime)  'convert High/Low DWORDs to LongLong
            LL_UTC_FTTicks = LL_UTC_FTTicks + Application.RandBetween(0, 9999) ' add random microseconds, 100nSec to FT ticks
            
            iFTYear = funcExtractYearFromFileTimeTicks(LL_UTC_FTTicks) '       EXTRACT THE YEARS FROM FILETIMETICKS
            
            If iFTYear <> iSTYear Then  'stop loop if the SYSTEMTIME and Extracted FILETIME years do not match
                        With stUTCSystemTime
                                Debug.Print "--------------"
                                Debug.Print "stYear          "; .stYear
                                Debug.Print "stMonth        "; .stMonth
                                Debug.Print "stDayOfWeek"; .stDayOfWeek
                                Debug.Print "stDay           "; .stDay
                                Debug.Print "stHour          "; .stHour
                                Debug.Print "stMin            "; .stMin
                                Debug.Print "stSec            "; .stSec
                                Debug.Print "stMilliSec       "; .stMilliSec
                        End With
                        Stop
            End If
Next liLoop
dTimeElapsed = Timer - dTimeStart
Debug.Print Format(liMaxLoops, "0,000"); "Test extractions successfully completed"; vbCrLf; _
"Total Time (Sec) :  "; Format(dTimeElapsed, "0.0"); vbCrLf; _
"milliSec per loop: "; Format(dTimeElapsed * 1000 / liMaxLoops, "0.00"); vbCrLf; "--------------------------"; vbCrLf; vbCrLf
End Sub


Function isLeapYear(Y As Integer) As Boolean
'https://stackoverflow.com/questions/128104/how-do-you-find-leapyear-in-vba
'chris neilsen's version, IMO most elegant/fast and deserved the top rating, even gave testing protocol to prove his answer is fast
'top rated solution is easiest to follow, but not the fastest, takes 15% longer to run on my machine
    If Y Mod 4 Then Exit Function  'not multiple of 4 so just exit
    If Y Mod 100 Then  'Y must be multiple of 4 to get here
    ElseIf Y Mod 400 Then Exit Function  'is multiple of 100 to get here, so exit if not multiple of 400
    End If
    isLeapYear = True
End Function
photonblaster
  • 11
  • 1
  • 4

1 Answers1

0

Let the Win32 API do the work for you, put this in a module or class:

Private Type FILETIME
   dwLowDateTime As Long
   dwHighDateTime As Long
End Type

Private Type SYSTEMTIME
   wYear           As Integer
   wMonth          As Integer
   wDayOfWeek      As Integer
   wDay            As Integer
   wHour           As Integer
   wMinute         As Integer
   wSecond         As Integer
   wMilliseconds   As Integer
End Type

   
Private Declare Function FileTimeToSystemTime Lib "kernel32.dll" ( _
   ByRef lpFileTime As FILETIME, _
   ByRef lpSystemTime As SYSTEMTIME _
   ) As Long

   
Private Declare Function SystemTimeToVariantTime Lib "OleAut32.dll" ( _
   ByRef lpSystemTime As SYSTEMTIME, _
   ByRef vbtime As Date _
   ) As Long


Function FileTime2VBDate(ByRef ft As FILETIME) As Date

   Dim st As SYSTEMTIME
   Dim dtm As Date
   Dim lRet As Long
   
   lRet = FileTimeToSystemTime(ft, st)
   If lRet <> 0 Then
      lRet = SystemTimeToVariantTime(st, dtm)
      If lRet <> 0 Then
         FileTime2VBDate = dtm
      Else
         FileTime2VBDate = CDate(0)
      End If
   Else
      FileTime2VBDate = CDate(0)
   End If

End Function

Since this method returns an ordinary VB date, you then can extract any date/time part of it with ease.

Hel O'Ween
  • 1,423
  • 9
  • 15
  • Hel, I modified my question to head off this answer, but idid it too late for your response. Extracting the year from FileTimeToSystemTime is almost 4X slower than my function. That being said, when using SystemTimeToVariantTime why not just do a Dim iYear as Integer, and iYear=SYSTEMTIME.wsYear? – photonblaster Sep 01 '21 at 16:09
  • You're right ofc that with your specific requirement of retrieving the year, just getting SYSTEMTIME.wYear is all that's needed. What I posted is a common method I use for different purposes, that's why I return an easy to handle Date value. The 4x times slower bit surprises me quite a bit, I must say. How much do we talk in absolute time here? It's in the milliseconds range, I suppose. Nonetheless, I take a true and tested API over self-baked code every time. Yes, that API may also (still) have a bug lurking somewhere. But chances are much higher that **my** similar code has a (crucial) bug. – Hel O'Ween Sep 02 '21 at 12:45