Die Community zu .NET und Classic VB.
Menü

VB 5/6-Tipp 0744: GPS / NMEA Datensätze Dekodieren

 von 

Beschreibung 

Dieser Tipp zeigt, wie man einen NMEA Datenstrom dekodiert, und die Informationen der einzelnen Datensätze in eine komfortable Typenstruktur speichert. Die eigentliche Auswertung wird hier in einem Bas-Modul vorgenommen. Die Form dient nur zur Darstellung der Daten, bzw. zum Halten der Controls für die RS232 Schnitstelle, usw.

Schwierigkeitsgrad:

Schwierigkeitsgrad 2

Verwendete API-Aufrufe:

keine

Download:

Download des Beispielprojektes [8,98 KB]

'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 GPS_Test.vbp -------------
' Die Komponente ' (MSCOMM32.OCX)' wird benötigt.

'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Horizontale Scrollbar "HScroll2" (Index von 0 bis 1)
' Steuerelement: Horizontale Scrollbar "HScroll1" (Index von 0 bis 1)
' Steuerelement: Schaltfläche "Command2"
' Steuerelement: Timersteuerelement "Timer1"
' Steuerelement: MSComm-Control "MSC"
' Steuerelement: Schaltfläche "Command1"
' Steuerelement: Bildfeld-Steuerelement "PS"
' Steuerelement: Bildfeld-Steuerelement "BS"
' Steuerelement: Bildfeld-Steuerelement "WM"
Option Explicit

'#######################################################################################################################
'Einfaches Pogramm zum auswerten der DatenSätze
'#######################################################################################################################


'#######################################################################################################################
'Die Form benötigt:
'2x Commandbutton
'1x Microsoft Comm Control
'1x Timer
'4x HScroll
'#######################################################################################################################

'#######################################################################################################################
'Das Projekt kann:
'Eine Verbindung zu einem GPS gerät herstellen
'Die NMEA Daten einlesen
'Eine Landkarte darstellen, und die NMEA Daten auf diesem Anzeigen
'   (Position der Landkarte muss unter umständen manuell angeglichen werden)
'Einfaches Zoomen der Landkarte
'Angleichen der Positionsdaten über HScroll
'Automatishes timergestüztes Anzeigen der Daten auf der Karte
'Gespeicherte Log-Daten (in einer Datei) auswerten
'#######################################################################################################################

Private XZoom As Double
Private XPosX As Double
Private XPosY As Double
Private XPSX As Single
Private XPSY As Single

Private Type GPS_Location_Type
    V_Breite As Double
    V_Länge As Double
    V_Höhe As Double
End Type
Private GPSLD() As GPS_Location_Type
Private GPSLC As Long

Private Type GPS_Sat_Type
    V_Breite As Double
    V_Länge As Double
    V_SatID As Long
    V_Signal As Long
    T_UpDate As Double
End Type
Private GPSSD() As GPS_Sat_Type
Private GPSSC As Long

Private Sub Command1_Click()
On Error Resume Next
If Command1.Caption = "Connect" Then
    Command1.Caption = "Disconnect"
    MSC.PortOpen = True
Else
    Command1.Caption = "Connect"
    If MSC.PortOpen = True Then MSC.PortOpen = False
End If
End Sub

Private Sub Command2_Click()
On Error Resume Next
Dim XFN As Integer
XFN = FreeFile
Open "C:\GPS.log" For Binary As XFN
Dim MX As Long
MX = LOF(XFN)
Dim TX As Long
Dim D As String
Dim GPSD() As GPS_GPType
Dim GPSC As Long
Dim X As Long
For TX = 1 To MX Step 10000
    D = Space(10000)
    If TX + 10000 > MX Then D = Space(MX - TX)
    Get XFN, TX, D
        GPS_DecodeData D, GPSD, GPSC, False
            For X = 1 To GPSC
                With GPSD(X)
                    If .V_Sender = "GP" Then
                        Select Case .V_Type
                            Case GPS_S_RMC
                                With .V_RMC
                                    GPSLC = GPSLC + 1
                                    ReDim Preserve GPSLD(GPSLC) As GPS_Location_Type
                                    If .V_BreiteN = 1 Then
                                        GPSLD(GPSLC).V_Breite = .V_Breite
                                    Else: GPSLD(GPSLC).V_Breite = (-.V_Breite + 48.4302) * 50000
                                    End If
                                    If .V_LängeE = 1 Then
                                        GPSLD(GPSLC).V_Länge = (.V_Länge - 10.4602) * 50000
                                    Else: GPSLD(GPSLC).V_Länge = (-.V_Länge + 10.4602) * 50000
                                    End If
                                End With
                            Case GPS_S_GGA
                            Case GPS_S_GSA
                            Case GPS_S_GSV
                            Case GPS_S_GLL
                            Case GPS_S_VTG
                            Case GPS_S_ZDA
                            Case GPS_S_FSI
                        End Select
                    End If
                End With
            Next
    DoEvents
Next
Close XFN
End Sub

Private Sub Form_Load()
On Error Resume Next
'WM.Picture = LoadPicture("C:\GS.jpg")
'WM.Picture = LoadPicture("C:\Land.jpg")
'WM.Picture = LoadPicture("C:\Land2.jpg")
'WM.Picture = LoadPicture("C:\LandGS2.jpg")
'WM.Picture = LoadPicture("C:\LandGS4.jpg")
If XZoom = 0 Then XZoom = 1
XPosX = 0
XPosY = 0
DrawMap
End Sub

Private Sub MSC_OnComm()
On Error Resume Next
Select Case MSC.CommEvent
    Case comEvReceive
        Dim D As String
        D = MSC.Input
        Dim GPSD() As GPS_GPType
        Dim GPSC As Long
        Dim X As Long
        Dim Y As Long
        Dim Z As Long
        Dim SID As Long
        GPS_DecodeData D, GPSD, GPSC, True
        If GPSC > 0 Then
            Debug.Print GPSC
            For X = 1 To GPSC
                With GPSD(X)
                    If .V_Sender = "GP" Then
                        Select Case .V_Type
                            Case GPS_S_RMC
                                With .V_RMC
                                    GPSLC = 1
                                    ReDim Preserve GPSLD(GPSLC) As GPS_Location_Type
                                    If .V_BreiteN = 1 Then
                                        GPSLD(GPSLC).V_Breite = .V_Breite
                                    Else: GPSLD(GPSLC).V_Breite = -.V_Breite
                                    End If
                                    If .V_LängeE = 1 Then
                                        GPSLD(GPSLC).V_Länge = .V_Länge
                                    Else: GPSLD(GPSLC).V_Länge = -.V_Länge
                                    End If
                                End With
                            Case GPS_S_GGA
                            Case GPS_S_GSA
                            Case GPS_S_GSV
                                Debug.Print "GSV"
                                With .V_GSV
                                    For Y = 1 To .V_SatC
                                        SID = 0
                                        For Z = 1 To GPSSC
                                            If GPSSD(Z).V_SatID = .V_SatD(Y).V_SID Then
                                                SID = Z
                                                Exit For
                                            End If
                                        Next
                                        If SID = 0 Then
                                            GPSSC = GPSSC + 1
                                            SID = GPSSC
                                            ReDim Preserve GPSSD(GPSSC) As GPS_Sat_Type
                                        End If
                                        GPSSD(SID).T_UpDate = Now
                                        GPSSD(SID).V_SatID = .V_SatD(Y).V_SID
                                        GPSSD(SID).V_Signal = .V_SatD(Y).V_SNR
                                        GPSSD(SID).V_Breite = .V_SatD(Y).V_EIDTT
                                        GPSSD(SID).V_Länge = .V_SatD(Y).V_AIDTT - 180
                                    Next
                                End With
                            Case GPS_S_GLL
                            Case GPS_S_VTG
                            Case GPS_S_ZDA
                            Case GPS_S_FSI
                        End Select
                    End If
                End With
            Next
        End If
End Select
End Sub

Private Sub PS_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error Resume Next
Select Case Shift
    Case 0
        If Button = 1 Then
            XPSX = X
            XPSY = Y
        End If
    Case 1
        Dim OX As Long
        Dim OY As Long
        Select Case Button
            Case 1: XZoom = XZoom + 1
            Case 2: XZoom = XZoom - 1
        End Select
        DrawMap
End Select
End Sub

Private Sub PS_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error Resume Next
Select Case Shift
    Case 0
        If Button = 1 Then
            XPosX = XPosX + (X - XPSX)
            XPosY = XPosY + (Y - XPSY)
            XPSX = X
            XPSY = Y
            DrawMap
        End If
    Case 1
        Select Case Button
            Case 1
            Case 2
        End Select
End Select
End Sub

Private Sub PS_Paint()
On Error Resume Next
PS.PaintPicture BS.Image, 0, 0
End Sub

Public Function DrawMap()
On Error Resume Next
Dim XW As Double
Dim XH As Double
Dim XWS As Double
Dim XHS As Double
Dim VX As Double
Dim VY As Double
Dim LX As Double
Dim LY As Double
Dim XR As Long
Dim X As Long
XR = 1
With BS
    .Width = PS.Width
    .Height = PS.Height
    .ForeColor = vbBlack
    .FillColor = vbBlack
    .FillStyle = 0
    BS.Line (0, 0)-(.Width, .Height), , B
    If XZoom = 0 Then XZoom = 1
    XW = BS.Width / XZoom
    XH = BS.Height / XZoom
'    BS.PaintPicture WM.Picture, XPosX, XPosY, XW, XH
'    BS.PaintPicture WM.Picture, 0, 0, BS.Width, BS.Height, ((CDbl(WM.Width) / 4 + 51) + -(XPosX / XZoom)),
'        (CDbl(WM.Height) / 8 - 11) + -(XPosY / XZoom), XW, XH
    XW = BS.Width * XZoom
    XH = BS.Height * XZoom
    XW = XW / 2
    XH = XH / 2
    XWS = XW / 180
    XHS = XH / 90
    .FillStyle = 1
    .ForeColor = vbBlue
    For X = 1 To GPSLC
        With GPSLD(X)
            VX = XWS * .V_Länge + CLng(HScroll1(0).Value) / 10 + CLng(HScroll2(0).Value) / 10000
            VY = XHS * .V_Breite + CLng(HScroll1(1).Value) / 10 + CLng(HScroll2(1).Value) / 10000
        End With
        If X > 1 Then BS.Line (XPosX + XW + CLng(VX), XPosY + XH + CLng(VY))-(XPosX + XW + CLng(LX), XPosY + XH + CLng(LY))
        LX = VX
        LY = VY
    Next
    
    For X = 1 To GPSLC
        With GPSLD(X)
            VX = XWS * .V_Länge + CLng(HScroll1(0).Value) / 10 + CLng(HScroll2(0).Value) / 10000
            VY = XHS * .V_Breite + CLng(HScroll1(1).Value) / 10 + CLng(HScroll2(1).Value) / 10000
        End With
        .ForeColor = vbRed
        BS.Line (XPosX + XW + CLng(VX - XR), XPosY + XH + CLng(VY - XR))-(XPosX + XW + CLng(VX + XR), XPosY + XH + CLng(VY + XR)), , B
    Next

    For X = 1 To GPSSC
        With GPSSD(X)
            VX = XWS * .V_Länge + CLng(HScroll1(0).Value) / 10 + CLng(HScroll2(0).Value) / 10000
            VY = XHS * .V_Breite + CLng(HScroll1(1).Value) / 10 + CLng(HScroll2(1).Value) / 10000
        End With
        .ForeColor = vbRed
        BS.Line (XPosX + XW + CLng(VX - XR), XPosY + XH + CLng(VY - XR))-(XPosX + XW + CLng(VX + XR), XPosY + XH + CLng(VY + XR)), , B
        .ForeColor = vbBlack
        BS.Line (XPosX + XW + CLng(VX), XPosY + XH + CLng(VY))-(XPosX + XW + CLng(VX) + 20, XPosY + XH + CLng(VY) - 10)
        .ForeColor = vbWhite
        .CurrentX = XPosX + XW + CLng(VX) + 20
        .CurrentY = XPosY + XH + CLng(VY) - 10 - 20
        BS.Print "GSID: " & GPSSD(X).V_SatID
        .CurrentX = XPosX + XW + CLng(VX) + 20
        .CurrentY = XPosY + XH + CLng(VY) - 10 - 10
        BS.Print "SNR: " & GPSSD(X).V_Signal
        .CurrentX = XPosX + XW + CLng(VX) + 20
        .CurrentY = XPosY + XH + CLng(VY) - 10
        BS.Print "Lon: " & CStr(GPSSD(X).V_Länge)
        .CurrentX = XPosX + XW + CLng(VX) + 20
        .CurrentY = XPosY + XH + CLng(VY) - 10 + 10
        BS.Print "Lat: " & CStr(GPSSD(X).V_Breite)
    Next
    XR = 5
    If GPSLC > 0 Then
        With GPSLD(GPSLC)
            VX = XWS * .V_Länge + CLng(HScroll1(0).Value) / 10 + CLng(HScroll2(0).Value) / 10000
            VY = XHS * .V_Breite + CLng(HScroll1(1).Value) / 10 + CLng(HScroll2(1).Value) / 10000
        End With
        .ForeColor = vbRed
        BS.Line (XPosX + XW + CLng(VX - XR), XPosY + XH + CLng(VY - XR))-(XPosX + XW + CLng(VX + XR), XPosY + XH + CLng(VY + XR)), , B
    End If
End With
PS_Paint
End Function

Private Sub Timer1_Timer()
On Error Resume Next
DrawMap
End Sub
'---------- Ende Formular "Form1" alias Form1.frm  ----------
'--------- Anfang Modul "GPS_Mod" alias GPS_Mod.bas ---------
Option Explicit

'### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ###
'### By.: Martin Wiemann                                                                                             ###
'###  Admin@MLN.ath.cx                                                                                               ###
'### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ###



'#######################################################################################################################
'== NMEA <-> RS232 ==
'Baud = 4800 (Standard) (Gängige Geräte senden jedoch mit 9600Baud, oder mehr. Teilweise Konfigurierbar)
'Bits = 8
'Parität = keine
'Stopbit = 1
'#######################################################################################################################



'#######################################################################################################################
'== Genaue Angaben über Datensätze ==
'http://www.kowoma.de/gps/zusatzerklaerungen/NMEA.htm
'http://www.nmea.de/nmea0183datensaetze.html
'Receiver-Spezifische Befehle: http://www.gpsinformation.org/dale/nmea.htm
'NMEA-Daten auf Google abbilden: http://www.gpsvisualizer.com/map?form=google
'#######################################################################################################################


'#######################################################################################################################
Public Enum GPS_GPSatz_Enum
    GPS_S_Unknow = 0
    GPS_S_RMC = 1
    GPS_S_GGA = 2
    GPS_S_GSA = 3
    GPS_S_GSV = 4
    GPS_S_GLL = 5
    GPS_S_VTG = 6
    GPS_S_ZDA = 7
    GPS_S_FSI = 8
End Enum
'#######################################################################################################################


'#######################################################################################################################
Public Type GPS_S_RMC_Type
    V_Zeit As String 'hhnnss (UTC)
    V_Status As Byte '1=ok / 0=inkorreckt
    V_Breite As Double
    V_BreiteN As Byte 'Nord / Süd
    V_Länge As Double
    V_LängeE As Byte 'Ost / West
    V_Geschwindigkeit As Single 'Geschwindigkeit über grund (Knoten)
    V_Kurs As Single
    V_Datum As String 'ddmmyy
    V_Deklination As Single
    V_DeklinationE As Byte 'Ost / West
    V_Modus As Byte 'A=Autonom, D=Differentiell, E=geschätzt, N=ungültig, S=Simmulator
End Type
Public Type GPS_S_GGA_Type
    V_Zeit As String 'hhnnss (UTC)
    V_Breite As Double
    V_BreiteN As Byte 'Nord / Süd
    V_Länge As Double
    V_LängeE As Byte 'Ost / West
    V_MessQualität As Byte '0=ungültig, 1=GPS, 2=DGPS, 6=Geschätzt(nurNEMA-0183 V2.3)
    V_AnzahlSat As Long 'Anzahl Satelliten (00 - 12)
    V_HDOP As Single 'Horizontale Genauigkeit
    V_AAa As Single
    V_AAaUo As Byte 'Units of Antenna
    V_HGHE As Single
    V_HGHEUo As Byte
    V_DatenAlter As Single
    V_DRSID As Long 'DGPS Stations ID
End Type
Public Type GPS_S_GSA_Type
    V_Mode2D3D As Byte 'Gewählter Modus
    V_Mode As Byte 'Art der Positionsbestimmung (1=kein Fix, 2=2D-Fix, 3=3D-Fix)
    V_PRNNrD() As Long 'IDs der Satelieten (01 - 12)
    V_PRNNrC As Long 'Anzahl vorhandener IDs
    V_PDOP As Single 'Genauigkeit
    V_HDOP As Single 'Horizontale Genauigkeit
    V_VDOP As Single 'Vertikale Genauigkeit
End Type
Public Type GPS_S_GSV_Sat_Type
    V_SID As Long 'Satellitennummer
    V_EIDTT As Long 'Elevation in Grad (N<->S)
    V_AIDTT As Long 'Azimuth in Grad (W<->O)
    V_SNR As Long 'Signalstärke in dB
End Type
Public Type GPS_S_GSV_Type
    V_TNOM As Long 'Gesammte anzahl der Nachrichten
    V_MN As Long 'Nachrichten Nummer
    V_SIV As Long  'Anzhal Satelliten in sichtweite
    V_SatD() As GPS_S_GSV_Sat_Type 'Satelliten-Infos
    V_SatC As Long 'Anzahl Satinfos
End Type
Public Type GPS_S_GLL_Type
    V_Breite As Double
    V_BreiteN As Byte 'Nord / Süd
    V_Länge As Double
    V_LängeE As Byte 'Ost / West
    V_Zeit As String 'hhnnss (UTC)
    V_Status As Byte 'A=ok / V=inkorreckt
End Type
Public Type GPS_S_VTG_Type
    V_KursT As Single 'Wahrer Kurs
    V_KursM As Single 'Mangnetischer Kurs
    V_GeschwindigkeitN As Single 'Geschwindigkeit über Grund in Knoten (N)
    V_GeschwindigkeitK As Single 'Geschwindigkeit über Grund in Km/h (K)
End Type
Public Type GPS_S_ZDA_Type
    V_Zeit As String
    V_Datum As String
    V_LocalZoneH As Integer 'Lokale Zonen beschreibung (+/- 13) (Stunden)
    V_LocalZoneM As Integer 'Lokale Zonen beschreibung (+/- 31) (Minuten)
End Type
Public Type GPS_S_FSI_Type
    V_FrequenzTX As Long 'Sendefrequenz
    V_FrequenzRX As Long 'Empfangsfrequenz
    V_ComMode As Long 'Kommunikations_Modus (NMEA Syntax 2)
    V_PWR As Long 'Sendeleistung
End Type
'#######################################################################################################################
Public Type GPS_GPType
    V_Sender As String
    V_Type As GPS_GPSatz_Enum 'Typ des Datensatzes
    V_Checked As Byte 'Daten wurden durch Quersumme verifiziert
    V_RMC As GPS_S_RMC_Type
    V_GGA As GPS_S_GGA_Type
    V_GSA As GPS_S_GSA_Type
    V_GSV As GPS_S_GSV_Type
    V_GLL As GPS_S_GLL_Type
    V_VTG As GPS_S_VTG_Type
    V_ZDA As GPS_S_ZDA_Type
    V_FSI As GPS_S_FSI_Type
End Type
'#######################################################################################################################
Private GPS_TempData As String

'#######################################################################################################################
'GPS_DecodeData = Wandelt einen eingehenden NMEA-0183 Datenstrom in Dekodierte Datensätze um
'#######################################################################################################################
Public Function GPS_DecodeData(V_Data As String, B_DataD() As GPS_GPType, B_DataC As Long, _
        Optional V_IgnoreChecksumme As Boolean = False)
On Error Resume Next
Dim XCheckSumme As String
Dim X As Long
Dim Y As Long
Dim Pos As Long
Dim T As String
Dim TCS As Byte
Dim XD() As String
Dim XC As Long
Dim XT As String
Dim XSenderkennung As String
Dim XSatzkennung As String
Dim GPST As GPS_GPType
Dim XChecked As Boolean
'Rückgabedatensätze auf 0 setzen
B_DataC = 0
'Daten an temporätvariable anhängen
GPS_TempData = GPS_TempData & V_Data
'Temp-Daten durchlaufen
For X = 1 To Len(GPS_TempData)
    'Datensatz ende suchen
    Pos = InStr(1, GPS_TempData, vbCrLf)
    'Ende gefunden?
    If Pos > 0 Then
        'Datensatz abschneiden und in Temo-Variable kopieren
        T = Mid(GPS_TempData, 1, Pos - 1)
        'Rest abschneiden
        GPS_TempData = Mid(GPS_TempData, Pos + 2)
    Else
        'Wenn kein Datensatz gefunden wurde, Temp-Variable leeren
        T = ""
    End If
    'Ist in der Temp ein Datensatz?
    If T <> "" Then
        'Prüfen ob Datensatz mit $ beginnt (Startmarkierung jedes Datensatz)
        If Left(T, 1) = "$" Then
            '$ Abschneiden
            T = Mid(T, 2)
            'Verifikation auf Falsch setzen
            XChecked = False
            'von hinten suchen Prüfen ob * vorhanden ist (Markierung für Quersumme)
            Pos = InStrRev(T, "*")
            'Gefunden?
            If Pos > 0 Then
                'Checksumme abschneiden, udn in Temp-Variable schreiben
                XCheckSumme = Mid(T, Pos + 1)
                'Rest abschneiden
                T = Mid(T, 1, Pos - 1)
                'Quersummen-Test-Variable auf 0 setzen
                TCS = 0
                'Datensatz durchlaufen
                For Y = 1 To Len(T)
                    'Alle Bytes miteinander verknüpfen
                    TCS = TCS Xor Asc(Mid(T, Y, 1))
                Next
                'Ist die Quersumme gleich dem Hexwert der Checksumme
                If LCase(Hex(TCS)) <> LCase(XCheckSumme) Then
                    'Wenn fehlerhafte Quersumme NICHT Ignoriert werden soll, Datensatz leeren
                    If V_IgnoreChecksumme = False Then T = ""
                Else
                    'Ansonsten Quersummenprüfung auf Valid stellen
                    XChecked = True
                End If
            End If
            'Prüfen ob Datensatz noch korreckt ist.
            If T <> "" Then
                '2Byte Senderkennung abschneiden
                XSenderkennung = Mid(T, 1, 2)
                '3 Byte Datensatzkennung abschneiden
                XSatzkennung = Mid(T, 3, 3)
                'Rest abschneiden
                T = Mid(T, 7)
                'Elementanzahl zurücksetzen
                XC = 0
                'Datensatz durchlaufen
                For Y = 1 To Len(T)
                    'Nach , im Datensatz suchen
                    Pos = InStr(1, T, ",")
                    'Gefunden?
                    If Pos > 0 Then
                        'Neues Element hinzufügen
                        XC = XC + 1
                        'Elemente Redimensionieren
                        ReDim Preserve XD(XC) As String
                        'Element in Array speichern
                        XD(XC) = Mid(T, 1, Pos - 1)
                        'Rest abschneiden
                        T = Mid(T, Pos + 1)
                    'Kein weiteres , gefunden
                    Else
                        'Neues Element hinzufügen
                        XC = XC + 1
                        'Elemente Redimensionieren
                        ReDim Preserve XD(XC) As String
                        'Rest in Array speichern
                        XD(XC) = T
                        'Schleife verlassen
                        Exit For
                    End If
                Next
                'Satzkennung MUSS Grossgeschrieben sein, ansonsten ist Datensatz beschädigt
                Select Case XSatzkennung
                    'Pflichtfeld
                    Case "RMC"
                        'Prüfen ob Elemntanzahl korrcket ist.
                        If XC = 12 Then
                            'Neuen RDS (Rückgabedatensatz) erstellen
                            B_DataC = B_DataC + 1
                            'Redimensionieren
                            ReDim Preserve B_DataD(B_DataC) As GPS_GPType
                            'Leeren Datensatz
                            B_DataD(B_DataC) = GPST
                            'Senderkennung Speichern (z.B. GP für GPS Datensatz)
                            B_DataD(B_DataC).V_Sender = XSenderkennung
                            'Typ des Datensatz speichern
                            B_DataD(B_DataC).V_Type = GPS_S_RMC
                            'erfolgreiche verifikation Verifikation speichern
                            If XChecked = True Then B_DataD(B_DataC).V_Checked = 1
                            With B_DataD(B_DataC).V_RMC
                                'Uhrzeit decodieren, und speichern
                                If Len(XD(1)) = 6 Then .V_Zeit = Mid(XD(1), 1, 2) & ":" & Mid(XD(1), 3, 2) & ":" & Mid(XD(1), 5, 2)
                                'Status auswählen
                                Select Case XD(2)
                                    '(OK)
                                    Case "A": .V_Status = 1
                                    '(Fehler)
                                    Case "V": .V_Status = 2
                                    '(unbekannt)
                                    Case Else: .V_Status = 0
                                End Select
                                'Breite auf Grad,Kommagrad umrechnen
                                If IsNumeric(XD(3)) = True Then .V_Breite = CDbl(Replace(XD(3), ".", ",")) / 100
                                'Messrichtung angeben
                                Select Case XD(4)
                                    'S = Von Süd gemessen
                                    Case "S": .V_BreiteN = 1
                                    'N = Von Nord Gemessen
                                    Case "N": .V_BreiteN = 2
                                    'Richtung unbekannt
                                    Case Else: .V_BreiteN = 0
                                End Select
                                If IsNumeric(XD(5)) = True Then .V_Länge = CDbl(Replace(XD(5), ".", ",")) / 100
                                'Messrichtung
                                Select Case XD(6)
                                    Case "E": .V_LängeE = 1
                                    Case "W": .V_LängeE = 2
                                    Case Else: .V_LängeE = 0
                                End Select
                                'Geschwindigkeit speichern
                                If IsNumeric(XD(7)) = True Then .V_Geschwindigkeit = CSng(Replace(XD(7), ".", ","))
                                'Kurs speichern
                                If IsNumeric(XD(8)) = True Then .V_Kurs = CSng(Replace(XD(8), ".", ","))
                                'Datum Dekodieren
                                If Len(XD(9)) = 6 Then .V_Datum = Mid(XD(9), 1, 2) & "." & Mid(XD(9), 3, 2) & "." & Mid(XD(9), 5, 2)
                                'Deklination speichern
                                If IsNumeric(XD(10)) = True Then .V_Deklination = CSng(Replace(XD(10), ".", ","))
                                'Messrichtung
                                Select Case XD(11)
                                    Case "E": .V_DeklinationE = 1
                                    Case "W": .V_DeklinationE = 2
                                    Case Else: .V_DeklinationE = 0
                                End Select
                                'Modus
                                Select Case XD(12)
                                    'Autonom
                                    Case "A": .V_Modus = 1
                                    'Differentiell
                                    Case "D": .V_Modus = 2
                                    'geschätzt
                                    Case "E": .V_Modus = 3
                                    'ungültig
                                    Case "N": .V_Modus = 4
                                    'Simmulator
                                    Case "S": .V_Modus = 5
                                    'Unbekannt
                                    Case Else: .V_Modus = 0
                                End Select
                            End With
                        End If
                    Case "GGA"
                        If XC = 14 Then
                            B_DataC = B_DataC + 1
                            ReDim Preserve B_DataD(B_DataC) As GPS_GPType
                            B_DataD(B_DataC) = GPST
                            B_DataD(B_DataC).V_Sender = XSenderkennung
                            B_DataD(B_DataC).V_Type = GPS_S_GGA
                            If XChecked = True Then B_DataD(B_DataC).V_Checked = 1
                            With B_DataD(B_DataC).V_GGA
                                If Len(XD(1)) = 6 Then .V_Zeit = Mid(XD(1), 1, 2) & ":" & Mid(XD(1), 3, 2) & ":" & Mid(XD(1), 5, 2)
                                If IsNumeric(XD(2)) = True Then .V_Breite = CDbl(Replace(XD(2), ".", ",")) / 100
                                Select Case XD(3)
                                    Case "S": .V_BreiteN = 1
                                    Case "N": .V_BreiteN = 2
                                    Case Else: .V_BreiteN = 0
                                End Select
                                If IsNumeric(XD(4)) = True Then .V_Länge = CDbl(Replace(XD(4), ".", ",")) / 100
                                Select Case XD(5)
                                    Case "E": .V_LängeE = 1
                                    Case "W": .V_LängeE = 2
                                    Case Else: .V_LängeE = 0
                                End Select
                                Select Case XD(6)
                                    'ungültig
                                    Case "0": .V_MessQualität = 1
                                    'GPS (normales GPS)
                                    Case "1": .V_MessQualität = 2
                                    'DGPS (Diferenzial-GPS) (Genauer als Normales GPS)
                                    Case "2": .V_MessQualität = 3
                                    'Geschätzt(nurNEMA-0183 V2.3)
                                    Case "6": .V_MessQualität = 4
                                    'Unbekannt
                                    Case Else: .V_MessQualität = 0
                                End Select
                                'Anzhal Satelliten
                                If IsNumeric(XD(7)) = True Then .V_AnzahlSat = CLng(XD(7))
                                'Horizontale Genauigkeit
                                If IsNumeric(XD(8)) = True Then .V_HDOP = CSng(Replace(XD(8), ".", ","))
                                If IsNumeric(XD(9)) = True Then .V_AAa = CSng(Replace(XD(9), ".", ","))
                                'Mess-Einheit
                                Select Case XD(10)
                                    'Meter
                                    Case "M": .V_AAaUo = 1
                                    'Unbekannt
                                    Case Else: .V_AAaUo = 0
                                End Select
                                If IsNumeric(XD(11)) = True Then .V_HGHE = CSng(Replace(XD(11), ".", ","))
                                Select Case XD(12)
                                    Case "M": .V_HGHEUo = 1
                                    Case Else: .V_HGHEUo = 0
                                End Select
                                'Alter der Daten
                                If IsNumeric(XD(13)) = True Then .V_DatenAlter = CSng(Replace(XD(13), ".", ","))
                                If IsNumeric(XD(14)) = True Then .V_DRSID = CLng(Replace(XD(14), ".", ","))
                            End With
                        End If
                    Case "GSA"
                        If XC = 17 Then
                            B_DataC = B_DataC + 1
                            ReDim Preserve B_DataD(B_DataC) As GPS_GPType
                            B_DataD(B_DataC) = GPST
                            B_DataD(B_DataC).V_Sender = XSenderkennung
                            B_DataD(B_DataC).V_Type = GPS_S_GSA
                            If XChecked = True Then B_DataD(B_DataC).V_Checked = 1
                            With B_DataD(B_DataC).V_GSA
                                Select Case XD(1)
                                    Case "A": .V_Mode2D3D = 1
                                    Case Else: .V_Mode2D3D = 0
                                End Select
                                Select Case XD(2)
                                    Case "1", "2", "3": .V_Mode = CLng(XD(2))
                                    Case Else: .V_Mode = 0
                                End Select
                                For Y = 3 To 14
                                    If IsNumeric(XD(Y)) = True Then
                                        .V_PRNNrC = .V_PRNNrC + 1
                                        ReDim Preserve .V_PRNNrD(.V_PRNNrC) As Long
                                        .V_PRNNrD(.V_PRNNrC) = CLng(XD(Y))
                                    End If
                                Next
                                If IsNumeric(XD(15)) = True Then .V_PDOP = CSng(Replace(XD(15), ".", ","))
                                If IsNumeric(XD(16)) = True Then .V_HDOP = CSng(Replace(XD(16), ".", ","))
                                If IsNumeric(XD(17)) = True Then .V_VDOP = CSng(Replace(XD(17), ".", ","))
                            End With
                        End If
                    'Satellieten-Informationen
                    Case "GSV"
                        'Ist Anzahl Elemente min. 3?
                        If XC >= 3 Then
                            'Anzahl Satelliten-Informationen durch 4 Teilbar? (ohne rest)
                            If ((XC - 3) Mod 4) = 0 Then
                                B_DataC = B_DataC + 1
                                ReDim Preserve B_DataD(B_DataC) As GPS_GPType
                                B_DataD(B_DataC) = GPST
                                B_DataD(B_DataC).V_Sender = XSenderkennung
                                B_DataD(B_DataC).V_Type = GPS_S_GSV
                                If XChecked = True Then B_DataD(B_DataC).V_Checked = 1
                                With B_DataD(B_DataC).V_GSV
                                    'Gesammte Anzahl an Nachrichten im Packet
                                    If IsNumeric(XD(1)) = True Then .V_TNOM = CLng(XD(1))
                                    'Nachrichtennummer
                                    If IsNumeric(XD(2)) = True Then .V_MN = CLng(XD(2))
                                    'Anzahl Satelliten in Sichtweite
                                    If IsNumeric(XD(3)) = True Then .V_SIV = CLng(XD(3))
                                    'Satellit-Informationen einzeln durchlaufen
                                    For Y = 4 To XC - 3 Step 4
                                        'Daten prüfen
                                        If IsNumeric(XD(Y)) = True And IsNumeric(XD(Y + 1)) = True And _
                                                IsNumeric(XD(Y + 2)) = True And IsNumeric(XD(Y + 3)) = True Then
                                            'Neuen Satellit hinzufügen
                                            .V_SatC = .V_SatC + 1
                                            ReDim Preserve .V_SatD(.V_SatC) As GPS_S_GSV_Sat_Type
                                            With .V_SatD(.V_SatC)
                                                'Satellit-ID speichern
                                                .V_SID = CLng(XD(Y))
                                                'Elevator des Satellit
                                                .V_EIDTT = CSng(Replace(XD(Y + 1), ".", ","))
                                                'Azimute des Satellit
                                                .V_AIDTT = CSng(Replace(XD(Y + 2), ".", ","))
                                                'Signalstärke des Satellit
                                                .V_SNR = CLng(XD(Y + 3))
                                            End With
                                        End If
                                    Next
                                End With
                            End If
                        End If
                    Case "GLL"
                        If XC >= 4 Then
                            B_DataC = B_DataC + 1
                            ReDim Preserve B_DataD(B_DataC) As GPS_GPType
                            B_DataD(B_DataC) = GPST
                            B_DataD(B_DataC).V_Sender = XSenderkennung
                            B_DataD(B_DataC).V_Type = GPS_S_GLL
                            If XChecked = True Then B_DataD(B_DataC).V_Checked = 1
                            With B_DataD(B_DataC).V_GLL
                                If IsNumeric(XD(1)) = True Then .V_Breite = CDbl(Replace(XD(1), ".", ",")) / 100
                                Select Case XD(2)
                                    Case "S": .V_BreiteN = 1
                                    Case "N": .V_BreiteN = 2
                                    Case Else: .V_BreiteN = 0
                                End Select
                                If IsNumeric(XD(3)) = True Then .V_Länge = CDbl(Replace(XD(3), ".", ",")) / 100
                                Select Case XD(4)
                                    Case "E": .V_LängeE = 1
                                    Case "W": .V_LängeE = 2
                                    Case Else: .V_LängeE = 0
                                End Select
                                If XC >= 5 Then
                                    If Len(XD(5)) = 6 Then .V_Zeit = Mid(XD(5), 1, 2) & ":" & Mid(XD(5), 3, 2) & ":" & Mid(XD(5), 5, 2)
                                End If
                                If XC >= 6 Then
                                    Select Case XD(6)
                                        '(OK)
                                        Case "A": .V_Status = 1
                                        'Fehler)
                                        Case "V": .V_Status = 2
                                        '(unbekannt)
                                        Case Else: .V_Status = 0
                                    End Select
                                End If
                            End With
                        End If
                    'Kurs un dGeschwindigkeit
                    Case "VTG"
                        If XC = 8 Then
                            B_DataC = B_DataC + 1
                            ReDim Preserve B_DataD(B_DataC) As GPS_GPType
                            B_DataD(B_DataC) = GPST
                            B_DataD(B_DataC).V_Sender = XSenderkennung
                            B_DataD(B_DataC).V_Type = GPS_S_VTG
                            If XChecked = True Then B_DataD(B_DataC).V_Checked = 1
                            With B_DataD(B_DataC).V_VTG
                                Select Case XD(2)
                                    Case "T": If IsNumeric(XD(1)) = True Then .V_KursT = CSng(Replace(XD(1), ".", ","))
                                    Case "M": If IsNumeric(XD(1)) = True Then .V_KursM = CSng(Replace(XD(1), ".", ","))
                                End Select
                                Select Case XD(4)
                                    Case "T": If IsNumeric(XD(3)) = True Then .V_KursT = CSng(Replace(XD(3), ".", ","))
                                    Case "M": If IsNumeric(XD(3)) = True Then .V_KursM = CSng(Replace(XD(3), ".", ","))
                                End Select
                                Select Case XD(6)
                                    Case "N": If IsNumeric(XD(5)) = True Then .V_GeschwindigkeitN = CSng(Replace(XD(5), ".", ","))
                                    Case "K": If IsNumeric(XD(5)) = True Then .V_GeschwindigkeitK = CSng(Replace(XD(5), ".", ","))
                                End Select
                                Select Case XD(8)
                                    Case "N": If IsNumeric(XD(7)) = True Then .V_GeschwindigkeitN = CSng(Replace(XD(7), ".", ","))
                                    Case "K": If IsNumeric(XD(7)) = True Then .V_GeschwindigkeitK = CSng(Replace(XD(7), ".", ","))
                                End Select
                            End With
                        End If
                    Case "ZDA"
                        If XC = 4 Then
                            B_DataC = B_DataC + 1
                            ReDim Preserve B_DataD(B_DataC) As GPS_GPType
                            B_DataD(B_DataC) = GPST
                            B_DataD(B_DataC).V_Sender = XSenderkennung
                            B_DataD(B_DataC).V_Type = GPS_S_ZDA
                            If XChecked = True Then B_DataD(B_DataC).V_Checked = 1
                            With B_DataD(B_DataC).V_ZDA
                                If Len(XD(1)) = 6 Then .V_Zeit = Mid(XD(1), 1, 2) & ":" & Mid(XD(1), 3, 2) & ":" & Mid(XD(1), 5, 2)
                                If IsNumeric(XD(2)) = True And IsNumeric(XD(3)) = True And IsNumeric(XD(4)) = True Then
                                    .V_Datum = Format(XD(2), "00") & ":" & Format(XD(3), "00") & ":" & Format(XD(4), "00")
                                End If
                                If IsNumeric(XD(5)) = True Then .V_LocalZoneH = CLng(XD(5))
                                If IsNumeric(XD(6)) = True Then .V_LocalZoneM = CLng(XD(6))
                            End With
                        End If
                    Case "FSI"
                        If XC = 4 Then
                            B_DataC = B_DataC + 1
                            ReDim Preserve B_DataD(B_DataC) As GPS_GPType
                            B_DataD(B_DataC) = GPST
                            B_DataD(B_DataC).V_Sender = XSenderkennung
                            B_DataD(B_DataC).V_Type = GPS_S_FSI
                            If XChecked = True Then B_DataD(B_DataC).V_Checked = 1
                            With B_DataD(B_DataC).V_FSI
                                If IsNumeric(XD(1)) = True Then .V_FrequenzTX = CLng(XD(1))
                                If IsNumeric(XD(2)) = True Then .V_FrequenzRX = CLng(XD(2))
                                Select Case XD(3)
                                    Case "C": .V_ComMode = 1
                                    Case Else: .V_ComMode = 0
                                End Select
                                If IsNumeric(XD(4)) = True Then .V_PWR = CLng(XD(4))
                            End With
                        End If
                    'Unbekanntes Packet speichern
                    Case Else
                        B_DataC = B_DataC + 1
                        ReDim Preserve B_DataD(B_DataC) As GPS_GPType
                        B_DataD(B_DataC) = GPST
                        B_DataD(B_DataC).V_Sender = XSenderkennung
                        B_DataD(B_DataC).V_Type = GPS_S_Unknow
                        If XChecked = True Then B_DataD(B_DataC).V_Checked = 0
                End Select
            End If
        End If
    End If
Next
End Function

'---------- Ende Modul "GPS_Mod" alias GPS_Mod.bas ----------
'-------------- Ende Projektdatei GPS_Test.vbp --------------

Tipp-Kompatibilität:

Windows/VB-VersionWin32sWin95Win98WinMEWinNT4Win2000WinXP
VB4
VB5
VB6

Hat dieser Tipp auf Ihrem Betriebsystem und mit Ihrer VB-Version funktioniert?

Ja, funktioniert!

Nein, funktioniert nicht bei mir!

VB-Version:

Windows-Version:

Ihre Meinung  

Falls Sie Fragen zu diesem Artikel haben oder Ihre Erfahrung mit anderen Nutzern austauschen möchten, dann teilen Sie uns diese bitte in einem der unten vorhandenen Themen oder über einen neuen Beitrag mit. Hierzu können sie einfach einen Beitrag in einem zum Thema passenden Forum anlegen, welcher automatisch mit dieser Seite verknüpft wird.