Блог

Я создаю базу данных, которая автоматически обновляет всю информацию на основе текущей даты пользователя.
Но есть проблема, это означает, что если у Пользователя неверные настройки даты, это означает, что вся система скомпрометирована. Единственное решение, о котором я подумал, состояло в том, чтобы получить региональные настройки пользователя и часовой пояс пользователя и использовать их, чтобы определить, неверны ли время и дата, чтобы база данных не обновлялась. Но до сих пор я не нашел СПОСОБА получить часовой пояс и региональные настройки пользователя с помощью Microsoft access. Кто-нибудь может мне помочь, пожалуйста? Я не нашел никакой функции или способа получить эти настройки пользователя в доступе. Ближе всего я подошел к этому, когда подал заявление.Языковые задания .Я действительно заблудился здесь.

Вы можете получить время UTC из удаленного API:

 ' 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" amp; Str(Err.Number) amp; ": " amp; Err.Description, vbCritical   vbOKOnly, "Web Service Error"
    Resume Exit_DateUtcNow

End Function
 

Затем проверьте, находится ли дата/время в Now() пределах /- 12 часов после этого.

Для этого требуется ссылка на Microsoft XML, v6.0 .

Вы можете прочитать региональные настройки из реестра.

Есть много способов чтения из реестра в VBA, которые я предпочитаю использовать WScript.Shell , но другие используют WinAPI (более сложный, но WScript.Оболочка может быть заблокирована)

 CreateObject("WScript.Shell").RegRead("HKEY_LOCAL_MACHINESYSTEMCurrentControlSetControlTimeZoneInformationTimeZoneKeyName")
 

Для получения более подробной информации о часовом поясе вы можете использовать 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. Как выполнить эти вычисления, описано в документации по типу. Конечно, вы также можете использовать стандартное имя и имя дневного света, чтобы проверить, установлен ли часовой пояс должным образом. Приведите их к строкам со следующим кодом:

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