Visual Basic Programming Code Examples

Obtain the time of an NT Server-Machine It is often useful (especially when writing records to file based databases like Access) to establish the time on a specific server. The following function obtains the date and time of a specified NT Server/Machine. 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 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 Declare Sub CopyMemory Lib "KERNEL32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long) Private Type TIME_OF_DAY lElapsedt As Long lMSecs As Long lHours As Long lMins As Long lSecs As Long lHunds As Long lTimezone As Long lTInterval As Long lDay As Long lMonth As Long lYear As Long lWeekday 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 ((32 * 2) - 1)) As Byte 'unicode StandardDate As SYSTEMTIME StandardBias As Long DaylightName(0 To ((32 * 2) - 1)) As Byte 'unicode DaylightDate As SYSTEMTIME DaylightBias As Long End Type 'Purpose : Obtains the time on an NT Server 'Inputs : [sServerName] The name of the NT Server to obtain the time on. ' If empty, obtains time of Logon Server (see notes). 'Outputs : Returns the time on the specified machine 'Notes : To get the time of the logon server use ' dtLogonServer = ServerGetTime(Environ$("LOGONSERVER")) Function ServerGetTime(Optional ByVal sServerName As String) As Date Dim tServerDate As TIME_OF_DAY, lprtTime As Long, lRetVal As Long Dim suServer As String, dtDays As Date Dim tSystimeUTC As SYSTEMTIME Dim tSystimeLocal As SYSTEMTIME Dim tTimeZoneInfo As TIME_ZONE_INFORMATION If Left$(sServerName, 2) <> "\\" And Len(sServerName) > 0 Then sServerName = "\\" & sServerName End If 'Convert server name to unicode suServer = StrConv(sServerName, vbUnicode) lRetVal = NetRemoteTOD(suServer, lprtTime) If lRetVal = 0 Then 'Copy pointer to structure CopyMemory tServerDate, ByVal lprtTime, Len(tServerDate) 'Obtain the time zone info. for the local machine Call GetTimeZoneInformation(tTimeZoneInfo) 'Copy the TIME_OF_DAY_INFO info into the SYSTEMTIME structure. With tSystimeUTC .wDay = tServerDate.lDay .wDayOfWeek = tServerDate.lWeekday .wMonth = tServerDate.lMonth .wYear = tServerDate.lYear .wHour = tServerDate.lHours .wMinute = tServerDate.lMins .wSecond = tServerDate.lSecs End With 'Convert the time to the corresponding time zone on the local machine. 'Note, passing a empty TIME_ZONE_INFORMATION structure causes the function 'to use the active time zone for the local machine. Call SystemTimeToTzSpecificLocalTime(tTimeZoneInfo, tSystimeUTC, tSystimeLocal) 'Reassign the converted date members to the output date With tServerDate .lMins = tSystimeLocal.wMinute .lHours = tSystimeLocal.wHour .lSecs = tSystimeLocal.wSecond .lDay = tSystimeLocal.wDay .lMonth = tSystimeLocal.wMonth .lYear = tSystimeLocal.wYear .lWeekday = tSystimeLocal.wDayOfWeek End With 'Convert the time since 1/1/70 ServerGetTime = DateSerial(70, 1, 1) + (tServerDate.lElapsedt / 60 / 60 / 24) 'Adjust for TimeZone differences ServerGetTime = ServerGetTime - (tServerDate.lTimezone / 60 / 24) 'Free memory Call NetApiBufferFree(ByVal lprtTime) End If End Function 'Example code Private Sub Form_Load() Debug.Print ServerGetTime(Environ$("LOGONSERVER")) End Sub