how can read out gps-data gps-usb-device via vb.net?
it took me while gather information , code-snippets read latitude/longitude coordinates gps attached via usb.
so here resulting class clsgpslocation. includes function checks com ports determin wether gps connected (findcomport) , sub returns latitude/longitude (getpos). public var _satellitesinview holds number of satellites of last getpos-call.
usage:
dim gpslocation new clsgpslocation dim latitude double, longitude double gpslocation.getpos(latitude, longitude) and here class:
imports system.io.ports 'public subs , functions 'sub new() 'sub new(port$) 'if port known 'function findcomport() string 'returns example 'com4' if com4 read out returns gps-messages 'public function opengpsport() boolean 'returns true if _serport open or opened 'public sub getpos(byref lat double, byref lon double) 'returns latitude / longitude in case of success. 0, 0 if not public class clsgpslocation dim _serport new serialport() public _port$ public _satellitesinview& dim gpslogfile = "gps.log" sub new() end sub sub new(port$) _port$ = port$ end sub public function findcomport() string findcomport = "" integer = 1 9 try _serport.close() catch ex exception end try _serport.portname = "com" & try _serport.open() catch ex exception end try if _serport.isopen '5 sekunden einlesen dim tmstart date = while tmstart.addseconds(5) > application.doevents() dim msg$ = _serport.readexisting if msg.contains("$gprmc") 'gefunden _port = _serport.portname findcomport = _serport.portname exit function end if application.doevents() end while end if next try _serport.close() catch ex exception end try end function public function opengpsport() boolean 'offen: ok if _serport.isopen return true 'port bereits ermittelt? if _port <> "" _serport.portname = _port try _serport.open() catch ex exception end try if _serport.isopen return true end if 'port ermitteln _port = findcomport() return _serport.isopen end function public function isopen() boolean return _serport.isopen end function private function getmsg() string if not opengpsport() return "" end if '5 sekunden einlesen dim tmstart date = while tmstart.addseconds(5) > application.doevents() dim msg$ = _serport.readexisting if msg.contains("$gprmc") 'gelesen return msg end if application.doevents() end while 'nix return "" end function private function todecimal(byval pos string) double 'pos="5601.0318" 'degrees: 56, minutes: 010318 'berechnung: decimal degrees = degrees + minutes/60 'posdb: 56.010318 dim posdb double = ctype(replace(pos, ".", ","), double) 'replace . , (used in german doubles) 'deg: 56 dim deg double = math.floor(posdb / 100) dim decpos double = math.round(deg + ((posdb - (deg * 100)) / 60), 5) return decpos '=56.0172 end function public sub getpos(byref lat double, byref lon double) lat = 0 lon = 0 if not opengpsport() exit sub end if dim msg$ dim sentence$ dim logsentence$ while true msg$ = getmsg() dim sentences() string = split(msg$, "$") dim bposread boolean = false integer = 0 sentences.count - 2 'den letzten satz nicht verarbeiten da der meistens verstümmelt ist. es wird immer nur der buffer gefüllt auch wenn der letzte satz nicht mehr komplett passt. sentence = sentences(i) dim words() string = split(sentence, ",") select case words(0) case "gpgga" lat = todecimal(words(2)) lon = todecimal(words(4)) _satellitesinview& = clng(words(7)) logsentence$ = & ":" & sentence bposread = true case "gprmc" lat = todecimal(words(3)) lon = todecimal(words(5)) logsentence$ = & ":" & sentence bposread = true case "gpgll" lat = todecimal(words(1)) lon = todecimal(words(3)) logsentence$ = & ":" & sentence bposread = true case "gprma" lat = todecimal(words(2)) lon = todecimal(words(4)) logsentence$ = & ":" & sentence bposread = true end select application.doevents() next if bposread = true exit while application.doevents() end while 'gpslogfile 'call function writes logsentence$ gpslogfile end sub end class
blockquote
Comments
Post a Comment