Code:
' Copyright Marius Milner 2004.
' Use with NetStumbler. Edit. Enjoy.
'Version 00:19 20040511
'20040426 Marks changes made to use speech, when you are not lucky enough to have
' Mappoint. Also adds ability to turn off signal strength playing - TPEER
'20040429a Marks changes made to allow setting of voice - find \HKEY_LOCAL_MACHINE\SOFTWARE\
' Microsoft\Speech\Voices\Tokens - that should give you a list of voices you can set
' it starts at 0, not 1. Change the line "Set TTS.voice = TTS.getvoices().item(X)" where X
' equals the number of the voice you want - TPEER
'20040429b Marks changes made to store the WEP status with the SSID, so the 'Stumbler Lady' will
' add "is Open" or "is Closed" - TPEER
' Start of by Laidback 030504
' Start of by Laidback - Start of Changes made by Laidback
' End of by Laidback - End of Changes made by Laidback
' Code thanks to TrackNS & rogerRabbit!
' End of by Laidback 030504
'
'20040504 Marks change to allow override of default voice by this script
' Also set VoiceNum to the number of the voice you want to use
' Will say the name of the voice IF you override the default - TPEER
'20040506 Changes to Voice stuff. If VoiceNum = Empty, the default voice will used
' Modified the hello world message to be the name of the voice used
' organized the user changeable switches/variables a little
' Changed all mappoint stuff to not be checked unless UseMAppoint = True - TPEER
'
'20040509 Version 00:18 - Removed everything to do with zoomcontrol.txt! - Laidback
'
'20040511 Version 00:19 - Added message boxes if unable to initialize voice or mappoint
' Added variable for what to add to WEP and NOWEP SSIDs
' Fixed bug with UseSpeech - TPEER
Dim ActiveMap
Dim LastLocation
Dim MapPointApp
Dim HistoryPushpins
Dim MotionPushpins
Dim WLANPushpins
Dim Vehicle
Dim Initialized
Dim BSSID_Dictionary, Spoken_BSSIDs, New_SSIDs
Dim IsScanning
Dim HadGPSData
Dim LastLatitude, LastLongitude, LastAltitude
Dim DropCrumbs, TrackVehicle, UseSpeech, UseAudio
Dim LastHighlighted
Dim UseMappoint ' 20040426
Dim UseSignalStr ' 20040426
Dim AddWEP ' 20040429b
Dim strNoWEP '20040511
Dim strWEP '20040511
Dim VoiceNum '20040504
' Start of by Laidback 030504
Dim CL, nameDir
nameScript = "ns04mappoint00:19"
' end of by Laidback 030504
' Start of by Laidback 050504
Dim place
Dim zoomToStartLoc
' End of by Laidback 050504
'*************** User Configurable Switches ****************
'***********************************************************
'***** Mappoint
UseMappoint = True '20040426 - True if you want to use Mappoint - this overrides
' DropCrumbs and TrackVehicle
place = "camino de valhondo O barajas, 28042 Madrid, Spain" 'Enter your starting location (street,#, city, country)
zoomToStartLoc = True ' True if you want MapPoint to zoom to start location entered in 'place' above
DropCrumbs = True ' True to put black dots everywhere we go, False otherwise
TrackVehicle = True ' True to follow your location while scanning
'***** Speech
UseSpeech = True ' Speak names of networks in view
AddWEP = True '20040429b - True if you want voice to add WEP status "is Open" or "is Closed" to the SSID
strNoWep = " is Open" ' Set to what you want added to SSID for NonWEP
strWEP = " is Closed" ' Set to what you want added to SSID for WEP
VoiceNum = Empty ' 20040504 set this to the number of the voice you want to use - Setting to Empty will use the default voice
'***** Sounds
UseAudio = False ' Traditional script audio - if you are using speech this will only trigger if there are no
' new ssids to say
UseSignalStr = False '20040426 - True if you want the varying signal strength sounds - if you are using speech
'this will only trigger if there are no new ssids to say, and UseAudio = True
'***********************************************************
'*********************End of switches***********************
If UseMappoint Then '20040426
AddItemContextMenu "HighlightOnMap", "Highlight on map"
End If '20040426
Set LastHighlighted = Nothing
Set WLANPushpins = Nothing
Dim TTS
On Error Resume Next ' 20040511
If UseSpeech Then
Set TTS = CreateObject("Sapi.SpVoice")
If Err <> 0 then ' 20040511
UseSpeech = False ' 20040511
MsgBox "Unable to wake up Stumbler Lady", 16, nameScript '20040511
End If ' 20040511
End If
If UseSpeech then ' 20040511
If TTS Is Nothing Then
UseSpeech = False
else ' 20040429a
Set TTS.voice = TTS.getvoices().item(VoiceNum) ' 20040429a
End If
End If
If UseSpeech Then
TTS.Speak TTS.getvoices().item(VoiceNum).getdescription ' 20040505
'TTS.Speak "Hello Ian!" ' commented out 20040505
Set Spoken_BSSIDs = CreateObject("Scripting.Dictionary")
Set New_SSIDs = CreateObject("Scripting.Dictionary")
End If
Initialize
Sub Initialize()
On Error Resume Next
HadGPSData = False
Set BSSID_Dictionary = CreateObject("Scripting.Dictionary")
If UseMappoint Then '20040426
' Try to get a handle to an existing instance of MapPoint
Set MapPointApp = GetObject(, "MapPoint.Application")
' No instance found, create one.
If Err <> 0 Then
Err.Clear
Set MapPointApp = CreateObject("MapPoint.Application")
If Err = 0 then ' 20040505
MapPointApp.Visible = True
MapPointApp.UserControl = False
MapPointApp.Activate
else '20040505
Msgbox "Unable to initialize Mappoint", 16, nameScript '20040511
Err.Clear ' 20040505
UseMappoint = False ' 20040505
place = "" ' 20040505
zoomToStartLoc = False ' 20040505
DropCrumbs = False ' 20040505
TrackVehicle = False ' 20040505
End If ' 20040505
End If
End If ' 20040505
If UseMappoint Then '20040505
Set ActiveMap = MapPointApp.ActiveMap
Dim StartLoc
Set StartLoc = ActiveMap.FindResults(place)(1) ' Middle of, uh, somewhere
If DropCrumbs Then
Set HistoryPushpins = ActiveMap.Datasets.AddPushpinSet("Location History")
If Err <> 0 Then
Err.Clear
Set HistoryPushpins = ActiveMap.Datasets("Location History")
End If
End If
Set WLANPushpins = ActiveMap.Datasets.AddPushpinSet("Wireless LAN data")
If Err <> 0 Then
Err.Clear
Set WLANPushpins = ActiveMap.Datasets("Wireless LAN data")
End If
If TrackVehicle Then
Set MotionPushpins = ActiveMap.Datasets.AddPushpinSet("Last Location")
If Err <> 0 Then
Err.Clear
Set MotionPushpins = ActiveMap.Datasets("Last Location")
End If
Set Vehicle = MotionPushpins("Last Location")
If Err <> 0 Then
Err.Clear
Set Vehicle = FindOrAddPushpin(StartLoc, "Last Location", False)
End If
Vehicle.Symbol = 82 ' red car, just like the stumblemobile :-)
Vehicle.Highlight = True
Vehicle.MoveTo (MotionPushpins)
' Start of by Laidback 050504
if zoomToStartLoc = True then
MotionPushpins.ZoomTo
End if
' End of by Laidback 050504
End If
End If '20040426
Initialized = True
' Start of by Laidback 030504
IsScanning = True
End Sub
Function SSIDIcon(SSID)
Dim i, s
s = 0
For i = 1 To Len(SSID)
s = s + Asc(Mid(SSID, i, 1))
Next
SSIDIcon = 17 + (s Mod 47)
End Function
Sub HighlightOnMap(BSSID, SSID)
If Not LastHighlighted Is Nothing Then
LastHighlighted.Highlight = False
LastHighlighted.BalloonState = 0
End If
If BSSID_Dictionary.Exists(BSSID) Then
Set LastHighlighted = BSSID_Dictionary.Item(BSSID)
LastHighlighted.Highlight = True
LastHighlighted.BalloonState = 2
LastHighlighted.GoTo
End If
End Sub
Function FindOrAddPushpin(Loc, Title, InDict)
On Error Resume Next
Dim pp
Set pp = Nothing
Set pp = ActiveMap.AddPushpin(Loc, Title)
If pp Is Nothing Then Set pp = ActiveMap.FindPushpin(Title)
If InDict Then Set BSSID_Dictionary.Item(Title) = pp
Set FindOrAddPushpin = pp
End Function
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub OnGPSPosition(Lat, Lon, Alt)
' Lat : double : Latitude, degrees east
' Lon : double : Longitude, degrees north
' Alt : double : Altitude above sea level, meters
If Not Initialized Then
Initialize
End If
If UseMappoint Then '20040426
' Start of by Laidback 030504
on error resume next
' End of by Laidback 030504
If HadGPSData Then
' If we haven't moved, do nothing.
If LastLatitude = Lat And LastLongitude = Lon And LastAltitude = Alt Then Exit Sub
End If
LastLatitude = Lat
LastLongitude = Lon
LastAltitude = Alt
Set LastLocation = ActiveMap.GetLocation(Lat, Lon, Alt)
If DropCrumbs Then
Dim Crumb
Set Crumb = FindOrAddPushpin(LastLocation, Lat & " " & Lon & " " & Alt, False)
Crumb.Symbol = 16 ' Small black circle
Crumb.MoveTo (HistoryPushpins)
End If
If TrackVehicle Then
' Move the visual indicator to the new location.
Set Vehicle.Location = LastLocation
If IsScanning Or Not HadGPSData Then
' If scanning or first position, center the map on the new location
' Start of by Laidback 030504
UpdateCurrentLocation Lat, Lon
' End of by Laidback 030504
End If
End If
End If '20040426
HadGPSData = True
End Sub
' Called when user requests that scanning start, or when scanning is started automatically.
Sub OnEnableScan()
If Not HadGPSData Then Exit Sub ' Discard while no GPS
If Not Initialized Then
Initialize
End If
IsScanning = True
End Sub
' Called when user requests that scanning stop.
Sub OnDisableScan()
' Start of by Laidback 030504
on error resume next
' End of by Laidback 030504
If WLANPushpins Is Nothing Then
' Blah
Else
If UseMappoint Then '20040426
WLANPushpins.ZoomTo
End If '20040426
End If
IsScanning = False
End Sub
Sub OnScanResult(SSID, BSSID, CapFlags, Signal, Noise, LastSeen)
' SSID : String : SSID (Network name)
' BSSID : String : BSSID (MAC address)
' CapFlags : Integer : 802.11 capability flags
' Signal : Integer : signal level (dBm)
' Noise : Integer : noise level(dBm)
' LastSeen : Time
Dim ComboSSID '20040429
' If UseSpeech And Not Spoken_BSSIDs.Exists(BSSID) Then 20040511
If UseSpeech Then '20040511
If Not Spoken_BSSIDs.Exists(BSSID) Then '20040511
' TTS.Speak SSID, SVSFlagsAsync
' New_SSIDs.Item(SSID) = 1 ' 20040429b
ComboSSID = SSID ' 20040429
If AddWEP then '20040429b
If ((CapFlags / 16) Mod 2) = 1 Then '20040429b
ComboSSID = SSID & strWEP '20040429b
Else '20040429b
ComboSSID = SSID & strNoWEP '20040429b
End If ' 20040429b
End If '20040429b
New_SSIDs.Item(ComboSSID) = 1 ' 20040429b
Spoken_BSSIDs.Item(BSSID) = LastSeen ' Could check and see if it's been a long time, play again
End If
End If
End Sub
' Called to indicate that NetStumbler has changed its location information
' for a BSSID. The new location may not necessarily be the place where you
' are right now.
' History: New in 0.4.
Sub OnPositionChange(SSID, BSSID, CapFlags, MaxSNR, Lat, Lon, Alt, FixType)
' SSID : String : SSID (Network name)
' BSSID : String : BSSID (MAC address)
' CapFlags : Integer : 802.11 capability flags
' MaxSNR: Integer : highest seen signal-to-noise ratio (dB) that had a position fix associated with it
' Lat : Double : Newly calculated latitude, degrees
' Lon : Double : Newly calculated longitude, degrees
' Alt : Double : Newly calculated altitude (currently not calculated)
' FixType : Integer : Reserved for future use.
' TTS.Speak SSID, SVSFlagsAsync
If Not Initialized Then
' To get here, start with no script, start scan, then enable script
Initialize
IsScanning = True
End If
If UseMappoint Then '20040426
Dim foundBSS, newLocation
Set newLocation = ActiveMap.GetLocation(Lat, Lon, Alt)
If BSSID_Dictionary.Exists(BSSID) Then
Set foundBSS = BSSID_Dictionary.Item(BSSID)
Set foundBSS.Location = newLocation
Else
Set foundBSS = FindOrAddPushpin(newLocation, BSSID, True)
foundBSS.MoveTo (WLANPushpins)
foundBSS.Symbol = SSIDIcon(SSID)
End If
Dim Flags
Flags = ""
If (CapFlags Mod 2) = 1 Then Flags = Flags & "ESS "
If ((CapFlags / 2) Mod 2) = 1 Then Flags = Flags & "IBSS "
If ((CapFlags / 16) Mod 2) = 1 Then Flags = Flags & "WEP "
foundBSS.Note = "SSID: " & SSID & vbCrLf & _
"BSSID: " & BSSID & vbCrLf & _
"CapFlags: " & Flags & " (" & Hex(CapFlags) & ")" & _
"SNR: " & MaxSNR
Set newLocation = Nothing
End If '20040426
End Sub
' Called when a scan cycle has completed (typically right before a new one starts).
Sub OnScanComplete(FoundNew, SeenBefore, LostContact, BestSNR)
' FoundNew : Integer : Count of new BSSIDs
' SeenBefore : Integer : Count of not-new BSSIDs
' LostContact : Integer : Count of BSSIDs missed since last scan
' BestSNR : Integer : SNR of strongest signal (dBm)
'If UseSpeech And (New_SSIDs.Count > 0) Then 20040511
If UseSpeech Then '20040511
If (New_SSIDs.Count > 0) Then '20040511
Dim n, a
n = New_SSIDs.Count
a = New_SSIDs.Keys
For i = 0 To n - 1
TTS.Speak a(i), SVSFlagsAsync
Next
New_SSIDs.RemoveAll
ElseIf UseAudio Then
If FoundNew > 0 Then
PlaySound "ns-aos-new.WAV"
ElseIf LostContact > 0 Then
PlaySound "ns-los.WAV"
ElseIf SeenBefore > 0 Then
If UseSignalStr Then '20040426
' Still seeing some
If BestSNR >= 60 Then
PlaySound "ns-signal-6.WAV"
ElseIf BestSNR >= 50 Then
PlaySound "ns-signal-5.WAV"
ElseIf BestSNR >= 40 Then
PlaySound "ns-signal-4.WAV"
ElseIf BestSNR >= 30 Then
PlaySound "ns-signal-3.WAV"
ElseIf BestSNR >= 20 Then
PlaySound "ns-signal-2.WAV"
ElseIf BestSNR >= 10 Then
PlaySound "ns-signal-1.WAV"
Else
PlaySound "ns-signal-0.WAV"
End If
End If '20040426
Else
' Nothing seen
' PlaySound "ns-tick.WAV"
End If
End If '20040511
End If
End Sub
' Start of by Laidback 030504
Sub UpdateCurrentLocation (thisLat, thisLon)
lastLatTrack = FormatMP(thisLat)
lastLonTrack = FormatMP(thisLon)
On Error Resume Next
Set CL = ActiveMap.GetLocation(FormatMP(thisLat), FormatMP(thisLon))
If Err.Number <> 0 Then Exit Sub
CL.GoTo()
End Sub
Function FormatMP (thisCoord)
FormatMP = FormatNumber(thisCoord, 5)
End Function
' End of by Laidback 030504