Synchronisation horloge pc avec horloge gps version 2

Soyez le premier à donner votre avis sur cette source.

Vue 15 653 fois - Téléchargée 45 111 fois

Description

C'est une évolution de mon programme précédent qui utilisait les trames GPS NMEA à 4800 bds RMC. Celles ci ont le léger inconvénient d'un renouvellement toutes les 2 secondes mais elles sont universelles sur tous les GPS. Cette fois ci, j'utilise le protocole propriétaire GARMIN à 9600 bds avec des trames commandées par un timer réglé à 600ms.
C'est une approche du protocole GARMIN que je cherche à décoder entièrement.
Ce code permet l'acquisition de données en mode binaire avec le composant MSCOMM, en lieu et place du mode text le plus souvent utilisé et documenté. En tout cas je n'ai pas trouvé de code équivalent sur le site vbfrance permettant de recevoir des donnnées 8 bits par MSComm.

Source / Exemple :


Option Explicit
Private Declare Function GetTimeZoneInformation Lib "kernel32" (lpTimeZoneInformation As TIME_ZONE_INFORMATION) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds 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

Private Type TIME_ZONE_INFORMATION
    Bias As Long
    StandardName As String * 64
    StandardDate As SYSTEMTIME
    StandardBias As Long
    DayLightName As String * 64
    DayLightDate As SYSTEMTIME
    DayLightBias As Long
End Type

Private Sub cmdSync_Click() 'remise à l'heure du PC avec l'horloge GPS
        Time = lblTime(0)
End Sub

Private Sub Command1_Click() 'Commande pour cacher la Forme et ouvrir un systray
    Me.Hide
    DWFH_Systray1.CreateSysTray
End Sub

Private Sub Form_Load()
    Dim intCounter As Integer
    
    For intCounter = 1 To 8
        On Error Resume Next
        Form1.GPS.CommPort = intCounter
        Form1.GPS.PortOpen = True
        If Not Err.Number = 8002 Then
            Exit For
        End If
        Form1.GPS.PortOpen = False
    Next intCounter
    ' le premier port com libre est choisi par défaut
    
    With Form1.GPS  'paramètres propres à la réception GPS en mode GARMIN
        .Settings = "9600,N,8,1"
        .Handshaking = 0
        .InputLen = 0
        .RThreshold = 1
        .InBufferSize = 1024
        .NullDiscard = False   'le byte 0 n'est pas filtré (important)
        .InputMode = comInputModeBinary  ' entrées en mode binaire  (important)
    End With
    
    Debug.Print Form1.GPS.CommPort
    Form1.Timer1.Interval = 60000    ' toutes les minutes
    Form1.Timer1.Enabled = True
    Form1.GPS.PortOpen = True
    Timer2_Timer
    With Timer3
        .Interval = 700
        .Enabled = True
    End With
    Timer3_Timer
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    Timer1.Enabled = False
    GPS.InBufferCount = 0
    GPS.PortOpen = False
    DWFH_Systray1.DestroySysTray
End Sub

Private Sub GPS_OnComm()
    Dim Buffer() As Byte
    Dim Arr() As Byte
    Dim ret As Long
    Dim nZoneCorrection As Long
    Dim TZI As TIME_ZONE_INFORMATION
    
    Select Case GPS.CommEvent
     Case comEvReceive
           Buffer = GPS.Input
            Arr = Buffer
                If UBound(Arr) >= 7 And Arr(0) = 16 Then  ' vérifie si trame réponse valide
                    If UBound(Arr) > 20 Then
                        If Arr(9) = &HE Then   ' trame Date_Time détectée
                            Envoi (Chr(&H10) & Chr(6) & Chr(2) & Chr(&HE) & Chr(0) & Chr(&HEA) _
                            & Chr(&H10) & Chr(3))  ' envoi trame de fin d'échange
                          ret = GetTimeZoneInformation(TZI)  ' recherche le fuseau horaire pour afficher l'heure locale
                          nZoneCorrection = TZI.Bias
                          If ret = 1 Then
                              nZoneCorrection = nZoneCorrection + TZI.StandardBias
                          ElseIf ret = 2 Then
                              nZoneCorrection = nZoneCorrection + TZI.DayLightBias
                          End If
                          nZoneCorrection = -nZoneCorrection
                          lblTime(0) = Format(CStr(Arr(15)), "00") & ":" & Format(CStr(Arr(17)), "00") & ":" & Format(CStr(Arr(18)), "00")
                          lblTime(0) = DateAdd("n", nZoneCorrection, lblTime(0)) ' heure locale= heure GPS (UTC) + Correction fuseau
                          GPS.InBufferCount = 0  'buffer vidé
                        Else
                            Exit Sub
                        End If
                    End If
                End If
  End Select
End Sub

Private Sub Timer1_Timer()
    Static Compteur As Integer
    
    Compteur = Compteur + 1
    Select Case Compteur
    
        Case 60  'toutes les heures remise à l'heure du PC par le GPS
           Time = lblTime(0)
           Compteur = 0
        Case Else
    End Select
    Debug.Print Compteur
End Sub
' Ouverture du menu systray si click droit de la souris
Private Sub DWFH_Systray1_Action(Button As Integer, Genre As Long)
    If Button = 2 Then PopupMenu systraymenu
End Sub
 
 
Private Sub Timer2_Timer() 'Affichage de l'heure PC toutes les secondes
    lblTime(1) = Format$(Now, "hh:mm:ss") 'toutes les secondes, affichage de l'heure systeme
End Sub
Private Sub mnuAfficher_Click()
    Me.Show
End Sub

Private Sub mnuQuitter_Click()
    End
End Sub
Private Sub Envoi(Mot$) 'envoi des trames vers le GPS
   Dim n
   On Error Resume Next
   Do
      DoEvents
   Loop While (GPS.OutBufferCount > 0)
   GPS.Output = Mot$
   Sleep (200)
End Sub

Private Sub Timer3_Timer() 'commande de demande d'heure au gps au format GARMIN
    Envoi (Chr(16) & Chr(10) & Chr(2) & Chr(5) & Chr(0) & Chr(&HEF) & Chr(16) & Chr(3))
End Sub

Codes Sources

A voir également

Ajouter un commentaire Commentaires
Messages postés
31
Date d'inscription
jeudi 29 juillet 2004
Statut
Membre
Dernière intervention
17 février 2006

Peut être l'erreur est-elle résolue :
lblTime(0) = Format(CStr(Arr(15)), "00") & ":" & Format(CStr(Arr(17)), "00") & ":" & Format(CStr(Arr(18)), "00")

Effectivement, lorsque les valeurs dans Arr(15), Arr(17) et Arr(18) ne sont pas des valeurs à deux chiffres, une erreur 13 était créée due à un format invalide pour une date. Cette fois ci doit être la bonne.
Messages postés
31
Date d'inscription
jeudi 29 juillet 2004
Statut
Membre
Dernière intervention
17 février 2006

Pardonne moi de te poser les questions suivantes : ton gps, c'est bien un garmin ? Tu t'es bien positionné dans le setup du recepteur en format d'interface GARMIN à 9600 bds ? C'est primordial...
Et ca ne peut se faire que manuellement. As tu utilisé le fichier ZIp ? C'est idiot mais sait-on jamais...
Sur GARMIN GPS Pilot, cela fonctionne bien.
Messages postés
50
Date d'inscription
mercredi 31 mars 2004
Statut
Membre
Dernière intervention
2 mai 2007

Merci de ta réponse
Je n'ai créé aucun tableau, mais utilisé ton code initial
sans aucune modifs.
Même avec ton correctif, ça ne fonctionne pas !
Cordialement
Bamphi
Messages postés
31
Date d'inscription
jeudi 29 juillet 2004
Statut
Membre
Dernière intervention
17 février 2006

Encore mieux :

lblTime(0) = CDate(Format$(CStr(Arr(15)) & CStr(Arr(17)) & CStr(Arr(18)), "00:00:00"))
Messages postés
31
Date d'inscription
jeudi 29 juillet 2004
Statut
Membre
Dernière intervention
17 février 2006

Pour Bamphi

A priori une erreur 53 est une erreur de 'Fichier introuvable'. Je pense éventuellement au fait que labeltime(0) et labelTime(1) sont deux tableaux de controle : as tu créé sur la Form1 deux tableaux de controle "labelTime" ?
Sinon tu peux éventuellement remplacer la ligne :
lblTime(0) = CStr(Arr(15)) & ":" & CStr(Arr(17)) & ":" & CStr(Arr(18))
par celle ci :
lblTime(0) = Format$(CStr(Arr(15)) & CStr(Arr(17)) & CStr(Arr(18)), "00:00:00")
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.