VB 5/6-Tipp 0744: GPS / NMEA Datensätze Dekodieren
von ThePuppetMaster
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:
| Verwendete API-Aufrufe: keine | Download: |
'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-Version | Win32s | Win95 | Win98 | WinME | WinNT4 | Win2000 | WinXP |
| VB4 |  | | | | | | |
| VB5 | | | | | | |  |
| VB6 | | | | | | | |
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.