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
Date On Server
Reply With Quote
