GetTimefromRmServer




Option Explicit
Private Declare Function NetRemoteTOD Lib "NETAPI32.DLL" _
(ByVal server As String, buffer As Any) As Long
Private Declare Function NetApiBufferFree Lib "NETAPI32.DLL" _
(ByVal buffer As Long) As Long
Private Declare Sub CopyMemory Lib "KERNEL32" Alias "RtlMoveMemory" _
(hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
Private Type TIME_OF_DAY
t_elapsedt As Long
t_msecs As Long
t_hours As Long
t_mins As Long
t_secs As Long
t_hunds As Long
t_timezone As Long
t_tinterval As Long
t_day As Long
t_month As Long
t_year As Long
t_weekday As Long
End Type
Private Sub Command1_Click()
Dim t As TIME_OF_DAY
Dim tPtr As Long
Dim res As Long
Dim szServer As String,
Dim days As Date
Dim todays As Date
'

' Replace \\ntsig with your NT server that you want to get the time from

'

szServer = StrConv("\\ntsig", vbUnicode) 'Convert the server name to unicode
res = NetRemoteTOD(szServer, tPtr) 'You could also pass vbNullString for the server name
If res = 0 Then
CopyMemory t, ByVal tPtr, Len(t) 'Copy the pointer returned to a TIME_OF_DAY structure
days = DateSerial(70, 1, 1) + (t.t_elapsedt / 60 / 60 / 24) 'Convert the elapsed time since 1/1/70 to a date
days = days - (t.t_timezone / 60 / 24) 'Adjust for TimeZone differences
'Get local computer information for comparison

todays = DateSerial(70, 1, 1) + (DateDiff("s", DateSerial(70, 1, 1), Now()) / 60 / 60 / 24)
Me.Cls
Print DateDiff("s", DateSerial(70, 1, 1), Now()), todays, t.t_elapsedt, days
NetApiBufferFree (tPtr) 'Free the memory at the pointer
Else
MsgBox "Error occurred Call NetRemoteTOD: " & res, vbOKOnly, "NetRemoteTOD"
'Error 53: cannot find server

End If
End Sub











( gettimefromrmserver.html )- by Paolo Puglisi - Modifica del 17/12/2023