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: Select all
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