毫秒时间；毫秒(2)错误返回

Question

我试图在Access 2010/13中使用此方法实现毫秒时间戳；MS Access可以处理毫秒时间值--真的--参见: http://www.devx.com/dbzone/Article/39046#sthash.xEIruMyE.dpuf

函数Msec(2)应该以毫秒为单位返回系统时间，但它似乎大约在10小时之外。

Public Function Msec( _
  Optional ByVal intTimePart As Integer) _
  As Date

' This is the core function.
' It generates the current time with millisecond resolution.
'
' Returns current (local) date/time including millisecond.
' Parameter intTimePart determines level of returned value:
'   0: Millisecond value only.
'   1: Time value only including milliseconds.
'   2: Full Date/time value including milliseconds.
'   None or any other value: Millisecond value only.

  Const cintMsecOnly            As Integer = 0
  Const cintMsecTime            As Integer = 1
  Const cintMsecDate            As Integer = 2

  Static typTime      As SYSTEMTIME
  Static lngMsecInit  As Long

  Dim datMsec         As Date
  Dim datDate         As Date
  Dim intMilliseconds As Integer
  Dim lngTimeZoneBias As Long
  Dim lngMsec         As Long
  Dim lngMsecCurrent  As Long
  Dim lngMsecOffset   As Long

  ' Set resolution of timer to 1 ms.
  timeBeginPeriod 1
  lngMsecCurrent = timeGetTime()

  If lngMsecInit = 0 Or lngMsecCurrent < lngMsecInit Then
    ' Initialize.
    ' Get bias for local time zone respecting
    ' current setting for daylight savings.
    lngTimeZoneBias = GetLocalTimeZoneBias(False)
    ' Get current UTC system time.
    Call GetSystemTime(typTime)
    intMilliseconds = typTime.wMilliseconds
    ' Repeat until GetSystemTime retrieves next count of milliseconds.
    ' Then retrieve and store count of milliseconds from launch.
    Do
      Call GetSystemTime(typTime)
    Loop Until typTime.wMilliseconds <> intMilliseconds
    lngMsecInit = timeGetTime()
    ' Adjust UTC to local system time by correcting for time zone bias.
    typTime.wMinute = typTime.wMinute - lngTimeZoneBias
    ' Note: typTime may now contain an invalid (zero or negative) minute count.
    ' However, the minute count is acceptable by TimeSerial().
  Else
    ' Retrieve offset from initial time to current time.
    lngMsecOffset = lngMsecCurrent - lngMsecInit
  End If

  With typTime
    ' Now, current system time is initial system time corrected for
    ' time zone bias.
    lngMsec = (.wMilliseconds + lngMsecOffset)
    Select Case intTimePart
      Case cintMsecTime, cintMsecDate
        ' Calculate the time to add as a date/time value with millisecond resolution.
        datMsec = lngMsec / 1000 / clngSecondsPerDay
        ' Add to this the current system time.
        datDate = datMsec + TimeSerial(.wHour, .wMinute, .wSecond)
        If intTimePart = cintMsecDate Then
          ' Add to this the current system date.
          datDate = datDate + DateSerial(.wYear, .wMonth, .wDay)
        End If
      Case Else
        ' Calculate millisecond part as a date/time value with millisecond resolution.
        datMsec = (lngMsec Mod 1000) / 1000 / clngSecondsPerDay
        ' Return millisecond part only.
        datDate = datMsec
    End Select
  End With

  Msec = datDate

End Function

就像杰克·哈德卡斯尔说的，可能是时区相关的。

它从不运行这段代码；

  If lngMsecInit = 0 Or lngMsecCurrent < lngMsecInit Then
    ' Initialize.
    ' Get bias for local time zone respecting
    ' current setting for daylight savings.
    lngTimeZoneBias = GetLocalTimeZoneBias(False)
    ' Get current UTC system time.
    Call GetSystemTime(typTime)
    intMilliseconds = typTime.wMilliseconds
    ' Repeat until GetSystemTime retrieves next count of milliseconds.
    ' Then retrieve and store count of milliseconds from launch.
    Do
      Call GetSystemTime(typTime)
    Loop Until typTime.wMilliseconds <> intMilliseconds
    lngMsecInit = timeGetTime()
    ' Adjust UTC to local system time by correcting for time zone bias.
    typTime.wMinute = typTime.wMinute - lngTimeZoneBias
    ' Note: typTime may now contain an invalid (zero or negative) minute count.
    ' However, the minute count is acceptable by TimeSerial().

却去了；

  Else
    ' Retrieve offset from initial time to current time.
    lngMsecOffset = lngMsecCurrent - lngMsecInit
  End If

回答!来自@pathDongle

时间以毫秒世界协调时的形式存储；

!DateTimeMS = GetTimeUTC()

并由；

Public Function UTCtoTimeLocal(dSysUTC As Date) As Date
'Dim sysTime As SYSTEMTIME
    Dim DST As Long
    Dim tzi As TIME_ZONE_INFORMATION

    DST = GetTimeZoneInformation(tzi)
    UTCtoTimeLocal = dSysUTC - TimeSerial(0, tzi.Bias, 0) + IIf(DST = 2, TimeSerial(1, 0, 0), 0)
End Function

查询；

SELECT tblzzAuditTrail.DateTimeMS, FormatDate(UTCtoTimeLocal([DateTimeMS])) AS DateTimeLocal

可以作为字符串进行过滤。

Private Sub BuildFilter()
    Dim strFilter As String
    Dim ctl As Control

    strFilter = ""

'add selected values to string
    For Each ctl In Me.FormHeader.Controls
        With ctl
            If .ControlType = acTextBox Or .ControlType = acComboBox Then
                If Nz(.Value) <> "" Then
                    If InStr(.Name, "Date") <> 0 Then
                        If Nz(StartDate) <> "" And Nz(EndDate) <> "" And InStr(strFilter, "DateTimeLocal") = 0 Then
                            strFilter = strFilter & "[DateTimeLocal] BETWEEN '" & FormatDate(Me.StartDate.Value) & "' AND '" & FormatDate(Me.EndDate.Value) & "' AND "
                        ElseIf Nz(StartDate) <> "" And InStr(strFilter, "DateTimeLocal") = 0 Then
                            strFilter = strFilter & "[DateTimeLocal] > '" & FormatDate(Me.StartDate.Value) & "' AND "
                        ElseIf Nz(EndDate) <> "" And InStr(strFilter, "DateTimeLocal") = 0 Then
                            strFilter = strFilter & "[DateTimeLocal] <= '" & FormatDate(Me.EndDate.Value) & "' AND "
                        End If
                    ElseIf InStr(.Name, "ID") <> 0 Then
                        strFilter = strFilter & "[" & .Name & "] = " & .Value & " AND "
                    Else
                        strFilter = strFilter & "[" & .Name & "] = '" & .Value & "' AND "
                    End If
                End If
            End If
        End With
    Next ctl
'trim trailing And
    strFilter = TrimR(strFilter, 5)

Debug.Print strFilter
    With Me.subfrmzzAuditTrailDisplay
        .Form.Filter = strFilter
        .Form.FilterOn = True
    End With
End Sub

由此产生的过滤串；

[UserID] = 2 AND [DateTimeLocal] BETWEEN '06/01/2015 00:00:00.000' AND '07/01/2015 00:00:00.000'

根据我的另一个问题；

毫秒时间:按日期过滤表单

Answer 1

这些功能中的大多数可以简化如下：

函数GetTimeLocal将返回用户本地系统日期时间，并进行夏令调整。

函数GetTimeUTC将返回UTC时间

函数FormatDate将使用正确的毫秒组件将Date格式化为字符串。

通常情况下，最好将所有时间存储为UTC，并在需要时进行转换。

Option Explicit

#If Win64 Then
    Public Declare PtrSafe Sub GetSystemTime Lib "kernel32" (ByRef lpSystemTime As SYSTEMTIME)
    Private Declare PtrSafe Function GetTimeZoneInformation Lib "kernel32" (lpTimeZoneInformation As TIME_ZONE_INFORMATION) As Long
#Else
    Public Declare Sub GetSystemTime Lib "kernel32" (ByRef lpSystemTime As SYSTEMTIME)
    Private Declare Function GetTimeZoneInformation Lib "kernel32" (lpTimeZoneInformation As TIME_ZONE_INFORMATION) As Long
#End If

Public 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 Type TIME_ZONE_INFORMATION
    Bias As Long
    StandardName(31) As Integer
    StandardDate As SYSTEMTIME
    StandardBias As Long
    DaylightName(31) As Integer
    DaylightDate As SYSTEMTIME
    DaylightBias As Long
End Type

Sub test()
Dim dtLcl As Date
Dim dtUTC As Date
    dtLcl = GetTimeLocal 'Gets local time including adjustement for daylight saving time
    dtUTC = GetTimeUTC 'Gets UTC time

    Debug.Print FormatDate(dtLcl)
    Debug.Print FormatDate(dtUTC)

End Sub

Function FormatDate(ByVal dt As Date) As String
Dim sysTime As SYSTEMTIME
Dim sec As Double
Dim x As Double

    With sysTime
        .wYear = Year(dt)
        .wMonth = Month(dt)
        .wDay = Day(dt)
        .wHour = Hour(dt)
        .wMinute = Minute(dt)
        'Second() function rounds to nearest second so calc floor second
        'Eg 12:15:09.678 will give second component as 10 instead of 09
        x = (dt - Int(dt)) * 86400#
        sec = x - Fix(x / 60#) * 60#
        .wSecond = Int(sec)
        .wMilliseconds = Int(Round(sec - .wSecond, 3) * 1000)
        FormatDate = Format(dt, "dd/mm/yyyy hh:mm:ss.") & Format(sysTime.wMilliseconds, "000")
    End With

End Function

Public Function GetTimeLocal() As Date
Dim dSysUTC As Date, sysTime As SYSTEMTIME
Dim DST As Long, IsDST As Boolean
Dim tzi As TIME_ZONE_INFORMATION
Dim ms As Double

    GetSystemTime sysTime
    With sysTime
        'Debug.Print "ms=" & .wMilliseconds
        ms = CDbl(.wMilliseconds) / (86400# * 1000#)
        dSysUTC = DateSerial(.wYear, .wMonth, .wDay) + TimeSerial(.wHour, .wMinute, .wSecond) + ms
    End With
    DST = GetTimeZoneInformation(tzi)
    GetTimeLocal = dSysUTC - TimeSerial(0, tzi.Bias, 0) + IIf(DST = 2, TimeSerial(1, 0, 0), 0)
End Function

Public Function GetTimeUTC() As Date
Dim dSysUTC As Date
Dim sysTime As SYSTEMTIME
Dim ms As Double

    GetSystemTime sysTime
    With sysTime
        'Debug.Print "ms=" & .wMilliseconds
        ms = CDbl(.wMilliseconds) / (86400# * 1000#)
        GetTimeUTC = DateSerial(.wYear, .wMonth, .wDay) + TimeSerial(.wHour, .wMinute, .wSecond) + ms
    End With
End Function