Synchronisation horraire (horloge atomique) avec gestion de délais

Soyez le premier à donner votre avis sur cette source.

Snippet vu 11 400 fois - Téléchargée 33 fois

Contenu du snippet

Ce code sert à synchroniser l'heure de son programme en fonction de l'heure GMT (Greenwich mean time) ou si vous préférez, l'heure internationnale. Quoique déjà présent sur ce réseau, j'ai simplifié le code au max et comme vous le savez certainement, il y a un délais entre le temps d'envoi et de réception d'une donnée sur le net. Or, la NIST (Nationnal Institute of Standards and Technology), la société américaine qui vérifie constament la position de la terre en vue de donner l'heure exacte, inclus dans son envoi, une estimation de ce délais, j'ai donc intégré une façon simple d'obtenir l'heure la plus précise possible, malgré le traffic sur internet.

Pour utiliser ce code, commencez par ajouter un "command Buttons", un "winsock" et deux "timers" dont le "timer1" dont l'intervale doit être à "1000" et doivent tous deux être "enabled = false" et collez ce code, il vous permettra de variabiliser l'heure atomique et de l'incrémenter à chaque seconde, vous en faites ensuite ce que vous voulez...

Source / Exemple :


Dim hour As Byte                                'variable d'heure
Dim minute As Byte                             'variable de minute
Dim second As Byte                            'variable de seconde
Dim day As Byte                                  'variable de jour
Dim month As Byte                              'variable de mois
Dim year As Integer                            'variable d'année

Private Sub Command1_Click()
Winsock1.Close                                      'on ferme le winsock s'il est ouvert
tcptime.Connect "time.nist.gov", "13"    'on se connecte sur le serveur de la NIST
End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Dim data As String                               'variable de donnée brute
Winsock1.GetData data                       'chargement de la donnée brute
hour = Mid(data, 17, 2)                        'on enregistre l'heure
minute = Mid(data, 20, 2)                    'on enregistre la minute
second = Mid(data, 23, 2)                    'on enregistre la seconde
year = Mid(data, 8, 2)                          'l'année
month = Mid(data, 11, 2)                      'le mois
day = Mid(data, 14, 2)                          'le jour
second = second + 1                             'on ajoute une seconde pour compenser pour le délais du net
Timer1.Enabled = False                         'on arrête le timer1 (qui sert à incrémenter l'heure)
Timer2.Interval = 1000 - Mid(data, 31, 3) 'on prends une seconde et on y enlève le délais en MiliSeconde donné par la NIST
Timer2.Enabled = True                          'on démarre le timer2
End Sub

Private Sub Timer1_Timer()                          'timer d'incrémentation du temps
second = second + 1                                 'plus une seconde
If second = "60" Then second = "0": minute = minute + 1    'si on est rendu à 60 secondes, on ajoute une minute et on réinitialise la secondes
If minute = "60" Then minute = "0": hour = hour + 1            'si on est rendu à 60 minute, on ajoute une heure et on réinitialise la minute
If hour = "24" Then hour = "0"                                                'pas la peine de nous y attarder!
Me.Caption = hour & ":" & minute & ":" & second & " " & WeekdayName(Weekday(year & "-" & month & "-" & day)) & " " & day & " " & MonthName(month) & " " & year     'ça non plus!
End Sub

Private Sub Timer2_Timer()                          'timer de délais
Timer2.Enabled = False                                'quand on atteint notre délais, on arrête le timer2 et on démarre le timer1
Timer1.Enabled = True
End Sub

Conclusion :


pour plus d'informations concernant la synchronisation horraire, consultez le site web de la NIST (en anglais) au http://www.boulder.nist.gov/timefreq/service/its.htm

Bonne programmation.

A voir également

Ajouter un commentaire Commentaires
Messages postés
1
Date d'inscription
dimanche 9 février 2003
Statut
Membre
Dernière intervention
28 octobre 2006

Lors de l'execution de votre code une erreur apparait
il fallait remplacer tcptime par dans la ligne 10
Messages postés
64
Date d'inscription
lundi 25 août 2003
Statut
Membre
Dernière intervention
22 novembre 2011

loll
Messages postés
3757
Date d'inscription
mardi 23 septembre 2003
Statut
Modérateur
Dernière intervention
13 mars 2006
16
ben, je sais, c pas top mais comme je n'ai pas retrouvé l'adresse ...... cela dit, la source de yannickt est bonne aussi.
Messages postés
1467
Date d'inscription
samedi 13 mars 2004
Statut
Membre
Dernière intervention
5 mai 2010
3
Et voilà CanisLupus qui nous sort une source dans un commentaire, lol.
Sinon, bonne source.
Messages postés
3757
Date d'inscription
mardi 23 septembre 2003
Statut
Modérateur
Dernière intervention
13 mars 2006
16
Tout ce que je peux dire c que j'utilise le code suivant pour remettre à l'heure mon PC et ça marche ! Ce code vient de vbfrance mais je ne sais plus qui en est l'auteur, s'il pouvait se manisfester !

' Programme SYnchronisation de votre PC

' Le serveur NTP écoute sur le port 37
' le client se connecte sur le port 37
' le serveur envoie la date et l'heure sous forme d'un nombre
' entier de secondes depuis 1900
' le serveur ferme la connexion

Dim sNTP As String 'trame 32 bits retournée par le serveur SNTP
Dim sngTimeDelay As Single 'temps écoulé entre la connection au serveur
'et les données recues.
'la correction à apporter est égale
'à la moitié de cette valeur


Private Declare Function SetSystemTime Lib "kernel32" _
(lpSystemTime As SYSTEMTIME) As Long

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

Sub Form_load()
Me.Hide
With Winsock
.Close
sNTP = Empty
'
' Nom du serveur de temps NTP.
' L'heure suisse même atomique c'est autre chose !
.RemoteHost = "ntp.metas.ch"
'
' Connection sur le port dédié 37. (RFC 1305, 1361, 2030)
'
.RemotePort = 37
.Connect
End With
End Sub

Private Sub WinSock_DataArrival(ByVal bytesTotal As Long)
Dim sData As String

Call Winsock.GetData(sData, vbString)
sNTP = sNTP & sData
End Sub
Private Sub WinSock_Connect()
sngTimeDelay = Timer 'temps écoulé depuis minuit
End Sub
Private Sub WinSock_Close() 'le serveur ferme la connection
On Error Resume Next

Do Until Winsock.State = sckClosed
Winsock.Close
DoEvents
Loop

sngTimeDelay = ((Timer - sngTimeDelay) / 2) 'correction en secondes à apporter entre la connection et la fermeture de connection
Call SyncClock(sNTP)
End Sub
Private Sub SyncClock(sTemp As String)
Dim dblNTPTime As Double ' réponse temps en secondes écoulées depuis 1900
Dim UTCDATE As Date
Dim LngTimeFrom1990 As Long
Dim ST As SYSTEMTIME

sTemp = Trim$(sTemp) ' élimine les espaces à droite et gauche
If Len(sTemp) <> 4 Then ' vérifie la longueur de la chaine de retour 4 caractères
Call MsgBox("le serveur NTP retourne une réponse invalide.", _
vbCritical, "Réponse invalide")
Exit Sub
End If

' décodage de la chaine de 4 caractères ACII retournées
dblNTPTime = Asc(Left$(sTemp, 1)) * 256 ^ 3 + Asc(Mid$(sTemp, 2, 1)) * 256 ^ 2 + _
Asc(Mid$(sTemp, 3, 1)) * 256 ^ 1 + Asc(Right$(sTemp, 1))

LngTimeFrom1990 = dblNTPTime - 2840140800# 'temps en secondes depuis 1990

' correction de la date introduite au système
UTCDATE = DateAdd("s", CDbl(LngTimeFrom1990 + CLng(sngTimeDelay)), #1/1/1990#)

With ST
.wYear = Year(UTCDATE)
.wMonth = Month(UTCDATE)
.wDay = Day(UTCDATE)
.wHour = Hour(UTCDATE)
.wMinute = Minute(UTCDATE)
.wSecond = Second(UTCDATE)
End With

Call SetSystemTime(ST)
Call MsgBox("Horloge PC synchronisée avec succés.", vbInformation, _
"Mise à l'heure réussie")

End Sub

Si ça peut te servir......

Bonne prog
Afficher les 7 commentaires

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.