0

我忘了为这个问题添加动机。使用 FileTimeToSystemTime 的明显解决方案非常慢，这个函数比慢速 API 调用快 3 倍以上。作为精密计时项目的一部分，我开发了 VBA 代码来从 FILETIME (FT) 数据中提取 YEAR 信息。我可以改进测试这段代码吗？算法是：

  1. 从 FT 数据中提取整数天数
  2. 估计年份除以每年的平均天数（(365*400+100-3)/400=365.2425 天/年）。这是正确的答案 +/- 一年。
  3. 考虑闰年，计算截至 1 月 1 日和 12 月 31 日今年的确切天数。
  4. 如果实际的天数 (1) 在这两个数字之间，则 2) 中的估计是正确的。如果不正确，则添加或减去一年以获得正确的年份，其中包括 1) 中的天数。

为了测试代码，我创建了一个随机的 SYSTEMTIME (ST) 日期/时间，使用 SystemTimeToFileTime 将此日期转换为 FT 刻度，然后运行提取函数。我知道输入年份，所以我可以验证提取的年份等于输入年份。我循环运行了测试代码。当我的笔记本电脑没有受到限制时，我可以每秒查看大约 12K ST 测试。我已经运行了一百万个随机样本，没有错误。

我担心这还不够好测试，因为我已经阅读了很多关于使用日期的内容，对于这么多时区、国家、任意本地更改问题等问题如此之多。这是足够好的测试，还是我应该做其他事情，比如尝试做一些闰年测试或夏令时测试（我不知道该怎么做）。提取和测试代码：


     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
4

1 回答 1

0

让 Win32 API 为您完成工作，将其放入模块或类中：

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

由于此方法返回一个普通的 VB 日期，因此您可以轻松提取其中的任何日期/时间部分。

于 2021-09-01T09:31:56.943 回答