API DECLARTIONS

Visual Basic 4 / 5 / 6 Syntax (Toggle Plain Text)

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)

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)

MODULE

Visual Basic 4 / 5 / 6 Syntax (Toggle Plain Text)

'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

'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

Visual Basic 4 / 5 / 6 Syntax (Toggle Plain Text)

'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

'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