Search Tools Links Login

Get Remote Time and Date


Say you to check the time and date of a remote computer, be it a server or workstation. Here is how you do it.

Module

Option Explicit

'API Structures
Type TIME_OF_DAY_INFO
    tod_elapsed 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

'NetAPI Calls
Public Declare Function NetRemoteTOD Lib "netapi32.dll" (yServer As Any, pBuffer As Long) As Long
Private Declare Function NetApiBufferFree Lib "netapi32.dll" (ByVal pBuffer As Long) As Long
'Kernel API Calls
Private Declare Sub CopyMem Lib "kernel32.dll" Alias "RtlMoveMemory" (pTo As Any, uFrom As Any, ByVal lSize As Long)

'Return the Time and Date of a specified Machine on the Net
Public Function GetRemoteTime(ServerName As String) As Date
    Dim lpBuffer As Long
    Dim t_struct As TIME_OF_DAY_INFO
    Dim ret As Long
    Dim bServer() As Byte

    If Trim(ServerName) = "" Then
        'Local machine
        ret = NetRemoteTOD(vbNullString, lpBuffer)
    Else
        'Check the syntax of the ServerName string
        If InStr(ServerName, "\\") = 1 Then
            bServer = ServerName & vbNullChar
        Else
            bServer = "\\" & ServerName & vbNullChar
        End If
        ret = NetRemoteTOD(bServer(0), lpBuffer)
    End If
    CopyMem t_struct, ByVal lpBuffer, Len(t_struct)
    If lpBuffer Then
        Call NetApiBufferFree(lpBuffer)
    End If
    GetRemoteTime = DateSerial(t_struct.tod_year, t_struct.tod_month, t_struct.tod_day) + TimeSerial(t_struct.tod_hours, t_struct.tod_mins - t_struct.tod_timezone, t_struct.tod_secs)
End Function

Usage

Get the time and date of the local machine

Private Sub Command1_Click()
    MsgBox GetRemoteTime("")
End Sub

Get the time and date a remote Workstation

Private Sub Command2_Click()
    MsgBox GetRemoteTime("\\MYWORKSTATION")
End Sub

About this post

Posted: 2019-10-03
By: AndreaTincani
Viewed: 305 times

Categories

Visual Basic 6

Attachments

No attachments for this post

Special Instructions

This code originally appeared on AndreaVB.com, and has been republished here with the permission of Andrea Tincani.


Loading Comments ...

Comments

No comments have been added for this post.

You must be logged in to make a comment.

ADODB.Connection error '800a0e79'

Operation is not allowed when the object is open.

/assets/inc/inc_footer.asp, line 37