View Single Post
Old 12-02-2004   #1 (permalink)
janolap1
Registered Member
 
Join Date: Nov 2004
Posts: 9
Post Simple script to log GPS position

Hi,

This is a simple script to log GPS position from netstumbler of course.
But it's optimized to work with GPS visualiser.
So put the .ns1 file and the csv file generated by the script and you have your map.

Code:
Option Explicit
'***************************************************
'	Script:		TrackGPSNS
'	Version:	0.1
'	Description:	This script:
'	write a comma separated value file of the GPS position
'	Author:		Jean Cartier
'	Original code:  rogerRabbit

'******************************************************


Dim oFS, oTS, acquiredGPS, CL, PL, lastLatDB, lastLonDB, lastAltDB, lastLatTrack, lastLonTrack, nameScript, nameDir, nameDB, dist, rTime, myColon, myHour, myMinute, myTime

nameScript	= "TrackGPSNS"
rTime = Time()
myColon = instr(1, rTime, ":",vbBinaryCompare)

IF myColon = 2 THEN
            myHour = Left(rTime,1)
            myMinute = Mid(rTime, 3, 2)
        ELSE
            myHour = Left(rTime,2)
            myMinute = Mid(rTime, 4, 2)
        END IF

myTime = myHour & myMinute
nameDB	= Year(Now())&Month(Now())&Day(Now())&myTime&".csv"
dist = 20

Initialise

Sub OnGPSPosition (Lat, Lon, Alt)
	If acquiredGPS Then
		If Distance(lastLatDB, lastLonDB, Lat, Lon) > dist Then
			WriteToDB Lat, Lon, Alt
			UpdateBreadcrumbs Lat, Lon, Alt
		End If

		If TrackOK(Lat, Lon) Then
			UpdatePreviousLocation
			UpdateCurrentLocation Lat, Lon
		End If
	Else
		If AcquiredOK(Lat, Lon) Then
			acquiredGPS = True
			UpdateCurrentLocation Lat, Lon
			WriteToDB Lat, Lon, Alt
		End If
		UpdateBreadcrumbs Lat, Lon, Alt
	End If
End Sub

'********************************************************
Sub Initialise ()
	Dim oWSH
	On Error Resume Next
	Set oFS = CreateObject("Scripting.FileSystemObject")
	If Err.Number <> 0 Then
		MsgBox "FSO initialisation failed!", 16, nameScript
		Exit Sub
	End If
	Set oWSH = CreateObject("WScript.Shell")
	If Err.Number <> 0 Then
		MsgBox "WSH Shell initialisation failed!", 16, nameScript
		Exit Sub
	End If
	nameDir = oWSH.RegRead("HKCU\Software\Bogosoft\NetStumbler\Settings\Script Name")
	Set oWSH = Nothing
	nameDir = oFS.GetParentFolderName(nameDir)
	If Not oFS.FolderExists(nameDir) Then
		MsgBox "TrackNS folder not found!", 16, nameScript
		Exit Sub
	Else
		nameDir = nameDir & "\"
	End If
	Set oTS = oFS.OpenTextFile(nameDir & nameDB, 8, True)
	If oTS.Line = 1 Then oTS.WriteLine("DateStamp,Latitude,Longitude,Altitude") 
End Sub

Function Distance (y0, x0, y1, x1)
	Distance = Sqr((y0 - y1) ^ 2 + ((x0 - x1) * 1.6172) ^ 2 ) * 225282
End Function

Function FormatMP (thisCoord)
	FormatMP = FormatNumber(thisCoord, 5)
End Function

Sub WriteToDB (thisLat, thisLon, thisAlt)
	On Error Resume Next
	oTS.WriteLine(FormatDateTime(Now, 0) & "," & replace(thisLat,",",".") & "," & replace(thisLon,",",".")& "," & replace(thisAlt,",","."))
	If Err.Number <> 0 Then Exit Sub
End Sub

Sub UpdateBreadcrumbs (thisLat, thisLon, thisAlt)
	lastLatDB = thisLat
	lastLonDB = thisLon
	lastAltDB = thisAlt
End Sub

Function TrackOK (thisLat, thisLon)
	If FormatMP(thisLat) <> lastLatTrack Or FormatMP(thisLon) <> lastLonTrack Then
		TrackOK = True
	Else
		TrackOK = False
	End If
End Function

Sub UpdatePreviousLocation ()
	On Error Resume Next
	Set PL = CL
	If Err.Number <> 0 Then Exit Sub
End Sub

Sub UpdateCurrentLocation (thisLat, thisLon)
	lastLatTrack = FormatMP(thisLat)
	lastLonTrack = FormatMP(thisLon)
End Sub

Function AcquiredOK (thisLat, thisLon)
	If Not IsEmpty(lastLatDB) And (thisLat <> lastLatDB Or thisLon <> lastLonDB) Then
		AcquiredOK = True
	Else
		AcquiredOK = False
	End If
End Function
Hope this can help someone

Cordially

Jean CARTIER
janolap1 is offline   Reply With Quote