有没有办法验证用户的时间和日期在 microsoft access vba 中是否正确？

Question

我正在创建一个数据库，它会根据用户的当前日期自动更新所有信息。
但是有一个问题，这意味着如果用户设置了错误的日期，则意味着整个系统都受到了威胁。我想到的唯一解决方案是获取用户的区域设置和用户的时区，并使用它来确定时间和日期是否错误，这样数据库就不会更新。但到目前为止，我发现没有办法使用 microsoft access 获取用户的时区和区域设置。有人能帮助我吗？ 我发现没有任何功能或方法可以在 Access 中获取用户的这些设置。我最接近的是 Application.LanguageSettings 。我真的迷路了。

Answer 1

您可以从远程 API 检索 UTC 时间：

' Retrieves the current UTC date and time from a remote source.
' Split seconds (milliseconds) are rounded to the second like VBA.Now does.
'
' Documentation:
'   http://worldtimeapi.org/
'
' 2018-09-11. Gustav Brock. Cactus Data ApS, CPH.
'
Public Function DateUtcNow() As Date

    ' ServiceUrl for time service.
    Const ServiceUrl        As String = "http://worldtimeapi.org/api/timezone/etc/utc.txt"
    
    ' Fixed constants.
    Const Async             As Boolean = False
    Const StatusOk          As Integer = 200
    Const UtcSeparator      As String = "datetime: "
    Const IsoSeparator      As String = "T"
    
    ' Engine to communicate with the service.
    Dim XmlHttp             As XMLHTTP60
    
    Dim ResponseText        As String
    Dim UtcTimePart         As String
    Dim DateTimePart        As String
    Dim SplitSeconds        As Double
    Dim CurrentUtcTime      As Date
  
    On Error GoTo Err_DateUtcNow
    
    Set XmlHttp = New XMLHTTP60
    
    XmlHttp.Open "GET", ServiceUrl, Async

    XmlHttp.send

    ResponseText = XmlHttp.ResponseText
    If XmlHttp.status = StatusOk Then
        UtcTimePart = Split(ResponseText, UtcSeparator)(1)
        DateTimePart = Replace(Left(UtcTimePart, 19), IsoSeparator, " ")
        SplitSeconds = Val(Mid(UtcTimePart, 20, 7))
        CurrentUtcTime = DateAdd("s", SplitSeconds + 0.5, CDate(DateTimePart))
    End If
    
    DateUtcNow = CurrentUtcTime

Exit_DateUtcNow:
    Set XmlHttp = Nothing
    Exit Function

Err_DateUtcNow:
    MsgBox "Error" & Str(Err.Number) & ": " & Err.Description, vbCritical + vbOKOnly, "Web Service Error"
    Resume Exit_DateUtcNow

End Function

然后检查Now() 的日期/时间是否在此之后的 +/- 12 小时内。

这需要引用Microsoft XML, v6.0。

Answer 2

您可以从注册表中读取区域设置。

VBA中从注册表读取的方式有很多，我比较喜欢用WScript.Shell，但也有人用WinAPI（比较复杂，但是可以屏蔽WScript.Shell）

CreateObject("WScript.Shell").RegRead("HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\TimeZoneInformation\TimeZoneKeyName")

更详细的时区信息，可以使用WinAPI。

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


Public Type TIME_ZONE_INFORMATION
    Bias As Long
    StandardName(64) As Byte
    StandardDate As SYSTEMTIME
    StandardBias As Long
    DaylightName(64) As Byte
    DaylightDate As SYSTEMTIME
    DaylightBias As Long
End Type

Const TIME_ZONE_ID_STANDARD = 1
Const TIME_ZONE_ID_DAYLIGHT = 2

Public Declare PtrSafe Function GetTimeZoneInformation Lib "Kernel32.dll" (ByRef lpTimezoneInformation As TIME_ZONE_INFORMATION) As Long

Public Function GetBiasInHours() As Long
    Dim tzi As TIME_ZONE_INFORMATION
    Dim IsDST As Long
    IsDST = GetTimeZoneInformation(tzi)
    Dim Bias As Long
    If IsDST = TIME_ZONE_ID_DAYLIGHT Then
        Bias = tzi.DaylightBias / 60
    Else
        Bias = tzi.Bias / 60
    End If
    GetBiasInHours = Bias
End Function

偏差可用于计算时间到 UTC 时间。 the documentation on the type 中描述了如何进行这些计算。当然，您也可以使用 StandardName 和 DaylightName 来检查时区是否按预期设置。您可以使用以下代码将它们转换为字符串：

Dim StandardNameString As String
StandardNameString = tzi.StandardName
StandardNameString = Left(StandardNameString, InStr(StandardNameString & vbNullChar, vbNullChar) - 1)