MakeIT II

在Windows CE的平台上如果要做SNTP自動校時的功能我們應該要如何實做呢？下面這邊有些相關資料可以參考

• SNTP Client in C#
• RFC 2030

 

下面的是參考上面所提的C#範例修改過來的(開發平台是VS2003在CE4.2上面)，省略了很多部分，有興趣的可以參考看看

''共用模組(設定系統時間的API)

''共用模組(設定系統時間的API)
 _
    Public Structure SYSTEMTIME
        Public year As Short
        Public month As Short
        Public dayOfWeek As Short
        Public day As Short
        Public hour As Short
        Public minute As Short
        Public second As Short
        Public milliseconds As Short
    End Structure 'SYSTEMTIME

 _
    Public Function SetLocalTime(ByRef time As SYSTEMTIME) As Boolean
    End Function

 _
    Public Function SetSystemTime(ByRef time As SYSTEMTIME) As Boolean
    End Function

''主程式Form1，上面有TextBox1(用來顯示訊息),Button(名稱為btnSyncTime)，
''TextBox(名稱為txtServerName，用來放校時主機的IP位址)

    ''傳送給校時主機用
    Dim btySend(47) As Byte
    ''接收資料用
    Dim btyRecv(47) As Byte

    Private Sub btnSyncTime_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnSyncTime.Click

        Dim UDP As New UdpClient
        Dim RemoteEP As New IPEndPoint(IPAddress.Parse(txtServerName.Text), 123)
        UDP.Connect(RemoteEP)
        GetData(btySend)
        UDP.Send(btySend, btySend.Length)
        btyRecv = UDP.Receive(RemoteEP)
        ''判斷接收到的資料是否有異常
        If btyRecv(0) >> 6 <> 0 Then
            ''異常情形的處理
            TextBox1.Text = "Error"
        End If

        TextBox1.Text = "Reference Timesstamp:"
        TextBox1.Text &= ComputeDate(GetMilliSeconds(16)).ToString & vbCrLf
        TextBox1.Text &= "Originate Timesstamp:"
        TextBox1.Text &= ComputeDate(GetMilliSeconds(24)).ToString & vbCrLf
        TextBox1.Text &= "Receive Timesstamp:"
        TextBox1.Text &= ComputeDate(GetMilliSeconds(32)).ToString & vbCrLf
        TextBox1.Text &= "Transmit Timesstamp:"
        TextBox1.Text &= ComputeDate(GetMilliSeconds(40)).ToString
        Dim systemtime1 As SYSTEMTIME
        Dim time1 As DateTime = CDate(ComputeDate(GetMilliSeconds(40)).ToString)
        ''取的的時間為UTC時間，要加上8小時才是台灣這邊的時間
        time1 = time1.AddHours(8)
        systemtime1.year = CType(time1.Year, Short)
        systemtime1.month = CType(time1.Month, Short)
        systemtime1.dayOfWeek = CType(time1.DayOfWeek, Short)
        systemtime1.day = CType(time1.Day, Short)
        systemtime1.hour = CType(time1.Hour, Short)
        systemtime1.minute = CType(time1.Minute, Short)
        systemtime1.second = CType(time1.Second, Short)
        systemtime1.milliseconds = CType(time1.Millisecond, Short)
        SetLocalTime(systemtime1)
        UDP.Close()
    End Sub

    ''取得要傳送給SNTP Server的封包
    Private Sub GetData(ByRef Data() As Byte)
        Dim intPart As Long = 0
        Dim FractPart As Long = 0
        Dim T As New TimeSpan
        Dim milliseconds As Long
        Dim strtmp As String = ""

        ''取得現在時間與1900/1/1的毫秒差
        Dim NowDate As DateTime = DateTime.Now
        T = NowDate.Subtract(CDate("1900/1/1 00:00:00"))
        milliseconds = T.TotalMilliseconds
        intPart = milliseconds / 1000
        FractPart = ((milliseconds Mod 1000) * &H 100000000L ) / 1000
        Data(0) = 27
        strtmp = Hex(intPart)
        For x As Integer = 1 To 8 - strtmp.Length
            strtmp = 0 & strtmp
        Next
        Data(40) = CInt("&H" & strtmp.Substring(0, 2))
        Data(41) = CInt("&H" & strtmp.Substring(2, 2))
        Data(42) = CInt("&H" & strtmp.Substring(4, 2))
        Data(43) = CInt("&H" & strtmp.Substring(6, 2))
        strtmp = Hex(FractPart)
        For x As Integer = 1 To 8 - strtmp.Length
            strtmp = 0 & strtmp
        Next
        Data(44) = CInt("&H" & strtmp.Substring(0, 2))
        Data(45) = CInt("&H" & strtmp.Substring(2, 2))
        Data(46) = CInt("&H" & strtmp.Substring(4, 2))
        Data(47) = CInt("&H" & strtmp.Substring(6, 2))
    End Sub

    ''將毫秒資料轉換為日期格式
    Private Function ComputeDate(ByVal milliseconds As Long) As DateTime
        Dim span As TimeSpan = TimeSpan.FromMilliseconds(CDbl(milliseconds))
        Dim time As DateTime = New DateTime(1900, 1, 1)
        time = time.Add(span)
        Return time
    End Function

    ''將收到的byte資料轉換為日期時間資料
    Private Function GetMilliSeconds(ByVal offset As Byte) As Long
        Dim intpart As Long = 0
        Dim fractpart As Long = 0
        ''每組日期時間為8bytes,分為整數與小數部份
        For i As Integer = 0 To 3
            intpart = 256 * intpart + btyRecv(offset + i)
        Next
        For i As Integer = 4 To 7
            fractpart = 256 * fractpart + btyRecv(offset + i)
        Next
        Dim milliseconds As Long = intpart * 1000 + (fractpart * 1000) / &H 100000000L
        Return milliseconds
    End Function