我正在创建一个数据库,该数据库根据用户的当前日期自动更新所有信息。
但是有一个问题,如果用户的日期设置有误,就意味着整个系统都被攻陷了。我想到的唯一解决方案是获取用户的区域设置和用户的时区,并使用它来确定时间和日期是否错误,以便数据库不会更新。但到目前为止,我发现无法使用 microsoft access 获取用户的时区和区域设置。有人能帮助我吗?
我没有找到在 Access 中获取用户设置的功能或方法。我最接近的是 Application.LanguageSettings 。我真的迷路了。
答案 0 :(得分:3)
您可以从远程 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
的引用。
答案 1 :(得分:3)
您可以从注册表中读取区域设置。
VBA中读取registry的方式有很多种,我更喜欢用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)