Get Time from Remote NT Server

Author: Lothar Haensler

This small piece of code returns a VB Date and will raise an error if the

NetRemoteTOD

– API call fails. It takes care of all time-zone information – place the following code into a standard BAS module :

option Explicit
'
'
private Declare Function NetRemoteTOD Lib "Netapi32.dll" ( _
    tServer as Any, pBuffer as Long) as Long
'
private 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
'
private Type TIME_ZONE_INFORMATION
    Bias as Long
    StandardName(32) as Integer
    StandardDate as SYSTEMTIME
    StandardBias as Long
    DaylightName(32) as Integer
    DaylightDate as SYSTEMTIME
    DaylightBias as Long
End Type
'
private Declare Function GetTimeZoneInformation Lib "kernel32" _
        (lpTimeZoneInformation as TIME_ZONE_INFORMATION) as Long
'
private Declare Function NetApiBufferFree Lib "Netapi32.dll" _
        (byval lpBuffer as Long) as Long
'
private Type TIME_OF_DAY_INFO
    tod_elapsedt as Long
    tod_msecs as Long
    tod_hours as Long
    tod_mins as Long
    tod_secs as Long
    tod_hunds as Long
    tod_timezone as Long
    tod_tinterval as Long
    tod_day as Long
    tod_month as Long
    tod_year as Long
    tod_weekday as Long
End Type
'
private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
        (Destination as Any, Source as Any, byval Length as Long)
'
'
public Function getRemoteTOD(byval strServer as string) as date
'    
    Dim result as date
    Dim lRet as Long
    Dim tod as TIME_OF_DAY_INFO
    Dim lpbuff as Long
    Dim tServer() as Byte
'
    tServer = strServer & vbNullChar
    lRet = NetRemoteTOD(tServer(0), lpbuff)
'    
    If lRet = 0 then
        CopyMemory tod, byval lpbuff, len(tod)
        NetApiBufferFree lpbuff
        result = DateSerial(tod.tod_year, tod.tod_month, _
                            tod.tod_day) + _
        TimeSerial(tod.tod_hours, tod.tod_mins - tod.tod_timezone, _
                   tod.tod_secs)
        getRemoteTOD = result
    else
        Err.Raise Number:=vbObjectError + 1001, _
        Description:="cannot get remote TOD"
    End If
'
End Function

– to use in your program, call it like this :

private Sub Command1_Click()
    Dim d as date
'
    d = GetRemoteTOD("your NT server name goes here")
    MsgBox d
End Sub
'
'
'

Download BAS module