如何取得互联网上的时钟?

侃侃2016 2008-09-08 10:35:29

如何取得互联网上的时钟?

...全文

163 7 打赏收藏转发到动态举报

写回复

用AI写文章

7 条回复

切换为时间正序

请发表友善的回复…

发表回复

it_gz_xi 2008-09-10

打赏
举报

路过

华芸智森 2008-09-09

打赏
举报

VB6.0版完整源程序





Option Explicit



Dim SvrName(14) As String

'



Private Sub SetTime()



    On Error Resume Next

    

    Dim i As Long

    For i = 1 To 14

        With Winsock1(i)

            If .State = 9 Then Exit Sub

            If .State > 0 Then .Close

            .Connect SvrName(i), 13

        End With

    Next

    

    Timer2.Enabled = True

    labMsg.Caption = "开始校时..."

    

End Sub

'



Private Sub Form_Load()



    Dim i As Long

    

    '//校时的服务哭。

    SvrName(1) = "time.nist.gov"                'NCAR, Boulder, Colorado  192.43.244.18

    SvrName(2) = "time-a.nist.gov"              'NIST, Gaithersburg, Maryland  129.6.15.28

    SvrName(3) = "time-b.nist.gov"              'NIST, Gaithersburg, Maryland  129.6.15.29

    SvrName(4) = "time-a.timefreq.bldrdoc.gov"  'NIST, Boulder, Colorado  132.163.4.101

    SvrName(5) = "time-b.timefreq.bldrdoc.gov"  'NIST, Boulder, Colorado  132.163.4.102

    SvrName(6) = "time-c.timefreq.bldrdoc.gov"  'NIST, Boulder, Colorado  132.163.4.103

    SvrName(7) = "utcnist.colorado.edu"         'University of Colorado, Boulder  128.138.140.44

    SvrName(8) = "time-nw.nist.gov"             'Microsoft, Redmond, Washington 131.107.1.10

    SvrName(9) = "nist1.datum.com"              'Datum, San Jose, California  66.243.43.21

    SvrName(10) = "nist1.dc.glassey.com"        'Abovenet, Virginia  216.200.93.8

    SvrName(11) = "nist1.ny.glassey.com"        'Abovenet, New York City  208.184.49.9

    SvrName(12) = "nist1.sj.glassey.com"        'Abovenet, San Jose, California  207.126.103.204

    SvrName(13) = "nist1.aol-ca.truetime.com"   'TrueTime, AOL facility, Sunnyvale, CA  207.200.81.113

    SvrName(14) = "nist1.aol-va.truetime.com"   'TrueTime, AOL facility, Virginia  205.188.185.33

    

    For i = 1 To 14

        Load Winsock1(i)

    Next

    

    labTime.Caption = Format$(Now, "yyyy-mm-dd  hh:mm:ss")

    Call SetTime

    

End Sub

'



Private Sub Form_Unload(Cancel As Integer)

    Dim i As Long

    For i = 1 To 14

        Unload Winsock1(i)

    Next

    Erase SvrName

    End

End Sub

'



Private Sub Timer1_Timer()

    labTime.Caption = Format$(Now, "yyyy-mm-dd  hh:mm:ss")

End Sub

'



Private Sub Timer2_Timer()

    Call SetTime

End Sub

'



Private Sub Timer3_Timer()

    Unload Me

End Sub

'



Private Sub Winsock1_DataArrival(Index As Integer, ByVal bytesTotal As Long)



    On Error Resume Next

    

    Dim s As String

    Dim dt As Date

    

    Winsock1(Index).GetData s, vbString

    

    If Mid$(s, 31, 1) <> "0" Then Exit Sub

    If Me.Tag = "OK" Then Exit Sub

    

    Me.Tag = "ok"

    dt = CDate(Mid$(s, 8, 17)) + 8# / 24#

    Date = dt

    Time = dt

    labMsg = labMsg & "成功!  10秒后关闭!" & vbCrLf

    Timer2.Enabled = False

    Timer3.Enabled = True

    

End Sub