vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
Mails senden, abrufen und decodieren - ganz easy ;-)  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2024
 
zurück
Rubrik: Datum/Zeit und Timer · Datums- und Zeitfunktionen   |   VB-Versionen: VB620.01.03
Systemzeit mit Atomzeit abgleichen

Ab sofort besitzt auch ihr PC eine Funkuhr! Ohne teure Hardware oder sonstigen Zusatzkosten!

Autor:   Dieter OtterBewertung:     [ Jetzt bewerten ]Views:  36.450 
www.tools4vb.deSystem:  Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11 Beispielprojekt auf CD 

Nachfolgender Tipp zeigt, wie sich die Atomzeit über das Internet auslesen und die aktuelle Systemzeit entsprechend der Atomzeit aktualisieren lässt.

Alles, was Sie hierzu brauchen, ist die Adresse eines Time-Servers, sowie das Winsock-Control. Als Time-Server nehmen wir in unserem Beispiel time.gov. Die Atomzeit wird hierbei in folgendem Format übermittelt: xxxxx yy-mm-dd hh:mm:ss xx x x xx.x UTC(NIST) *. Man braucht dann lediglich das Datum und die Uhrzeit zu extrahieren und die Systemzeit über die SetSystemTime-Struktur neu zu setzen. Grund für die Verwendung von SetSystemTime ist folgender: Wir brauchen uns nicht um Sommer- oder Winterzeit zu kümmern! Wir können die benötigte SYSTEMTIME-Struktur also direkt ohne weitere Berechnung mit den vom Timer-Server übermittelten Daten füllen.

Um das nachfolgende Beispiel zu testen, starten Sie ein neues Projekt, fügen über Projekt - Komponenten das Microsoft Winsock-Control hinzu und ziehen es auf die Form. Über einen CommandButton soll dann die Atomzeit ermittelt und die Systemzeit entsprechend aktualisiert werden.

Option Explicit
 
' benötigte API-Deklarationen: Systemzeit setzen
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 Declare Function SetSystemTime Lib "kernel32" ( _
  lpSystemTime As SYSTEMTIME) As Long
 
' Systembenachrichtigung
Private Declare Function SendMessage Lib "user32" _
  Alias "SendMessageA" ( _
  ByVal hwnd As Long, _
  ByVal wMsg As Long, _
  ByVal wParam As Long, _
  lParam As Any) As Long
 
Private Const HWND_BROADCAST = &HFFFF&
Private Const WM_TIMECHANGE = &H1E
Private Sub Command1_Click()
  ' Verbindung zum TimerServer herstellen
  With Winsock1
    .RemotePort = 13
    .RemoteHost = "time.gov"
    .Connect
  End With
End Sub
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
  ' Timerserver schickt uns Daten
  Dim sData As String
  Dim vArray As Variant
  Dim ST As SYSTEMTIME
 
  ' Daten abrufen
  Winsock1.GetData sData
 
  ' Atomzeit werden in folgendem Format übermitteln:
  ' xxxxx yy-mm-dd hh:mm:ss xx x x  xx.x UTC(NIST) *
 
  ' Datum und Uhrzeit aus den Daten extahieren
  vArray = Split(sData, " ")
  If IsDate(vArray(1)) Then
    ' SYSTEMTIME-Struktur mit der Atomzeit "füllen"
    With ST
      .wDay = Val(Right$(vArray(1), 2))
      .wMonth = Val(Mid$(vArray(1), 4, 2))
      .wYear = 2000 + Val(Left$(vArray(1), 2))
      .wHour = Val(Left$(vArray(2), 2))
      .wMinute = Val(Mid$(vArray(2), 4, 2))
      .wSecond = Val(Right$(vArray(2), 2))
    End With
 
    ' Neue Systemzeit "setzen"
    SetSystemTime ST
 
    ' System über Zeit-Änderung benachrichtigen
    SendMessage HWND_BROADCAST, WM_TIMECHANGE, 0&, 0&
 
    MsgBox "Systemzeit wurde aktualisiert!"
  End If
 
  ' Verbindung trennen
  Winsock1.Close
End Sub
Private Sub Winsock1_Error( _
  ByVal Number As Integer, _
  Description As String, _
  ByVal Scode As Long, _
  ByVal Source As String, _
  ByVal HelpFile As String, _
  ByVal HelpContext As Long, _
  CancelDisplay As Boolean)
 
  ' Fehler  
  ' Winsock schließen
  Winsock1.Close
End Sub

Mit diesem Tipp haben Sie ab sofort eine Funkuhr in Ihrem PC
 

Dieser Tipp wurde bereits 36.450 mal aufgerufen.

Voriger Tipp   |   Zufälliger Tipp   |   Nächster Tipp

Über diesen Tipp im Forum diskutieren
Haben Sie Fragen oder Anregungen zu diesem Tipp, können Sie gerne mit anderen darüber in unserem Forum diskutieren.

Neue Diskussion eröffnen

nach obenzurück


Anzeige

Kauftipp Unser Dauerbrenner!Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv  Vol.6
(einschl. Beispielprojekt!)

Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv!
- nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten
- Symbol-Galerie mit mehr als 3.200 Icons im modernen Look
Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m.
 
   

Druckansicht Druckansicht Copyright ©2000-2024 vb@rchiv Dieter Otter
Alle Rechte vorbehalten.
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein.

Diese Seiten wurden optimiert für eine Bildschirmauflösung von mind. 1280x1024 Pixel