Solved Access VBA code to retrieve server date (1 Viewer)

[cheekybuddha]

Wouldn't your users be able to open the VBA editor and change the lines of code that prevent them from using your database?

You'd imagine the OP would be distributing an .accde.

it would be easier to just get the time from a http request

That's what theDBguy posted in the post before yours

 

[The_Doc_Man]

Thanks, had overlooked that code was added in #1.

I found that for NetRemoteTOD: http://vbnet.mvps.org/index.html?code/network/netremotetod.htm

But: shouldn't the clients and the servers of a network have synchronous times and only the time zone be different? I thought otherwise there are problems in AD.

Josef, your idea is good but not everyone is on an Active Directory-based network. If you don't have AD and don't have something running NTP (Network Time Protocol) then the client and server times don't have to match. Note also that in such a case, you can't use Kerberos security since it REQUIRES time sync because of the token-passing method used in that case.

 

[561414]

You'd imagine the OP would be distributing an .accde.

Who knows.

That's what theDBguy posted in the post before yours

Oh I didn't read it, he uses a similar approach. But hey, my code is shorter, eh.

 

[Pop_Access]

You'd imagine the OP would be distributing an .accde.

That's what theDBguy posted in the post before yours

The file that I distributed is .accde

 

[arnelgp]

you may also try this:

' idea from
' https://devblogs.microsoft.com/scripting/how-can-i-determine-the-system-time-on-a-computer/
'
' arnelgp
'
Public Function GetServerSysDate(ByVal ComputerName As String)
  Dim objWMIService, colItems, objItem

  ' Using the SWbemServices object directly:
Set objWMIService = GetObject("winmgmts:\\" & ComputerName & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * From Win32_LocalTime")
For Each objItem In colItems
    'Debug.Print "Month: " & objItem.Month
    'Debug.Print "Day: " & objItem.Day
    'Debug.Print "Year: " & objItem.Year
    'Debug.Print "Hour: " & objItem.Hour
    'Debug.Print "Minute: " & objItem.Minute
    'Debug.Print "Second: " & objItem.Second
    GetServerSysDate = CDate(objItem.Month & "/" & objItem.Day & "/" & objItem.Year & " " & objItem.Hour & ":" & objItem.Minute & ":" & objItem.Second)
Next

End Function

 

[Pop_Access]

you may also try this:

' idea from
' https://devblogs.microsoft.com/scripting/how-can-i-determine-the-system-time-on-a-computer/
'
' arnelgp
'
Public Function GetServerSysDate(ByVal ComputerName As String)
  Dim objWMIService, colItems, objItem

  ' Using the SWbemServices object directly:
Set objWMIService = GetObject("winmgmts:\\" & ComputerName & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * From Win32_LocalTime")
For Each objItem In colItems
    'Debug.Print "Month: " & objItem.Month
    'Debug.Print "Day: " & objItem.Day
    'Debug.Print "Year: " & objItem.Year
    'Debug.Print "Hour: " & objItem.Hour
    'Debug.Print "Minute: " & objItem.Minute
    'Debug.Print "Second: " & objItem.Second
    GetServerSysDate = CDate(objItem.Month & "/" & objItem.Day & "/" & objItem.Year & " " & objItem.Hour & ":" & objItem.Minute & ":" & objItem.Second)
Next

End Function

Thank you @arnelgp
I would like to ask for further guidance on how to call the GetServerSysDate function under the Form Load event and compare the retrieved date with a specific date. for example: if the retrieved date >= 10/15/2023.

 

[Pop_Access]

Wouldn't your users be able to open the VBA editor and change the lines of code that prevent them from using your database? If that does not matter, then maybe it would be easier to just get the time from a http request. This is a google service that returns the date in the headers when called, even if the subdomain is made up:

Sub getTime()
    Dim req As Object
    Set req = CreateObject("MSXML2.ServerXMLHTTP")
    req.Open "GET", "https://whatever.firebaseio.com/"
    req.send
    MsgBox req.getResponseHeader("Date")
End Sub

Thank you @561414

I would like to ask for further guidance on how to compare the retrieved date with a specific date. for example: if the retrieved date >= 10/15/2023.
since the code you provided is working well.

 

[arnelgp]

i made simple form (Form1) which will get the server date.
you modify the Load Event and put the Server address on the Constant SERVER.

 

[The_Doc_Man]

I would like to ask for further guidance on how to compare the retrieved date with a specific date.

There are multiple formats to consider... data types Date for VBA or tables or queries, and String for VBA or ShortText for tables or queries. They don't always directly inter-compare and the use of ">=" as a comparison operator means you have to be a bit tricky.

Data type "DATE" is a numeric date that is a typecast (i.e. interpretation) of data type DOUBLE. It is possible, when both dates are in DATE format, to directly compare IF ( Date1 >= Date2 ) Then ... and get a true/false result. Note that type DATE includes time in the mix. Therefore, if you assign a value to a DATE variable, be aware that NOW() and DATE() are two functions that would return a DATE data type, but NOW() includes time and DATE() does not. So if comparing DATE data types from different sources, be sure you know whether time is involved. That is because NOW() equals DATE() for only 1 in 86,400 seconds. Otherwise, NOW() is greater than (later than) DATE() except exactly at midnight.

A problem comes into play when a text or string data type is involved in the comparison. When you retrieve a date, you have good odds that it came back as a formatted string. Approaches exist that would allow you to compare string-based times. The simplest method uses function CDATE() to convert a string representation of a date and time into a DATE data type for numeric comparison. In that case, you can compare IF CDATE(StringDate1) >= CDATE(StringDate2) Then ... and again get a valid true/false result. IF you have a mixed case, the first thing to try is to compare the DATE variable against CDATE() of the STRING variable, as IF CDATE(StringDate) >= DATEDate Then ... to manage the comparison.

The other type of comparison is possible, but requires special formatting. You see, doing a STRING compare doesn't follow numeric comparison rules. When comparing strings "2" is greater than "10" because it runs one byte at a time until the first inequality. Therefore, if you have to convert a numeric DATE variable to a string, the only format that works is FORMAT( DATEvariable, "yyyy-mm-dd hh:nn:ss" ) to produce a date and time string looking like 2023-06-13 09:50:31 - showing IN ORDER year, month, day, hour, minute, second. In that format only, you can do a date comparison of two strings and still get a meaningful result from the ">=" operator.

 

[561414]

Thank you @561414

I would like to ask for further guidance on how to compare the retrieved date with a specific date. for example: if the retrieved date >= 10/15/2023.
since the code you provided is working well.

Sure, modify the sub and make it return a date with dd/mm/yyyy as format. Since it returns something like this: Tue, 13 Jun 2023 17:10:34 GMT, we can extract the date starting from the 6th character, with a lenght of 11 characters using the Mid function. After that, we cast it into a date string. For this, I had to make sure the IsDate function returns true for a string like this: 13 Jun 2023, it does return true.

Function getTime() As Date
    Dim req As Object
    Set req = CreateObject("MSXML2.ServerXMLHTTP")
    req.Open "GET", "https://whatever.firebaseio.com/"
    req.send
  
    Dim long_date As Variant
    long_date = req.getResponseHeader("Date")

    Dim short_date As Variant
    short_date = Mid(long_date, 6, 11)
  
    getTime = CDate(short_date)
  
End Function

Let's compare now. For that, I could use another function like

Function daysLeft(strLimitDate, strTestDate) As Long
    ' cast the strings to date then to long
    Dim limit As Long: limit = CLng(CDate(strLimitDate))
    Dim test As Long: test = CLng(CDate(strTestDate))
  
    daysLeft = limit - test
End Function

With that function, we simply check daysLeft is not 0 or below, so we can use it in another sub like

Sub CheckLicense()
    Dim days As Long
  
    ' change that date to test it
    days = daysLeft("10/15/2023", getTime)
    If days <= 0 Then
        MsgBox "Limit reached, app downgraded."
    Else
        MsgBox "You have " & days & " left to use the app."
    End If
End Sub

Of course, do your own tests. Dates are tricky in all languages.

EDIT:
This is a general guidance, use the DateSerial function to be explicit in your dates. For instance, 1/12/2023 could be January 12th or December 1st. Another approach could be to cast the server date to date, then to long and modify the rest of the code. And that is not the only approach, there are more.

 

[Pop_Access]

i made simple form (Form1) which will get the server date.
you modify the Load Event and put the Server address on the Constant SERVER.

@arnelgp
"Thank you so much for your support.

I greatly appreciate your assistance, and I'm pleased to inform you that the code is working well. I have gained valuable knowledge from this experience.

I would like to take a moment to share a lesson I learned from this scenario. During the implementation, I encountered an issue where I lacked the necessary permission to access the server date.

 

[Pop_Access]

There are multiple formats to consider... data types Date for VBA or tables or queries, and String for VBA or ShortText for tables or queries. They don't always directly inter-compare and the use of ">=" as a comparison operator means you have to be a bit tricky.

Data type "DATE" is a numeric date that is a typecast (i.e. interpretation) of data type DOUBLE. It is possible, when both dates are in DATE format, to directly compare IF ( Date1 >= Date2 ) Then ... and get a true/false result. Note that type DATE includes time in the mix. Therefore, if you assign a value to a DATE variable, be aware that NOW() and DATE() are two functions that would return a DATE data type, but NOW() includes time and DATE() does not. So if comparing DATE data types from different sources, be sure you know whether time is involved. That is because NOW() equals DATE() for only 1 in 86,400 seconds. Otherwise, NOW() is greater than (later than) DATE() except exactly at midnight.

A problem comes into play when a text or string data type is involved in the comparison. When you retrieve a date, you have good odds that it came back as a formatted string. Approaches exist that would allow you to compare string-based times. The simplest method uses function CDATE() to convert a string representation of a date and time into a DATE data type for numeric comparison. In that case, you can compare IF CDATE(StringDate1) >= CDATE(StringDate2) Then ... and again get a valid true/false result. IF you have a mixed case, the first thing to try is to compare the DATE variable against CDATE() of the STRING variable, as IF CDATE(StringDate) >= DATEDate Then ... to manage the comparison.

The other type of comparison is possible, but requires special formatting. You see, doing a STRING compare doesn't follow numeric comparison rules. When comparing strings "2" is greater than "10" because it runs one byte at a time until the first inequality. Therefore, if you have to convert a numeric DATE variable to a string, the only format that works is FORMAT( DATEvariable, "yyyy-mm-dd hh:nn:ss" ) to produce a date and time string looking like 2023-06-13 09:50:31 - showing IN ORDER year, month, day, hour, minute, second. In that format only, you can do a date comparison of two strings and still get a meaningful result from the ">=" operator.

@The_Doc_Man
Thank you for clarifying date formats and comparisons. Your insights were invaluable. Much appreciated.

 

[Pop_Access]

Sure, modify the sub and make it return a date with dd/mm/yyyy as format. Since it returns something like this: Tue, 13 Jun 2023 17:10:34 GMT, we can extract the date starting from the 6th character, with a lenght of 11 characters using the Mid function. After that, we cast it into a date string. For this, I had to make sure the IsDate function returns true for a string like this: 13 Jun 2023, it does return true.

Function getTime() As Date
    Dim req As Object
    Set req = CreateObject("MSXML2.ServerXMLHTTP")
    req.Open "GET", "https://whatever.firebaseio.com/"
    req.send
 
    Dim long_date As Variant
    long_date = req.getResponseHeader("Date")

    Dim short_date As Variant
    short_date = Mid(long_date, 6, 11)
 
    getTime = CDate(short_date)
 
End Function

Let's compare now. For that, I could use another function like

Function daysLeft(strLimitDate, strTestDate) As Long
    ' cast the strings to date then to long
    Dim limit As Long: limit = CLng(CDate(strLimitDate))
    Dim test As Long: test = CLng(CDate(strTestDate))
 
    daysLeft = limit - test
End Function

With that function, we simply check daysLeft is not 0 or below, so we can use it in another sub like

Sub CheckLicense()
    Dim days As Long
 
    ' change that date to test it
    days = daysLeft("10/15/2023", getTime)
    If days <= 0 Then
        MsgBox "Limit reached, app downgraded."
    Else
        MsgBox "You have " & days & " left to use the app."
    End If
End Sub

Of course, do your own tests. Dates are tricky in all languages.

EDIT:
This is a general guidance, use the DateSerial function to be explicit in your dates. For instance, 1/12/2023 could be January 12th or December 1st. Another approach could be to cast the server date to date, then to long and modify the rest of the code. And that is not the only approach, there are more.

@561414
I wanted to reach out and express my heartfelt appreciation for providing the solution that successfully resolved my problem.
Your support has made a positive impact, and I truly appreciate it.
=================
I would like to extend my sincere gratitude and appreciation to all members of this forum for your valuable contributions.
thank you for your dedication and the time you invested in helping us.

 

[561414]

I'm happy to help. Good luck in your project!