Synch system time using RFC 868 in VB.NET


Option Explicit On
Option Strict On
 
Imports System.Net.Sockets
Public Class Form1
    Inherits System.Windows.Forms.Form
 
#Region " Windows Form Designer generated code "
   
 
    Private Sub Button1_Click(ByVal sender As System.Object, _
        ByVal e As System.EventArgs) Handles Button1.Click
 
        Dim x As Long
        Dim Diff As Long
        Dim Host As String = "time-A.timefreq.bldrdoc.gov"
        Dim TCP As TcpClient
 
        Label1.Text = "Current time: " & CStr(System.DateTime.UtcNow) & vbCrLf
 
        TCP = New TcpClient
        TCP.Connect(Host, 37)
 
        Dim stream As NetworkStream = TCP.GetStream
        Dim b(3) As Byte
        stream.Read(b, 0, 4)
        stream.Close()
 
        x = CLng(b(0) * 256 ^ 3 + b(1) * 256 ^ 2 _
            + b(2) * 256 ^ 1 + b(3) * 256 ^ 0) 'time in seconds since 1/1/1900
 
        Debug.WriteLine(Host & " " & CStr(x))
 
        Dim ts As TimeSpan = System.TimeSpan.FromSeconds(x)
        Diff = DateDiff(DateInterval.Second, System.DateTime.UtcNow, #1/1/1900#.Add(ts))
        Label1.Text = Label1.Text & Host & " " & CStr(#1/1/1900#.Add(ts))
 
 
        Microsoft.VisualBasic.DateAndTime.TimeOfDay = _
            Microsoft.VisualBasic.DateAndTime.TimeOfDay.AddSeconds(Diff)
 
    End Sub
End Class

   You are visitor number 1986 for this page.
   Thursday, February 09, 2012