time sync? - RESOLVED

[cajsoft]

I would like to be able to sync the time on my computers with a server on the network. I cannot use the NET command as some computers reside on a domain and others in a workgroup.

Is there a way to accomplish this with V.B. Can I connect to a server on the network and copy it's time to the local machine?

[jemidiah]

I believe http://www.analogx.com/contents/down...etwork/ats.htm allows you to manually change servers. Hope that's enough

[cajsoft]

Originally posted by jemidiah
I believe http://www.analogx.com/contents/down...etwork/ats.htm allows you to manually change servers. Hope that's enough

Thanks for the info, but I've found a API call to do it.

Cheers.

[Mark Gambo]

I was reading one of your posts regarding time syncing:

http://vbforums.com/showthread.php?s=&threadid=263811&highlight=Getting+Time+from+Server

I was wondering what was the API Call you found to accomplish this?

Thanks

[cajsoft]

Private Type NETRESOURCE
    lngScope As Long                'To Specify scope during enumeration.
    lngType As Long                 'Defines the type of Resource.
    lngDisplayType As Long          'How resources will be displayed
    lngUsage As Long                'Specifies the Resource usage.
    strLocalName As String          'Local Device for the connection
    strRemoteName As String         'Indicates the Network Resource
    strComment As String            'For a Provider-Supplied Comment.
    strProvider As String           'Name of Provider who owns theresource.
End Type

Const RESOURCETYPE_ANY = &H0         'These are some useful
Const RESOURCETYPE_DISK = &H1        'Constants to be used
Const RESOURCETYPE_PRINT = &H2       'with many of the WNet
Const RESOURCETYPE_UNKNOWN = &HFFFF  'Functions.
Const CONNECT_UPDATE_PROFILE = &H1

Public srvr As String

Private Declare Function WNetAddConnection2 Lib "mpr.dll" Alias "WNetAddConnection2A" (lpNetResource As _
        NETRESOURCE, ByVal lpPassword As String, ByVal lpUserName As String, ByVal dwFlags As Long) As Long
Private Declare Function WNetCancelConnection2 Lib "mpr.dll" Alias _
      "WNetCancelConnection2A" (ByVal lpName As String, _
      ByVal dwFlags As Long, ByVal fForce As Long) As Long


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 ti As TIME_OF_DAY_INFO


Private Type HiLoInt
    loInt As Integer
    hiInt As Integer
End Type

Dim TwoInt As HiLoInt

Private Type LongType
    l As Long
End Type

Dim lLong As LongType

Private Declare Function NetRemoteTOD Lib "netapi32.dll" (ServerName As Any, buffer As Any) As Long

Private Declare Function DataFromPtr Lib "kernel32" Alias "lstrcpynW" (RetVal As Any, ByVal Ptr As Long, ByVal nCharCount As Long) As Long

Private Declare Function NetAPIBufferFree Lib "netapi32.dll" Alias "NetApiBufferFree" (ByVal Ptr As Long) As Long




Private Sub Connect_Up(srvpath As String, username As String)

Dim ServerText As String, PassWordText As String
Dim DriveLetter As String
Dim Msg As String
Dim Succeed As Long
On Error GoTo errer

Dim nrConnect As NETRESOURCE            'Get NETRESOURCE var.

nrConnect.lngType = RESOURCETYPE_DISK           'Set Resource Type.
nrConnect.strLocalName = ""               'Get Drive Letter
nrConnect.strRemoteName = UCase$(srvpath)    'Path to resource
nrConnect.strProvider = ""                      'Unknown Provider.

PassWordText = "password"  'A Text Box for the PassWord
srvr = nrConnect.strRemoteName

Succeed = WNetAddConnection2(nrConnect, PassWordText, username, 0)
Exit Sub
errer:
MsgBox "Error: " & Err.Description & "(" & srvpath & " " & username & ")"
End Sub


Private Sub Command1_Click()
failed = False
start:
    
    Dim sName As String
    Dim pbServer() As Byte
    Dim ptmpBuffer As Long

    Dim lRetVal As Long


    'Set the NT server name
    sName = "\\MYSERVER1"

    'Convert the name to a Unicode byte array
    pbServer = sName & vbNullChar

    'Call the NetRemoteTOD function
    lRetVal = NetRemoteTOD(pbServer(0), ptmpBuffer)
    
    
    
    If lRetVal <> 0 Then
        MsgBox "Failed"
        If failed = False Then
            Connect_Up sName, "MY_DOMAIN\myuser"
            failed = True
            GoTo start
        End If
    
        failed = True
        
        'Function failed
        Exit Sub
    End If

    'Extract the information into a TIME_OF_DAY_INFO structure

    'Get first element of the structure
    lRetVal = DataFromPtr(ti.tod_elapsedt, ptmpBuffer, 4)
    'Get second element of the structure
    lRetVal = DataFromPtr(ti.tod_msecs, ptmpBuffer + 4, 4)
    'Get third element of the structure
    lRetVal = DataFromPtr(ti.tod_hours, ptmpBuffer + 8, 4)
    '....
    lRetVal = DataFromPtr(ti.tod_mins, ptmpBuffer + 12, 4)
    lRetVal = DataFromPtr(ti.tod_secs, ptmpBuffer + 16, 4)
    lRetVal = DataFromPtr(ti.tod_hunds, ptmpBuffer + 20, 4)
    lRetVal = DataFromPtr(ti.tod_timezone, ptmpBuffer + 24, 4)
    lRetVal = DataFromPtr(ti.tod_tinterval, ptmpBuffer + 28, 4)
    lRetVal = DataFromPtr(ti.tod_day, ptmpBuffer + 32, 4)
    lRetVal = DataFromPtr(ti.tod_month, ptmpBuffer + 36, 4)
    lRetVal = DataFromPtr(ti.tod_year, ptmpBuffer + 40, 4)
    'Get last element of the structure
    lRetVal = DataFromPtr(ti.tod_weekday, ptmpBuffer + 44, 4)



    'Convert to local time
    If ti.tod_timezone <> -1 Then
        ti.tod_hours = ti.tod_hours - ti.tod_timezone \ 60
    End If
    If ti.tod_hours = 24 Then ti.tod_hours = 0
    'Release the memory, allocated by NetRemoteTOD function
    NetAPIBufferFree ptmpBuffer
    MsgBox ti.tod_hours & ":" & ti.tod_mins
    
    Me.Print "Time: "; ti.tod_hours; ":"; ti.tod_mins; ":"; ti.tod_secs
    Me.Print "Date: "; ti.tod_day; "/"; ti.tod_month; "/"; ti.tod_year
    Time = ti.tod_hours & ":" & ti.tod_mins & ":" & ti.tod_secs
    Cancel_Connected
    End
End Sub

Private Sub Cancel_Connected()
    ErrInfo = WNetCancelConnection2(srvr, _
      CONNECT_UPDATE_PROFILE, False)
      If ErrInfo = NO_ERROR Then
        MsgBox "Net Disconnection Successful!", vbInformation, _
        "Share Disconnected"
      Else
        MsgBox "ERROR: " & ErrInfo & " - Net Disconnection Failed!", _
        vbExclamation, "Share not Disconnected"
      End If
End Sub