[VBnet Network] NetRemoteTOD: Get Time of Day Info for Local or Remote Machines

	Visual Basic Network Services NetRemoteTOD: Get Time of Day Info for Local or Remote Machines

Posted:	Saturday October 27, 2001
Updated:	Monday December 26, 2011

Applies to:	VB4-32, VB5, VB6
Developed with:	VB6, Windows 2000, Windows XP
OS restrictions:	Windows NT3.1, Windows NT4, Windows 2000, Windows XP
Author:	VBnet - Randy Birch

Related:	WM_TIMECHANGE: Detect System Changes to the Date/Time RegQueryValueEx: Identify Time Zones by Time Zone Bias SetSystemTime: SNTP Time Server Synchronization using Winsock SetSystemTime: Date and Time Synchronization to a Remote Server

Prerequisites

One of the operating systems listed under OS Restrictions above.

NetRemoteTOD returns the time of day information from a specified server. This API is only available on NT 3.1/NT4/Win 2000/XP or later, and no special group membership is required to execute NetRemoteTOD.

The illustration shows the two lists containing the results of two separate calls to the function - the call first passing the local machine as the "server", the second passing a networked machine. The highlighted list items show each machine's time in the UTC for the local machine (\\vbnetdev). The time zone bias and hours, minutes, etc. are returned, as well as the day and month info.

The elapsedt member of the TIME_OF_DAY_INFO structure represents the number of seconds since 00:00:00, January 1, 1970, GMT. As I am located -5 hours from Greenwich, the list item above the highlighted line shows the UTC time for each machine calculated using the elapsedt value returned. The date for both "Machine's Local time" fields were calculated from this UTC value by applying the bias adjustment (in minutes) returned in the timezone member.

Msecs is a DWORD containing the number of milliseconds from an arbitrary starting point (system reset). The MSDN states that the msecs value is typically read twice, once when the process begins and again at the end. To determine the elapsed time between the process's start and finish, you can subtract the first value from the second.

NetRemoteTOD will not accept an IP address as the servername parameter; servername must begin with \\. In addition, like other net* api calls, vbNullString can be passed as servername to specify the local machine. For accuracy comparison, the label at the bottom of the form contains the result of VB's Now function.

BAS Module Code

None.

Form Code

To a form add a command button (Command1) and two list boxes (List1, List2). Add a label (Label1) for the Now result, and label other fields as desired. Add the following to the form:

Option Explicit

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ©1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
'               applications, but you may not reproduce 
'               or publish this code on any web site,
'               online service, or distribute as source 
'               on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Private Const NERR_SUCCESS As Long = 0&
Private Const TIME_ZONE_ID_DAYLIGHT As Long = 2

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 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(0 To 63) As Byte  'unicode (0-based)
   StandardDate   As SYSTEMTIME
   StandardBias   As Long
   DaylightName(0 To 63) As Byte  'unicode (0-based)
   DaylightDate   As SYSTEMTIME
   DaylightBias   As Long
End Type

Private Declare Function NetRemoteTOD Lib "Netapi32" _
  (UncServerName As Byte, _
   BufferPtr As Long) As Long

Private Declare Function NetApiBufferFree Lib "Netapi32" _
  (ByVal lpBuffer As Long) As Long

Private Declare Sub CopyMemory Lib "kernel32" _
   Alias "RtlMoveMemory" _
  (pTo As Any, uFrom As Any, _
   ByVal lSize As Long)

Private Declare Function GetTimeZoneInformation Lib "kernel32" _
  (lpTimeZoneInformation As TIME_ZONE_INFORMATION) As Long
   
Private Declare Function SystemTimeToTzSpecificLocalTime Lib "kernel32" _
  (lpTimeZoneInformation As TIME_ZONE_INFORMATION, _
   lpUniversalTime As SYSTEMTIME, _
   lpLocalTime As SYSTEMTIME) As Long
   
   
Private Sub Command1_Click()

   Dim server_date As TIME_OF_DAY_INFO
   Dim sServer As String
   
   List1.Clear
   List2.Clear

  'Specify the server and pass to GetRemoteTOD.
  
  'The function returns the TIME_OF_DAY_INFO
  'data adjusted to accomodate the local
  'machine's regional location
  
  'Naturally, change the machine names to suit.
   sServer = "\\vbnetdev"
   server_date = GetRemoteTOD(sServer)
   DisplayData List1, server_date

   sServer = "\\laptop2000"
   server_date = GetRemoteTOD(sServer)
   DisplayData List2, server_date

End Sub


Private Function GetRemoteTOD(ByVal sServer As String) As TIME_OF_DAY_INFO

   Dim success       As Long
   Dim bServer()     As Byte
   Dim tod           As TIME_OF_DAY_INFO
   Dim systime_utc   As SYSTEMTIME
   Dim systime_local As SYSTEMTIME
   Dim tzi           As TIME_ZONE_INFORMATION
   Dim bufptr        As Long

  'A null passed as sServer retrieves
  'the date for the local machine. If
  'sServer is null, no slashes are added.
   If sServer <> vbNullChar Then
    
     'If a server name was specified,
     'assure it has leading double slashes
      If Left$(sServer, 2) <> "\\" Then
         bServer = "\\" & sServer & vbNullChar
      Else
         bServer = sServer & vbNullChar
      End If
      
   Else
   
     'null or empty string was passed
      bServer = sServer & vbNullChar
   
   End If
   
  'get the time of day (TOD) from the specified server
   If NetRemoteTOD(bServer(0), bufptr) = NERR_SUCCESS Then

     'copy the buffer into a
     'TIME_OF_DAY_INFO structure
      CopyMemory tod, ByVal bufptr, LenB(tod)

     'get the time zone data for the local machine
      Call GetTimeZoneInformation(tzi)

     'assign TIME_OF_DAY_INFO members to
     'the SYSTEMTIME structure and call
     'SystemTimeToTzSpecificLocalTime to
     'convert the UTC dates in
     'TIME_OF_DAY_INFO to local dates
      With systime_utc
         .wDay = tod.tod_day
         .wDayOfWeek = tod.tod_weekday
         .wMonth = tod.tod_month
         .wYear = tod.tod_year
         .wHour = tod.tod_hours
         .wMinute = tod.tod_mins
         .wSecond = tod.tod_secs
      End With
      
     'convert time in Coordinated Universal Time
     '(UTC) to the time zone's corresponding
     'local time. Passing a "null" TIME_ZONE_INFORMATION
     '(tzi) causes the function to use the currently
     'active time zone on the local machine.
      Call SystemTimeToTzSpecificLocalTime(tzi, systime_utc, systime_local)
 
     'reassign the converted date members to
     'the TIME_OF_DAY_INFO structure returned
     'from the function
      With tod
         .tod_mins = systime_local.wMinute
         .tod_hours = systime_local.wHour
         .tod_secs = systime_local.wSecond
         .tod_day = systime_local.wDay
         .tod_month = systime_local.wMonth
         .tod_year = systime_local.wYear
         .tod_weekday = systime_local.wDayOfWeek
      End With
      
   End If
   
   Call NetApiBufferFree(bufptr)
   
  'return the TIME_OF_DAY_INFO structure
   GetRemoteTOD = tod

End Function


Private Sub DisplayData(lst As ListBox, server_date As TIME_OF_DAY_INFO)

   Dim newtime  As Date
   
  'show the data returned
   With lst
      .AddItem server_date.tod_timezone
      .AddItem server_date.tod_tinterval
      .AddItem ""
      .AddItem server_date.tod_elapsedt
      .AddItem server_date.tod_msecs
      .AddItem ""
      .AddItem server_date.tod_hours
      .AddItem server_date.tod_mins
      .AddItem server_date.tod_secs
      .AddItem server_date.tod_hunds
      .AddItem ""
      .AddItem server_date.tod_day
      .AddItem server_date.tod_month
      .AddItem server_date.tod_year
      .AddItem server_date.tod_weekday
      .AddItem ""

      'Some dates for comparison.
      
      'The first shows calculating the
      'date using the tod_elapsedt member.
      'tod_elapsedt is a value that contains
      'the number of seconds since
      '00:00:00, January 1, 1970, GMT.
       newtime = DateAdd("s", server_date.tod_elapsedt, #1/1/1970#)
      .AddItem newtime
      
      'Since tod_elapsedt is based on GMT (UTC),
      'the next date applies the tod_timezone
      'offset to adjust the date to the local time.
       newtime = DateAdd("n", -server_date.tod_timezone, newtime)
      .AddItem newtime
      
   End With
   
  'Now shows the local machine's date
  'and time as per the local machine's
  'regional short date/short time formats
   Label1.Caption = Now
      
End Sub


Private Sub List1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
   
   On Error Resume Next
   List2.ListIndex = List1.ListIndex
   
End Sub


Private Sub List1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)

   On Error Resume Next
   List2.ListIndex = List1.ListIndex
   
End Sub


Private Sub List2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

   On Error Resume Next
   List1.ListIndex = List2.ListIndex

End Sub

Private Sub List2_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)

   On Error Resume Next
   List2.ListIndex = List2.ListIndex
   
End Sub

Comments

PayPal Link