我忘了为这个问题添加动机。使用 FileTimeToSystemTime 的明显解决方案非常慢,这个函数比慢速 API 调用快 3 倍以上。作为精密计时项目的一部分,我开发了 VBA 代码来从 FILETIME (FT) 数据中提取 YEAR 信息。我可以改进测试这段代码吗?算法是:
- 从 FT 数据中提取整数天数
- 估计年份除以每年的平均天数((365*400+100-3)/400=365.2425 天/年)。这是正确的答案 +/- 一年。
- 考虑闰年,计算截至 1 月 1 日和 12 月 31 日今年的确切天数。
- 如果实际的天数 (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