dcsimg

Get Time from Remote NT Server

WEBINAR:
On-Demand

Desktop-as-a-Service Designed for Any Cloud ? Nutanix Frame



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


Comments

  • There are no comments yet. Be the first to comment!

  • You must have javascript enabled in order to post comments.

Leave a Comment
  • Your email address will not be published. All fields are required.

Most Popular Programming Stories

More for Developers

RSS Feeds

Thanks for your registration, follow us on our social networks to keep up-to-date