I have an application that runs off deadlines. I had been using the system date/time off the users computer. But now some of them are merely changing the clocks on there PC to get around it.
At one point of time, I wrote a text file on a server, then read the timestamp
There are however some APIs that can be used. I haven't use them, but I'm sure some samples can be found on Randy Birch's page - see if you can adapt some of this, perhaps
I tried using this ... but it crashes everything on peoples machines off the run time access version.
Seems NetRemoteTOD causes runtime error.
Private Declare Function NetRemoteTOD Lib "netapi32.dll" (yServer As Any, pBuffer As Long) As Long
Private Declare Function NetApiBufferFree Lib "netapi32.dll" (ByVal pBuffer As Long) As Long
Private Declare Sub CopyMem Lib "kernel32.dll" Alias "RtlMoveMemory" (pTo As Any, uFrom As Any, ByVal lSize As Long)
Private Type TIME_OF_DAY_INFO
telapsed As Long
tmsecs As Long
thours As Long
tmins As Long
tsecs As Long
thunds As Long
ttimezone As Long
ttinterval As Long
tday As Long
tmonth As Long
tyear As Long
tweekday As Long
End Type
'Purpose : Return the time of a remote or local machine
'Inputs : [sServerName] The name of the machine to return the time of.
' If unspecified returns time on local machine.
'Outputs : The date and time on the specified machine
Function GetCurrentDate(Optional sServerName As String) As Date
Dim tTime As TIME_OF_DAY_INFO
Dim lRet As Long, lpBuffer As Long
Dim abServer() As Byte
10 On Error GoTo PROC_ERR
20 ERH_PushStack_TSB ("GetCurrentDate")
'GetCurrentDate = Now()
'Exit Function
30 If fUserNTDomain = "...S" Then
40 sServerName = "\\..."
50 Else
60 sServerName = "\\..."
70 End If
80 If Len(sServerName) Then
'Check the syntax of the sServerName string
90 If InStr(sServerName, "\\") = 1 Then
100 abServer = sServerName & vbNullChar
110 Else
120 abServer = "\\" & sServerName & vbNullChar
130 End If
140 lRet = NetRemoteTOD(abServer(0), lpBuffer)
150 Else
'Local machine
160 lRet = NetRemoteTOD(vbNullString, lpBuffer)
170 End If
180 CopyMem tTime, ByVal lpBuffer, Len(tTime)
190 If lpBuffer Then
200 Call NetApiBufferFree(lpBuffer)
210 End If
This site uses cookies to help personalise content, tailor your experience and to keep you logged in if you register.
By continuing to use this site, you are consenting to our use of cookies.