VB 5/6-Tipp 0361: Die aktuelle Internetzeit auslesen

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'------------- Anfang Projektdatei Project1.vbp -------------
' Die Komponente ' (MSWINSCK.OCX)' wird benötigt.

'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Schaltfläche "Command2"
' Steuerelement: Schaltfläche "Command1"
' Steuerelement: Rahmensteuerelement "Frame1"
' Steuerelement: Kombinationsliste "Combo1" auf Frame1
' Steuerelement: Windows Socket "WinSock1"
' Steuerelement: Timersteuerelement "Timer1"
' Steuerelement: Rahmensteuerelement "Frame2"
' Steuerelement: Beschriftungsfeld "Label1" auf Frame2
' Steuerelement: Beschriftungsfeld "Label2"


'Autor: Alexander Haugk
'E-Mail: alex@freecoder.de
'WWW:  http://www.freecoder.de

Option Explicit
   
Private Type SYSTEMTIME
    wYear As Integer
    wMonth As Integer
    wDayOfWeek As Integer
    wDay As Integer
    wHour As Integer
    wMinute As Integer
    wSecond As Integer
    wMilliseconds As Integer
End Type

Private sNTP As String
Private TimeDelay As Single
Private Data As String
Private NTPTime As Double
Private LngTimeFrom1990 As Long
Private ST As SYSTEMTIME
Private Monat As String
Private UTCDATE As Date

Private Sub Form_Load()
    Combo1.AddItem "ntp1.fau.de"
    Combo1.AddItem "ntps1-0.cs.tu-berlin.de"
    Combo1.AddItem "time.ien.it"
    Combo1.AddItem "ntps1-1.rz.Uni-Osnabrueck.de"
    Combo1.AddItem "swisstime.ethz.ch"
    Combo1.AddItem "ntp.cs.mu.oz.au"
    Combo1.AddItem "tock.usno.navy.mil"
    Combo1.AddItem "tick.usno.navy.mil"
    Combo1.AddItem "ntp-cup.external.hp.com"
    Combo1.AddItem "tempo.cstv.to.cnr.it"
    Combo1.ListIndex = 0
End Sub

Private Sub Command1_Click()
    Label2.Caption = "verbinde..."
    Label1.Caption = "hole Zeit..."
    Command1.Enabled = False
    Command2.Enabled = False
    Combo1.Enabled = False
    WinSock1.Close
    sNTP = Empty
    WinSock1.RemoteHost = Combo1.Text 'NTP-Serveradresse
    WinSock1.RemotePort = 37 'NTP-Server Port
    WinSock1.Connect
    Me.Refresh
End Sub

Private Sub Command2_Click()
    Unload Me
End Sub

Private Sub WinSock1_Connect()
    Label2.Caption = "verbunden..."
    TimeDelay = Timer
End Sub

Private Sub WinSock1_DataArrival(ByVal bytesTotal As Long)
    Label2.Caption = "Hole Zeit..."
    WinSock1.GetData Data, vbString
    sNTP = sNTP & Data
End Sub

Private Sub WinSock1_Close()
    On Error Resume Next
    
    Do Until WinSock1.State = sckClosed
        WinSock1.Close
        DoEvents
    Loop
    
    TimeDelay = ((Timer - TimeDelay) / 2)
    Call SyncClock(sNTP)
End Sub

'Daten vom Server in verständliche Zeit übersetzen:
Private Sub SyncClock(tStr As String)
    Label2.Caption = "Zeit konvertieren..."
    tStr = Trim(tStr)
    If Len(tStr) <> 4 Then
        MsgBox "Unverständliche Antwort vom Server!", _
                vbCritical, "GetTime!"
        End
        Exit Sub
    End If
    
    NTPTime = Asc(Left$(tStr, 1)) * 256 ^ 3 + _
              Asc(Mid$(tStr, 2, 1)) * 256 ^ 2 + _
              Asc(Mid$(tStr, 3, 1)) * 256 ^ 1 + _
              Asc(Right$(tStr, 1))
              
    LngTimeFrom1990 = NTPTime - 2840140800#
    UTCDATE = DateAdd("s", CDbl(LngTimeFrom1990 + _
                      CLng(TimeDelay)), #1/1/1990#)
                      
    Select Case Month(UTCDATE)
        Case 1: Monat = "Januar"
        Case 2: Monat = "Februar"
        Case 3: Monat = "März"
        Case 4: Monat = "April"
        Case 5: Monat = "Mai"
        Case 6: Monat = "Juni"
        Case 7: Monat = "Juli"
        Case 8: Monat = "August"
        Case 9: Monat = "September"
        Case 10: Monat = "Oktober"
        Case 11: Monat = "November"
        Case 12: Monat = "Dezember"
    End Select
    
    Label1.Caption = "Datum: " & Day(UTCDATE) & " " & Monat & _
                     " " & Year(UTCDATE) & Chr(13) & "Zeit: " & _
                     Format(Hour(UTCDATE), "00") + 2 & ":" & _
                     Format(Minute(UTCDATE), "00") & ":" & _
                     Format(Second(UTCDATE), "00")
                     
    Command1.Enabled = True
    Command2.Enabled = True
    Combo1.Enabled = True
    Label2.Caption = "Fertig..."
End Sub
'---------- Ende Formular "Form1" alias Form1.frm  ----------
'-------------- Ende Projektdatei Project1.vbp --------------

Kommentar von Torsten am 25.09.2008 um 17:19

Hallo,
sehr wahr was Armin sagt. Ich hatte das Problem mit ptbtime2.ptb.de ausprobiert. In meiner Programmierung lief es einfach nicht. Aber es geht mit ntp3.fau.de . Allerdings wird hier GMT -2 genommen, was mich doch sehr verwundert für einen deutschen Server. Gibt es denn keinen "zuferlässigen" Server, der auch richtig mit Sommer-/Winterzeit umgehen kann?

Gruß
Torsten

Kommentar von Armin am 30.05.2008 um 05:19

Das Programm ist teilweise doch sehr mit der heissen Nadel gestrickt.
Besonders übel ist es, dass wenn ein Server nicht verfügbar ist, das Programm bis zum St.Nimmerleinstag wartet. Ich habe mir inzwischen einen Timeout eingebaut.
Das ganze hier zu posten wäre aber zu komplex.
Folgende Timeserver konnte ich (für Deutschland) als meisstens verfügbar ausmachen :
[code]
Combo1.AddItem "ptbtime2.ptb.de"
Combo1.AddItem "ptbtime1.ptb.de"
Combo1.AddItem "ntp3.fau.de"
Combo1.AddItem "ntp2.fau.de"
Combo1.AddItem "ntp1.fau.de"
Combo1.AddItem "ntp0.fau.de"
Combo1.AddItem "time.ien.it"
[code]
Die Liste erhebt keinen Anspruch auf Vollständigkeit.
Ausserdem scheint die Fluktuation der Verfügbarkeit erstaunlich gross zu sein.(Stand Mai 2008)

Ein wundersamer Effekt ist noch, dass einige Timeserver im Programm "Internet Toolkit" funktionieren und hier nicht. Dafür andere genau umgekehrt.

Gruss
Armin

Kommentar von Gunthard am 21.03.2008 um 20:59

funktioniert bei mir nicht - bleibt stehen.

Kommentar von Vincent Mairiaux am 18.11.2007 um 19:50

Hello,

Ich habe das schönes Code in VB6 (mit Windows XP) ausgepropiert jedoch es bleibt stehen auf "verbinde.." und weiter tut es nichts mehr!!
Was ist los glauben Sie?

Dank im Voraus.

PS bitte antworten Sie in einfach Deutsch oder vielleicht in English wenn möglich.

Kommentar von Dieter am 16.12.2006 um 12:08

warum das Case für den Monat
einfacher wäre für das Datum doch

Label1.Caption = "Datum: " & Format(UTCDATE, "d. mmmm yyyy") & ...

Kommentar von Ian77 am 08.09.2006 um 16:26

Wie realisiere ich das Ganze über einem Proxy?
Komme nur überm Firmenproxy ins Internet...

Danke

Kommentar von Daniel am 11.12.2004 um 11:39

Wie kommt man auf die Formel:
LngTimeFrom1990 = NTPTime - 2840140800#

Kommentar von Christian Gmeiner am 10.07.2002 um 18:19

Tip 361: Die Internetzeit aktuelle auslesen
Ändert das lieber

Kommentar von info am 17.06.2002 um 15:31

das original stammt von www.freevbcode.com / Paul Hews

Kommentar von MisterX am 13.06.2002 um 18:48

Tip:
via Web Services auslesen, ganz easy zu handeln, kaum code

Kommentar von PBR am 08.02.2002 um 16:27

Ich würde als Zeitserver ptbtime1.ptb.de nehmen; das sind die atomuhren in der physikalisch-technischen-bundesanstalt in braunschweig. Die liefern auch die zeit für die "normalen" funkuhren in europa

Kommentar von Tribun am 23.10.2001 um 19:16

Dann gibts da aber immernoch nen BUG in der Umrechnung, nehmen wir an, dass die Zeit um ca. 23 Uhr abends am tage des Monats / Jahreswechsel geschieht.
Wie wäre es denn mit
UTCDATE = DateAdd("h", 2, UTCDATE)
und natürlich wieder
Format(Hour(UTCDATE), "00") + 2 & ":" &
in
Format(Hour(UTCDATE), "00") & ":" &
ändern.

Kommentar von Hermann A. Kruse am 18.07.2001 um 01:51

Hallo
Das Programm zeigt morgens um 01:45:01
25:45:01 an!
Es ist wohl besser
UTCDATE = UTCDATE + 2 / 24
vor die Rechnung zu stellen und dann
Format(Hour(UTCDATE), "00") + 2 & ":" &
in
Format(Hour(UTCDATE), "00") & ":" &
zu ändern.

Kommentar von Manuel Reimer am 20.06.2001 um 17:25

Fehler in "Internetzeit Auslesen"
Ich suche nun schon längere Zeit eine Möglichkeit die Funkuhrzeit aus dem Internet zu ermitteln. Vor kurzem habe ich den Tipp "Internetzeit Auslesen" auf dieser Seite gefunden, der auf dem ersten Blick auch ziemlich professionell aussieht. Die Zeit wird direkt von einem Server abgefragt und es stehen sogar mehrere Server zur Auswahl. Bevor ich einen Tipp aus dem Internet in meinen Programmen verbaue prüfe ich diese aber üblicherweise sehr genau und so habe ich auch in diesem Tipp eine Menge Fehler gefunden.
Zuerst ist mir die Zeile
UTCDATE = DateAdd("s", CDbl(LngTimeFrom1990 + _
CLng(TimeDelay)), #1/1/90#)
aufgefallen. Hier wird bei der Übergabe des Wertes "number" an die Funktion DateAdd die CDbl-Funktion verwendet und das obwohl die Hilfe sagt, dass "number" ein Wert von Typ Long sein muss. Also habe ich diese Zeile folgendermaßen getestet:
UTCDATE = DateAdd("s", 2147483648, #1/1/1990#)
Hierbei ist der Wert 2147483648 genau um 1 größer als der Höchstwert vom Typ Long. Folge: Eine Fehlermeldung "Überlauf". Als nächstes wollte ich wissen, welches Datum dann denn maximal dargestellt werden kann. Also probierte ich das ganze nochmals mit dem Höchstwert vom Typ Long und bekam von der Funktion "SyncClock" folgende Werte:
Datum: 19.01.2058 Uhrzeit: 03:14:07
Folglich dachte ich zuerst, dass jedes Programm, in dem der Tipp "Internetzeit Auslesen" verwendet wurde am 19.01.2058 um Punkt 03:14:08 Uhr unweigerlich mit der Fehlermeldung "Überlauf" abstürzen würde. Als ich mir folgenden Bereich genauer anschaute wurde diese Vermutung aber wiederlegt:
NTPTime = Asc(Left$(tStr, 1)) * 256 ^ 3 + _
Asc(Mid$(tStr, 2, 1)) * 256 ^ 2 + _
Asc(Mid$(tStr, 3, 1)) * 256 ^ 1 + _
Asc(Right$(tStr, 1))
LngTimeFrom1990 = NTPTime - 2840140800#
UTCDATE = DateAdd("s", CDbl(LngTimeFrom1990 + _
CLng(TimeDelay)), #1/1/1990#)
Hier werden von den 4 Zeichen, die der Server liefert jeweils die Ascii-Werte mit entsprechenden Multiplikatoren multipliziert und die Ergebnisse addiert. Der Höchstwert, der hier entstehen kann entsteht folglich durch verwendung des folgenden Strings:
tStr = Chr$(255) & Chr$(255) & Chr$(255) & Chr$(255)
Ich baute diese Zeile in die Funktion "SyncClock" ein und testete das Programm erneut. Nun wurde mir folgendes Datum, bzw. folgende Zeit angezeigt:
Datum: 07.02.2036 Uhrzeit: 06:28:15
Tatsächlich wird ein Programm, in dem der Tipp "Internetzeit Auslesen" verwendet wurde also nicht am 19.01.2058 um 03:14:08 Uhr abstürzen, weil der Höchstwert vom Typ Long nie erreicht wird. Vielmehr quittieren diese Programme am 07.02.2036 um Punkt 06:28:16 Uhr ihren Dienst. Dann wahrscheinlich mit der Fehlermeldung "Unverständliche Antwort vom Server". Dies ist auf den Anfang der Funktion "SyncClock" zurückzuführen. Wenn der Server nämlich nicht genau 4 Zeichen liefert, dann wird diese Fehlermeldung angezeigt. Der Server wird aber auch nach besagtem Datum noch Zeiten liefern, aber dann wahrscheinlich nicht mehr mit nur 4 Zeichen sondern mit 5.
Das Resultat: Die Funktion "SyncClock" hat offensichtlich noch eine ganze Menge Bugs. Aus diesem Grund ist diese Lösung vorerst für meine Programme noch ungeeignet.
Übrigens an alle, die denken, dass bis 07.02.2036 um 06:28:16 noch lange hin ist: So haben vor einigen Jahrzehnten schon mal Programmierer gedacht. Dies wurde dann Jahr 2000 Bug genannt.
Viele Grüße
Manuel Reimer

Kommentar von Karsten Röttger am 16.05.2001 um 15:40

Na, auch ein Abo bei VB-Pro?

Kommentar von Lothar K am 21.04.2001 um 19:49

Natürlich muß man den kleinen Patzer:
Case 1
Case 1
Case 1
noch in:
Case 1
Case 2
Case 3
ändern, aber warum sich das Programm nach der Aktualisierung der Zeit stets aufhängt, (auf mehreren Rechnern getestet), ist mir ein Rätzel!

Kommentar von cybertrue am 20.02.2001 um 23:34

Achtung beim Umrechnen der Uhrzeit
Format(Hour(UTCDATE), "00") + 2
Die +2 Stunden gelten nur bei Sommerzeit! Sonst GMT +1!
Gruß cyberTrue

Kommentar von Moosi am 15.02.2001 um 20:45

Select Case Month(UTCDATE)
Case 1: Monat = "Januar"
Case 1: Monat = "Februar"
Case 1: Monat = "März"
Case 1: Monat = "April"
Case 1: Monat = "Mai"
Case 1: Monat = "Juni"
Case 1: Monat = "Juli"
Case 1: Monat = "August"
Case 1: Monat = "September"
Case 1: Monat = "Oktober"
Case 1: Monat = "November"
Case 1: Monat = "Dezember"
End Select
Kann nicht ganz stimmen! Hier steht immer nur 1! (nach meinem Wissen besteht ein Jahr aus !!12!! Monaten)! Kleiner Hinweiß. Gruß,Moosi