'*
'* 翔泳社 Windows Developer Magazine
'* 
'* 連載『ざっくりわかる、インターネットプログラミング』 サンプルソース
'* Copyright (C)2005 SHOEISYA & 山崎はるか
'* 
'* 翔泳社 http://www.shoeisha.com/mag/windev/
'*
'* 山崎はるか http://www.nda.co.jp/
'*

Imports System.Net 'IPHostEntry , IPEndPoint
Imports System.Net.Sockets 'UdpClient , SocketException
Imports System.Threading    'Thread


Public Class Form1
    Inherits System.Windows.Forms.Form

    Dim Bdata(47) As Byte   '送受信用バイナリ配列 (外部変数とする)


#Region " Windows フォーム デザイナで生成されたコード "

    Public Sub New()
        MyBase.New()

        ' この呼び出しは Windows フォーム デザイナで必要です。
        InitializeComponent()

        ' InitializeComponent() 呼び出しの後に初期化を追加します。

    End Sub

    ' Form は、コンポーネント一覧に後処理を実行するために dispose をオーバーライドします。
    Protected Overloads Overrides Sub Dispose(ByVal disposing As Boolean)
        If disposing Then
            If Not (components Is Nothing) Then
                components.Dispose()
            End If
        End If
        MyBase.Dispose(disposing)
    End Sub

    ' Windows フォーム デザイナで必要です。
    Private components As System.ComponentModel.IContainer

    ' メモ : 以下のプロシージャは、Windows フォーム デザイナで必要です。
    'Windows フォーム デザイナを使って変更してください。  
    ' コード エディタを使って変更しないでください。
    Friend WithEvents TextBox1 As System.Windows.Forms.TextBox
    <System.Diagnostics.DebuggerStepThrough()> Private Sub InitializeComponent()
        Me.TextBox1 = New System.Windows.Forms.TextBox
        Me.SuspendLayout()
        '
        'TextBox1
        '
        Me.TextBox1.Location = New System.Drawing.Point(0, 0)
        Me.TextBox1.Multiline = True
        Me.TextBox1.Name = "TextBox1"
        Me.TextBox1.ScrollBars = System.Windows.Forms.ScrollBars.Vertical
        Me.TextBox1.Size = New System.Drawing.Size(280, 248)
        Me.TextBox1.TabIndex = 0
        Me.TextBox1.Text = ""
        '
        'Form1
        '
        Me.AutoScaleBaseSize = New System.Drawing.Size(5, 12)
        Me.ClientSize = New System.Drawing.Size(336, 302)
        Me.Controls.Add(Me.TextBox1)
        Me.Name = "Form1"
        Me.Text = "NTPサーバー"
        Me.ResumeLayout(False)

    End Sub

#End Region

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load

        Dim receive As New Thread(AddressOf ReceiveThread)
        receive.Start()

    End Sub

    Private Sub ReceiveThread()
        '設定
        Dim udpc As UdpClient = New UdpClient(123)
        Dim EPhost As IPEndPoint = New IPEndPoint(IPAddress.Any, 123)
        Dim rt As Decimal

        While True
            '受信
            Bdata = udpc.Receive(EPhost)
            TextBox1.Text += DateTime.Now.ToString + " " + EPhost.Address.ToString + ":" + EPhost.Port.ToString + ControlChars.CrLf
            If Bdata(0) > 0 Then
                rt = GetDecimalSec(40)  '相手方の送信タイムスタンプを取得

                Dim a As Long               'バッファクリア
                For a = 0 To 47
                    Bdata(a) = 0
                Next
                Bdata(0) = &H1C
                Bdata(1) = &H1      'ストラタム1
                Bdata(12) = &H4C    'L
                Bdata(13) = &H4F    'O
                Bdata(14) = &H43    'C
                Bdata(15) = &H4C    'L
                SetDecimalSec(24, RetCalDate(rt))
                SetDecimalSec(32, DateTime.UtcNow)
                SetDecimalSec(40, DateTime.UtcNow)

                udpc.Connect(EPhost)           '送信
                udpc.Send(Bdata, Bdata.Length)
                udpc.Close()                   '切断（解放）

                EPhost.Address = IPAddress.Any '再設定
                EPhost.Port = 0
                udpc = New UdpClient(123)      '再定義
            End If

        End While
    End Sub

    'バイト配列の指定部分から 1900/1/1を基準とした相対秒数を取得
    Private Function GetDecimalSec(ByVal offset As Byte) As Decimal
        Dim sa1 As Decimal = 0  '秒の整数部
        Dim sa2 As Decimal = 0  '秒の端数部
        Dim a As Integer

        For a = 0 To 3
            sa1 = 256 * sa1 + Bdata(offset + a)
        Next
        For a = 4 To 7
            sa2 = 256 * sa2 + Bdata(offset + a)
        Next

        GetDecimalSec = Decimal.Floor(sa1 * 1000 + (sa2 * 1000) / &H100000000L)
    End Function

    'バイト配列の指定部分に 1900/1/1を基準とした相対秒数をセット
    Private Sub SetDecimalSec(ByVal offset As Byte, ByVal aday As DateTime)

        Dim sa1 As Decimal = 0  '秒の整数部
        Dim sa2 As Decimal = 0  '秒の端数部
        Dim a As Integer
        Dim n As Decimal

        Dim basetime As DateTime = New DateTime(1900, 1, 1, 0, 0, 0)
        Dim msec As Decimal = aday.Subtract(basetime).TotalMilliseconds

        sa1 = Int(msec / 1000)
        sa2 = Int(((msec Mod 1000) * &H100000000L) / 1000)

        n = sa1
        For a = 3 To 0 Step -1
            Bdata(offset + a) = Int(n Mod 256)
            n = n / 256
        Next
        n = sa2
        For a = 7 To 4 Step -1
            Bdata(offset + a) = Int(n Mod 256)
            n = n / 256
        Next

    End Sub

    'ミリセカンド(msec) を ベースの1900/1/1 に加算して、日付・時刻を得る
    Private Function RetCalDate(ByVal msec As Decimal) As DateTime
        Dim ts As TimeSpan = TimeSpan.FromMilliseconds(msec)
        Dim time As DateTime = New DateTime(1900, 1, 1)

        time = time.Add(ts)
        RetCalDate = time
    End Function

    Private Sub Form1_Closed(ByVal sender As Object, ByVal e As System.EventArgs) Handles MyBase.Closed
        End
    End Sub

    Private Sub Form1_Resize(ByVal sender As Object, ByVal e As System.EventArgs) Handles MyBase.Resize
        TextBox1.Width = Me.ClientSize.Width
        TextBox1.Height = Me.ClientSize.Height
    End Sub
End Class
