Announcement

Collapse
No announcement yet.

Snevl Latitude Version 2 Discussion

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • Viper76Man
    replied
    Dallas Texas. Straight Latitude.

    Leave a comment:


  • stevea
    replied
    Viper,

    Where are you located?

    I can't tell for sure if you are using Google Latitude or Btraced, but it sounds like you are using Latitude. Google does something kind of strange in what they report. The XML that I download has a local time in the Pacific time zone of the US for each observation, I suppose only because that is where their headquarters is. I then have to do some stuff to convert it to the local time for your HS computer. I can't imagine what would make it off by one hour, unless you are in one of those weird time zone exceptions (northern Indiana, I believe is one).

    If you are using Btraced, the story is completely different. I think the phone app reports things in Unix format seconds-since-epoch, and I convert it to what I assumed is simply GMT / universal time.

    Steve

    Leave a comment:


  • Viper76Man
    replied
    Time Zone Issue

    My times in snevl are forward 1 hour. I am using normal Latitude on my phone and my device and Homeseer have the proper times. I have checked all the obvious things (like settings in Google) and all are central time US. If I check my times directly in history on Latitude website they are correct but in the plugin when I check history they are 1 hour ahead. Any ideas? Seems like when it uses the tag to pull from google it is getting the wrong time for some reason.

    Leave a comment:


  • jskibo
    replied
    Steve,

    Thanks. Moving that line from 15 rows down to the top worked. It's reading the data perfect now!

    Leave a comment:


  • stevea
    replied
    That error confirms that the ScriptingReferences line is not being picked up. If you didn't have one there already, you should put a line right after [settings] that says this:

    ScriptingReferences=System.XML;System.XML.dll

    Until that line is seen by Homeseer, you won't get any points imported from the phone.

    Steve

    Leave a comment:


  • jskibo
    replied
    Well this line preceded all that.


    1/3/2013 11:18:14 PM Error Script compile error: Type 'XMLDocument' is not defined.on line 282


    My install didn't have any scripting reference line under settings, had to add one

    Happens only on uploading data points from the phone

    Leave a comment:


  • stevea
    replied
    I think you left out some stuff from the error message, but you don't need to repost. I'd suggest that you probably didn't the ScriptingReferences change as described in the instructions. If it wasn't that, I'll need more info to help you fix this.

    Steve

    Leave a comment:


  • jskibo
    replied
    Got this rather long error on first try starting it up

    Option Strict OffImports System.XMLImports System.TextImports System.Globalizationimports Schedulerimports SystemPublic Module scriptcode1#Region "Automatically generated code, do not modify"'Automatically generated code, do not modify'Event Sources Begin Public WithEvents hs As Scheduler.hsapplication Public WithEvents hsp As scheduler.hsp Public WithEvents hssystem As scheduler.phone0'Event Sources End'End of automatically generated code#End Region'***************************************************** ********************'* SnevlLatitude.vb - By Steve Anderson (stevea, aka Snevl)'*'* Homeseer script to gather data from Google Latitude for a number of'* "badges" (individual cell phones, etc.). Much of this is based on the'* great VBScript posted on the Homeseer board by wpiman.'*'* v0.1 (06/15/2011)'* v0.2 (06/16/2011)'* v0.3 (06/17/2011)'* v0.4 (06/17/2011)'* v0.5 (06/24/2011)'* v1.0 (06/26/2011)'* v1.1 (06/29/2011)'* v1.2 (07/01/2011)'* v1.3 (07/04/2011)'* v1.4 (07/17/2011)'* - Put in more debug for rev-geo parsing'* - If update has better rev-geo data than is in current track history'* use the update (City, Address, Zip)'* - If we fail to retrieve Latitude ATOM from Google, don't check distances'* - Take the uncertaintly radius into account when updating tracks'* v1.5 (07/31/2011)'* - More expanded reverse geocode KML parsing'* - Added test of Max Radius if enabled via config'* - Use Position from rev geo if we get it (more precise)'* - Option of either numeric labels or color gradients for markers'* v1.6 (08/27/2011)'* - User options for the colors of the track location map pins'* - Make some device strings a hyperlink for Google Map'* - Determine number of points to plot on map from user config'* v1.7 (09/11/2011)'* - Add checkbox for debug to save XML files (allows debug mode without'* saving all the XML)'* - Apply tweak to distance device ON/OFF if enabled'* - Don't update devices if we fail to get Latitude data'* v1.8 (11/14/2011)'* - Fix reversed variable initialization in the near tweak algorithm.'* - Allow for option on map type: roadmap, satellite, terrian, or hybrid'* - Create mutli-badge map device if needed; Update multi-badge map when'* any of the included badges moves.'* - Optionally ignore new observations if they imply a crazy speed of travel'* for the badge'* v1.9 (01/21/2012)'* - Turn the "Last Updated" device ON or OFF based on whether we are getting'* updates from Google. (v1.8.1, 12/3/2011)'* - Compact database using JET after pruning old records (1.8.2, 12/3/2011)'* - Fixed logic in near "tweak"; Was counting repeated reports with the same'* update time as a new observation (v1.8.3, 1/18/2011)'* v1.10 (03/31/2012)'* - Added optional 2nd map for each badge'* v2.0 (11/17/2012)'* - Added lots of stuff to handle both Latitude and Btraced'* - Restrict City to 48 characters to avoid exceeding database field length'* - Make sure the Lat/Lon strings are in decimal format'* - Fixed the silent ignore errors logic in both Latitude and Rev Geo'* - Fixed multi-person map, broken by other v2.0 changes'* - Fixed the order of device / map updates (found by Brady Bass)'* - After updating with Btraced data, get the most recent data for updates'* to the map and devices, since Btraced data may not ingest in roder'* v2.1 (12/26/2012)'* - Use US CultureInfo to parse the info from the Btraced XML, to avoid'* error when running in a locale where comma is decimal separator.'* - For fresh install, check to see if db is version 4'* - Don't try to preload badge if there is not history'* - Initialize the badge structure with empty strings to prevent error'* - Use US CultureInfo for formating of Lat and Lon, as Google expectes it'* - Fix the handling of position / reverse geocode data.'* - Correct handling of map zooms, that had been using the same zoom level for'* both maps.'****************************************************** ******************************' Number of consecutive times we will ignore errors from the Google Latitude feed, before we print an errorDim MAX_LATITUDE_XML_ERRORS as Integer = 3' Number of consecutive times we will ignore errors from the Google reverse geocode lookup, before we print an errorDim MAX_REV_GEOCODE_XML_ERRORS as Integer = 3' Default maximum distance a badge can be from a place for it to be 'near'Dim DEF_MAX_NEAR_DIST as Single = 0.1' Device location (room) for devicesDim DEV_LOC as String = "Snevl Latitude"' Flag to indicate if we are to do reverse geocodingDim DoRevGeocoding as Boolean = True' The number of days to keep in the logDim num_days_to_keep as Integer = 1000' The last date we pruned the databaseDim date_of_last_prune as DateTime' Flag for using miles (vs km)Dim use_miles as Boolean = True' Flag indicating a valid return from Google Latitude or BtracedDim got_location as Boolean' filename of saved ATOM fileDim atom_filename as String' Flag indicating if we ignore obs with large radius of uncertaintyDim IgnoreLargeRadius as Boolean' Maximum allowed radius, if IgnoreLargeRadius is TRUEDim MaxRadius as Integer' Flag indicating if we need to re-do the multi-badge mapDim update_multi_map as Boolean' Flag to indicate the current obs is the same time as the previous, so don't count as an updateDim same_time as Boolean' Flag to indicate we are processing Latitude Data (false if we are doing Btraced)Dim processing_latitude as Boolean' The database version required to work with this version of SnevlLatitudeConst db_version as Integer = 4' Constants for working with the databaseConst adOpenDynamic as Integer = 2Const adOpenKeyset as Integer = 1Const adLockOptimistic as Integer = 3Const adCmdTable as Integer = 2Const adCmdText as Integer = 1Const adDate as Integer = 7Const adSchemaTables as Integer = 20' The main badge classClass BadgeClass Public UserID as String ' The Google Latitude ID String Public DevID as String ' The Btraced Device ID Public UseLat as Boolean ' Flag indicating if we use Google Latitude Public UseBT as Boolean ' Flag indicating if we use Btraced Public UserName as String ' Our name for this person (usually first name) Public Position as String ' General location (usually city, state, country) Public Latitude as String ' Location of this badge, latitude Public Longitude as String ' Location of this badget, longitude Public ZipCode as String ' Location ZIP Public Address as String ' Approximate street address Public City as String ' Location Town Public Radius as Integer ' Google reported accuracy radius Public LastUpdate as DateTime Public InMultiMap as Boolean ' Flag for if this badge is included in the Multi-Badge map Public GotLocation as Boolean ' True if we were able to retrieve Latitude data Public Altitude as Integer ' Elevation in meters Public Trip as String ' Trip Name Public Battery as String ' Battery level Public Dev as Devices Public Sub New(ByVal name as String) Me.UserName = name Me.InMultiMap = False Me.Altitude = 0 Me.Trip = "" Me.Battery = "" Me.Position = "" Me.Address = "" Me.City = "" Me.ZipCode = "" Me.Dev = New Devices() Me.Dev.pos = "XX" Me.Dev.lat = "XX" Me.Dev.lon = "XX" Me.Dev.zip = "XX" Me.Dev.city = "XX" Me.Dev.address = "XX" Me.Dev.updated = "XX" Me.Dev.map = "XX" Me.Dev.map2 = "XX" Me.Dev.rad = "XX" Me.Dev.near = "XX" Me.Dev.alt = "XX" Me.Dev.trip = "XX" Me.Dev.battery = "XX" End SubEnd ClassClass Devices ' Device codes for a particular badge Public pos as String Public lat as String Public lon as String Public zip as String Public city as String Public address as String Public updated as String Public map as String Public map2 as String Public rad as String Public near as String Public alt as String Public trip as String Public battery as StringEnd Class' The class describing each place we want to compare positions tooClass PlaceClass Public Name as String ' The short name for this place Public Lat as String ' The latitude of this place Public Lon as String ' The longitude of this place Public MaxNear as Single ' The maximum 'near' distance for this placeEnd ClassDim debug as BooleanDim debug_xml as BooleanDim new_rev_geo as BooleanDim places(1) as PlaceClassDim badges(1) as BadgeClassDim num_badges as IntegerDim num_places as IntegerDim oConn as ObjectDim oRs as ObjectDim log_new as Boolean' For checking run timesDim start_dt as DateTimeDim end_dt as DateTimeDim delta_time as TimeSpan'*************************************************** ***********************' Main() - Main entry point for the script, for Latitude Data'******************************************************* *******************Sub Main(ByVal Params as Object) ' start_dt = DateTime.Now If Not init() Then Exit Sub End If If num_badges = 0 Then hs.WriteLog("Error","SnevlLatitude: No people/badges defined!") oConn.Close() Exit Sub End If processing_latitude = True update_multi_map = False For i as Integer = 0 To num_badges - 1 If badges(i).UseLat Then log_new = False got_location = GetLatitude(badges(i)) If got_location Then badges(i).GotLocation = True new_rev_geo = False update_track(badges(i)) Else End If update_devs(badges(i)) End If Next If update_multi_map Then debug_print("update_mult_map is TRUE, so calling make_multi_map") make_multi_map() End If oConn.Close() For i as Integer = 0 To num_badges - 1 badges(i) = Nothing Next For i as Integer = 0 To num_places - 1 places(i) = Nothing Next places = Nothing badges = Nothing ' end_dt = DateTime.Now ' delta_time = end_dt.Subtract(start_dt) ' hs.WriteLog("SnevlLatitude","Run time = " & delta_Time.TotalMilliseconds.ToString("F2") & " mSec")End Sub'******************************************************** ******************' BTMain() - Main entry point for Btraced data. '*********************************************************** ***************Sub BTMain(ByVal dummy as String) Dim b as BadgeClass Dim xml as String = hs.GetIniSetting("Btraced","File2Process","","SnevlLatitude. ini") debug_print("BTMain(), going to load: '" & xml & "'") If Not System.IO.File.Exists(xml) Then hs.writelog("Error","SnevlLatitude: Btraced thread triggered, but no file to process.") Exit Sub End If Dim xDoc as XMLDocument = New XMLDocument() processing_latitude = False update_multi_map = False Dim devID as String Dim point as String Try xDoc.Load(xml) If debug AndAlso debug_xml Then Dim debug_btraced_file as String = hs.GetAppPath() & "\Logs\SnevlLatitude_Btraced_" & DateTime.Now.ToString("yyyyMMdd_HHmm") & ".XML" If Not System.IO.Directory.Exists(hs.GetAppPath() & "\Logs") Then System.IO.Directory.CreateDirectory(hs.GetAppPath() & "\Logs") End If xDoc.Save(debug_btraced_file) End If Catch ex as Exception hs.WriteLog("Error","SnevlLatitude: Error loading Btraced XML file '" & xml & "'") hs.WriteLog("Error",ex.Message) End Try Try devID = xDoc.selectSingleNode("//bwiredtravel/devId").InnerText If Not init_btraced(b,devID) Then Exit Sub End If If b.UseBT = False Then Exit Sub End If b.Trip = xDoc.selectSingleNode("//bwiredtravel/travel/description").InnerText Catch ex as Exception hs.WriteLog("Error","SnevlLatitude: Error reading devID or Trip from Btraced XML file") hs.WriteLog("Error",ex.ToString) End Try new_rev_geo = False For Each xNode as XMLNode In xDoc.documentElement.selectNodes("travel/point") Try point = xNode.selectSingleNode("id").InnerText log_new = False b.Latitude = xNode.selectSingleNode("lat").InnerText b.Longitude = xNode.selectSingleNode("lon").InnerText b.Altitude = single.parse(xNode.selectSingleNode("altitude").InnerText,Sy stem.Globalization.CultureInfo.CreateSpecificCulture("en-US")) Catch ex as Exception hs.WriteLog("Error","SnevlLatitude: Failure reading point, Altitude, Latitude, or Longitude from Btraced XML") hs.WriteLog("Error",ex.ToString) End Try b.LastUpdate = linux_epoch_time(xNode.selectSingleNode("date").InnerText) Try Dim fRad as Single b.Battery = xNode.selectSingleNode("bat").InnerText fRad = single.parse(xNode.selectSingleNode("haccu").InnerText,Syste m.Globalization.CultureInfo.CreateSpecificCulture("en-US")) b.Radius = Convert.ToInt32(fRad) Catch ex as Exception hs.WriteLog("Error","SnevlLatitude: Failure reading Battery or Radius from Btraced XML") hs.WriteLog("Error",ex.ToString) End Try b.GotLocation = True got_location = True b.City = "" fix_latlon(b) debug_print("BTMain(), point='" & point & ", lat='" & b.Latitude & "', lon='" & b.Longitude & "'") update_track(b) Next ' The Btraced data may not have been in time order; To update devices and maps, get the last point from ' the track history database. get_last_point(b) make_map(b,1) make_map(b,2) update_devs(b) ' update_devs(b) 'TRY MOVING ABOVE System.IO.File.Delete(xml) If update_multi_map Then debug_print("update_mult_map is TRUE, so calling make_multi_map") make_multi_map() End If oConn.Close() oConn = Nothing For i as Integer = 0 To num_places - 1 places(i) = Nothing Next places = Nothing b = NothingEnd Sub'******************************************************** ******************' linux_epoch_time() - Converts the string seconds-since-epoch arg to ' DateTime'*************************************************** ***********************Function linux_epoch_time(ByVal secs As String) As DateTime Dim epoch as DateTime = New DateTime(1970,1,1,0,0,0) Try Dim epoch_secs as Double = Double.Parse(secs,System.Globalization.CultureInfo.CreateSpe cificCulture("en-US")) debug_print("linux_epoch_time(), converting '" & secs & "' to " & epoch_secs.ToString("F4")) Return(epoch.AddSeconds(epoch_secs)) Catch ex as Exception hs.WriteLog("Error","SnevlLatitude: Failure in linux_epoch_time() converting time from Btraced XML") hs.WriteLog("Error",ex.ToString) return(epoch) End TryEnd Function'*************************************************** ***********************' open_db() - Establish a connection to the database '*********************************************************** ***************Sub open_db() Dim strDatabase as String = hs.GetAppPath() & "\data\SnevlLatitude\SnevlLatitude.mdb" Dim DSN as String = "Provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info=False;Data Source='" & strDatabase & "'" oConn = CreateObject("ADODB.Connection") oConn.Open(DSN)End Sub'******************************************************** ******************' init_btraced() - Like init(), but just for Btraced instance Since there is' only one badge to pay attention to, we don't need to initalize the ' whole array of known people / badges.'**************************************************** **********************Function init_btraced(ByRef b as BadgeClass,ByVal devID as String) as Boolean Dim ver as Integer Dim found_devid as Boolean init_globals() ver = Int32.Parse(hs.GetIniSetting("Version","DatabaseVersion","0" ,"SnevlLatitude.ini")) open_db() If ver db_version Then hs.writelog("SnevlLatitude","Looks like DB version " & ver.ToString & ", requires upgrade to version " & db_version.ToString) upgrade_database(ver) End If b = New BadgeClass("dummy") ' placeholder name ' Find the devID Dim Rs2 as Object = oConn.Execute("Select * FROM Btraced WHERE devID='" & devID & "'") If Not Rs2.EOF Then b.DevID = Rs2("devID").Value b.Dev.alt = Rs2("DevAltitude").Value b.Dev.trip = Rs2("DevTrip").Value b.Dev.battery = Rs2("DevBattery").Value b.UseBT = Rs2("UseBtraced").Value Else Return(False) End If oRs = oConn.Execute("SELECT * FROM badges WHERE Name='" & Rs2("Name").value & "'") If Not oRs.EOF b.UserName = oRs("Name").value b.UseLat = oRs("UseLatitude").Value b.Dev.pos = oRs("DevPosition").Value b.Dev.lat = oRs("DevLat").Value b.Dev.lon = oRs("DevLon").Value b.Dev.city = oRs("DevCity").Value b.Dev.zip = oRs("DevZip").Value b.Dev.address = oRs("DevAddr").Value b.Dev.updated = oRs("DevUpdated").Value b.Dev.map = oRs("DevMap").Value b.Dev.map2 = oRs("DevMap2").Value b.Dev.rad = oRs("DevRadius").Value b.Dev.near = oRs("DevNear").Value Dim user_tag as String = oRs("Name").value & "_" & oRs("UniqueID").value.ToString b.InMultiMap = Boolean.Parse(hs.GetIniSetting("MultiMap","Badge_" &user_tag & _ "_Included","False","SnevlLatitude.ini")) b.GotLocation = False Else Return(False) End If Return(init_places())End Function'*************************************************** ***********************' init() - Initialize internal varables from INI file and database '*********************************************************** ***************Function init() as Boolean ' Stuff for doing database pulls Dim oCmd as Object = CreateObject("ADODB.Command") Dim strQry as String Dim ver as Integer ' Other variables used Dim i as Integer init_globals() ver = Int32.Parse(hs.GetIniSetting("Version","DatabaseVersion","1" ,"SnevlLatitude.ini")) open_db() ' If we need to upgrade the database schema, do so now If ver db_version Then hs.writelog("SnevlLatitude","Looks like DB version " & ver.ToString & ", requires upgrade to version " & db_version.ToString) upgrade_database(ver) End If Try Dim FieldCount as Integer Dim ret as Boolean = True strQry = "SELECT * FROM Badges" oRs = oConn.Execute(strQry) FieldCount = oRs.fields.count If FieldCount date_of_last_prune Then prune_database() End If Try ' Get all of our known badges out of the database strQry = "SELECT COUNT(*) AS rowcount From Badges" oCmd.CommandText = strQry oCmd.CommandType = 1 oCmd.ActiveConnection = oConn oRs = oCmd.Execute num_badges = oRs("rowcount").value 'debug_print("Badges database has " & num_badges.ToString & " rows") If num_badges 0 Then ReDim badges(num_badges-1) oRs = oConn.Execute("SELECT * FROM badges") i = 0 Do While Not oRs.EOF badges(i) = New BadgeClass(oRs("Name").Value) badges(i).UseLat = oRs("UseLatitude").Value badges(i).UserID = oRs("UserID").Value badges(i).Dev.pos = oRs("DevPosition").Value badges(i).Dev.lat = oRs("DevLat").Value badges(i).Dev.lon = oRs("DevLon").Value badges(i).Dev.city = oRs("DevCity").Value badges(i).Dev.zip = oRs("DevZip").Value badges(i).Dev.address = oRs("DevAddr").Value badges(i).Dev.updated = oRs("DevUpdated").Value badges(i).Dev.map = oRs("DevMap").Value badges(i).Dev.map2 = oRs("DevMap2").Value badges(i).Dev.rad = oRs("DevRadius").Value badges(i).Dev.near = oRs("DevNear").Value Dim user_tag as String = oRs("Name").value & "_" & oRs("UniqueID").value.ToString badges(i).InMultiMap = Boolean.Parse(hs.GetIniSetting("MultiMap","Badge_" &user_tag & _ "_Included","False","SnevlLatitude.ini")) badges(i).GotLocation = False 'hs.writelog("debug","For badge " & i.ToString & ", got stuff from Badges.") Dim Rs2 as Object = oConn.Execute("Select * FROM Btraced WHERE Name='" & oRs("Name").Value & "'") If Not Rs2.EOF Then badges(i).DevID = Rs2("devID").Value badges(i).Dev.alt = Rs2("DevAltitude").Value badges(i).Dev.trip = Rs2("DevTrip").Value badges(i).Dev.battery = Rs2("DevBattery").Value badges(i).UseBT = Rs2("UseBtraced").Value Else badges(i).Dev.alt = "XX" badges(i).Dev.trip = "XX" badges(i).Dev.battery = "XX" End If i += 1 oRs.MoveNext Loop End If Catch ex as Exception hs.writelog("Error","SnevlLatitude - Error while reading badge database in init():" & ex.Message) oConn.Close() Return(False) End Try Return(init_places())End Function'*************************************************** ***********************' init_globals() - Initialize the global variables'************************************************** ************************Sub init_globals() MAX_LATITUDE_XML_ERRORS = Int32.Parse(hs.GetIniSetting("Errors","MAX_LATITUDE_XML_ERRO RS","0","SnevlLatitude.ini")) MAX_REV_GEOCODE_XML_ERRORS = Int32.Parse(hs.GetIniSetting("Errors","MAX_REV_GEOCODE_XML_E RRORS","0","SnevlLatitude.ini")) DEF_MAX_NEAR_DIST = parse_single(hs.GetIniSetting("Tuning","MaxNearDistance","0. 8","SnevlLatitude.ini")) DEV_LOC = hs.GetIniSetting("Tuning","LocationForDevices","Snevl Latitude","SnevlLatitude.ini") DoRevGeocoding = Boolean.Parse(hs.GetIniSetting("Tuning","DoRevGeoCode","True ","SnevlLatitude.ini")) debug = Boolean.Parse(hs.GetIniSetting("Debug","DebugMode","False"," SnevlLatitude.ini")) debug_xml = Boolean.Parse(hs.GetIniSetting("Debug","DebugXML","False","S nevlLatitude.ini")) num_days_to_keep = Int32.Parse(hs.GetIniSetting("PruneDB","NumberOfDaysToKeep", "1000","SnevlLatitude.ini")) date_of_last_prune = DateTime.Parse(hs.GetIniSetting("PruneDB","DateOfLastPrune", DateTime.Now.AddDays(-10).ToString("d"),"SnevlLatitude.ini")) use_miles = Boolean.Parse(hs.GetIniSetting("Tuning","UseMiles","True","S nevlLatitude.ini")) IgnoreLargeRadius = Boolean.Parse(hs.GetIniSetting("Tuning","IgnoreLargeRadius", "False","SnevlLatitude.ini")) MaxRadius = Int32.Parse(hs.GetIniSetting("Tuning","MaxRadius","1500","Sn evlLatitude.ini"))End Sub'******************************************************** ******************' init_places() - Initialize the array of known places'***************************************************** *********************Function init_places() As Boolean Dim oCmd as Object = CreateObject("ADODB.Command") Dim strQry as String Dim i as Integer Try ' Get all of our known places out of the database strQry = "SELECT COUNT(*) AS rowcount From Places" oCmd.CommandText = strQry oCmd.CommandType = 1 oCmd.ActiveConnection = oConn oRs = oCmd.Execute num_places = oRs("rowcount").value 'debug_print("Places database has " & num_places.ToString & " rows") If num_places 0 Then ReDim places(num_places-1) oRs = oConn.Execute("SELECT * FROM Places") i = 0 Do While Not oRs.EOF places(i) = New PlaceClass() places(i).Name = oRs("Name").Value places(i).Lat = oRs("Latitude").Value places(i).Lon = oRs("Longitude").Value places(i).MaxNear = oRs("MaxNear").Value i += 1 oRs.MoveNext Loop End If Catch ex as Exception hs.writelog("Error","SnevlLatitude - Error while reading place database in init():" & ex.Message) oConn.Close() Return(False) End Try Return(True)End Function'*************************************************** ***********************' parse_single() - Parse a string into a single precision floating point,' no matter what locale decimal separator is used.'****************************************************** ********************Function parse_single(ByVal s as String) As Single Dim x as Single Dim cultures() As CultureInfo = {New CultureInfo("en-US"),New CultureInfo("fr-FR")} If Single.TryParse(s,NumberStyles.Float,cultures(0),x) Then return(x) ElseIf Single.TryParse(s,NumberStyles.Float,cultures(1),x) Then return(x) Else hs.writelog("Error","SnevlLatitude: Could not parse " & s & " into a floating point number.") return(1.0) End IfEnd Function'*************************************************** ***********************' GetLatitude() - Attempts to read latitude data for a particular badge '*********************************************************** ***************Function GetLatitude(ByRef b as BadgeClass) as Boolean Dim xml_saved as Boolean = False Dim xDoc as XMLDocument = New XMLDocument() Dim xNode, eNode as XMLNode Dim xNodeList as XMLNodeList Dim ns As XmlNamespaceManager = new XmlNamespaceManager(xDoc.NameTable) ns.AddNamespace("georss", "http://www.georss.org/georss") Dim doc as String = "http://www.google.com/latitude/apps/badge/api?user=" & b.UserID & "&type=atom" Try xDoc.Load(doc) Catch ex As Exception Dim err_count as Integer = Int32.Parse(hs.GetIniSetting("Errors","XMLFetchErrorCnt","0" ,"SnevlLatitude.ini")) debug_print("Error reading Google Latitude, error count = " & err_count.ToString & ", msg = " & ex.ToString()) debug_print("Was attempting to load '" & doc & "'") err_count += 1 If err_count MAX_LATITUDE_XML_ERRORS Then hs.WriteLog("Error","SnevlLatitude failed to retrieve XML from Google " & err_count.ToString & " consecutive times.") err_count = 0 End If hs.SaveIniSetting("Errors","XMLFetchErrorCnt",err_count.ToSt ring,"SnevlLatitude.ini") return False End Try hs.SaveIniSetting("Errors","XMLFetchErrorCnt","0","SnevlLati tude.ini") If debug AndAlso debug_xml Then If Not System.IO.Directory.Exists(hs.GetAppPath() & "\Logs") Then System.IO.Directory.CreateDirectory(hs.GetAppPath() & "\Logs") End If atom_filename = hs.GetAppPath() & "\Logs\SnevlLatitude_Atom_" & b.UserName & "_" & DateTime.Now.ToString("yyyyMMdd_HHmm") & ".XML" xDoc.Save(atom_filename) End If xNodeList = xDoc.GetElementsByTagName("entry") xNode = xNodeList(0) If xNode Is Nothing Then Dim msg as String = "No Google Latitude data found for user '" & b.UserName & "', UserID '" & b.UserID & "'" hs.writelog("Warning",msg) debug_print(msg) Return False End If eNode = xNode.SelectSingleNode("georssoint",ns) If eNode Is Nothing Then hs.WriteLog("Error","SnevlLatitude - Could not find 'point' from Google Latitude for " & b.UserName) Return False Else Dim coords() as String = eNode.InnerText.Split(" "c) b.Latitude = coords(0) b.Longitude = coords(1) fix_latlon(b) End If eNode = xNode.SelectSingleNode("georss:radius",ns) If eNode Is Nothing Then hs.WriteLog("Error","SnevlLatitude - Could not find 'radius' from Google Latitude for " & b.UserName) Return False Else b.Radius = Int32.Parse(eNode.InnerText) If IgnoreLargeRadius And b.Radius MaxRadius Then debug_print("GetLatitude(): Badge " & b.UserName & ", Obs radius (" & b.Radius.ToString _ & ") is larger than Max Radius (" & MaxRadius.ToString & "). Ignore this obs.") If System.IO.File.Exists(atom_filename) Then debug_print("Deleting ignored ATOM file: " & atom_filename) System.IO.File.Delete(atom_filename) End If Return False End If End If eNode = xNode.SelectSingleNode("georss:featurename",ns) If eNode Is Nothing Then hs.WriteLog("Error","SnevlLatitude - Could not find 'featurename' from Google Latitude for " & b.UserName) Return False Else b.Position = eNode.InnerText 'hs.writelog("debug","Position = " & b.Position) End If b.LastUpdate = fix_time(xNode("updated").InnerText) Return TrueEnd Function'*************************************************** ***********************' get_last_point() - Fill the BadgeClass structure with the last observation'************************************************ **************************Sub get_last_point(ByRef b as BadgeClass) oRs = CreateObject("ADODB.Recordset") oRs = oConn.Execute("SELECT * FROM LocationHistory WHERE Name='" & b.UserName & "' ORDER BY LastDateTime DESC") If oRs.EOF Then Exit Sub End If b.Latitude = oRs("Latitude").value b.Longitude = oRs("Longitude").value b.LastUpdate = oRs("LastDateTime").value b.Position = oRs("Position").value b.Radius = oRs("MinRadius").value b.Address = oRs("Address").value b.City = oRs("City").value b.ZipCode = oRs("Zip").valueEnd Sub'******************************************************** ******************' fix_latlon() - Make sure the Latitude and Longitude are fixed decimal'**************************************************** **********************Sub fix_latlon(ByRef b as BadgeClass) Dim sLat as Single = single.parse(b.Latitude,System.Globalization.CultureInfo.Cre ateSpecificCulture("en-US")) Dim sLon as Single = single.parse(b.Longitude,System.Globalization.CultureInfo.Cr eateSpecificCulture("en-US")) b.Latitude = sLat.ToString("F6",System.Globalization.CultureInfo.CreateSp ecificCulture("en-US")) b.Longitude = sLon.ToString("F6",System.Globalization.CultureInfo.CreateSp ecificCulture("en-US"))End Sub'******************************************************** **********************************************'* update_track() - Compare the new observation to the most recent previous observation of this '* badge. If it has moved enough, lookup the address (reverse geocode), log it into the track'* history, and generate a map. If it hasn't moved that far, only update the most recent entry'* in the track history.'*************************************************** ***************************************************Sub update_track(ByRef b as BadgeClass) ' Stuff for doing database pulls Dim oCmd as Object = CreateObject("ADODB.Command") Dim strQry as String Dim distance as Single Dim r1 as Single ' Radius of new observation Dim r2 as Single = 0 ' Radius of previous observation Dim MIN_DIST_TO_REGISTER as Single If processing_latitude Then MIN_DIST_TO_REGISTER = parse_single(hs.GetIniSetting("Tuning","MinDistanceForNewObs ","1","SnevlLatitude.ini")) Else MIN_DIST_TO_REGISTER = parse_single(hs.GetIniSetting("Tuning","BTMinDistanceForNewO bs","1","SnevlLatitude.ini")) End If Dim min_dist as Single = MIN_DIST_TO_REGISTER same_time = False log_new = False r1 = meters_to_dist(b.Radius) ' Look up the most recent observation on this badge (UserID) Try oRs = CreateObject("ADODB.Recordset") strQry = "SELECT * FROM LocationHistory WHERE Name='" & b.UserName & "' ORDER BY LastDateTime DESC" oRs.Open(strQry, oConn, adOpenDynamic, adLockOptimistic, adCmdText) If oRs.EOF Then log_new = True Else Dim IgnoreCrazySpeed as Boolean = Boolean.Parse(hs.GetIniSetting("Tuning","IgnoreCrazySpeed"," False","SnevlLatitude.ini")) distance = dist(b.Latitude,b.Longitude,oRs("Latitude").value,oRs("Longi tude").value) ' Are we ignoring unreasonable speed of movement? If IgnoreCrazySpeed AndAlso b.LastUpdate oRs("LastDateTime").value Then Dim max_speed as Single = Single.Parse(hs.GetIniSetting("Tuning","MaxSpeed","900.0","S nevlLatitude.ini")) Dim my_speed as Single Dim ts as Timespan Dim sTime as DateTime = oRs("LastDateTime").value Dim eTime as DateTime = b.LastUpdate ts = eTime - sTime my_speed = distance / (ts.TotalHours) If my_speed max_speed Then debug_print("For badge " & b.UserName & ", speed of " & my_speed.ToString("F2") & " would exceed max speed of " _ & max_speed.ToString("F2") & ", so ignoring point.") Exit Sub End If End If r2 = meters_to_dist(oRs("MinRadius").value) If r2 MIN_DIST_TO_REGISTER Then min_dist = r2 End If ' Consider the observation a new location if the new point is sufficiently far from the old point, and ' if the radius of accuracy doesn't encompass the old point. If distance min_dist And r1 oRs("LastDateTime").value Then ' New observation, but considered same location: Update the existing log entry oRs.Fields("NumObs") = oRs("NumObs").value + 1 oRs.Fields("LastDateTime") = b.LastUpdate If oRs("MinRadius").value b.Radius Then oRs.Fields("MinRadius") = b.Radius If b.Latitude oRs("Latitude").value AndAlso b.Longitude oRs("Longitude").value Then debug_print("update_track(): Logging obs an improved accuracy obs of the previous obs") ' Since the new location is more accurate than the old one, use this location for the address oRs.Fields("Latitude") = b.Latitude oRs.Fields("Longitude") = b.Longitude reverse_geocode(b) oRs.Fields("Position") = b.Position If b.City "" Then oRs.Fields("City") = b.City ElseIf Not IsDBNull(oRs("City").value) Then b.City = oRs("City").value End If If b.Address "" Then oRs.Fields("Address") = b.Address ElseIf Not IsDBNull(oRs("Address").value) Then b.Address = oRs("Address").value End If If b.ZipCode "" Then oRs.Fields("Zip") = b.ZipCode ElseIf Not IsDBNull(oRs("Zip").value) Then b.ZipCode = oRs("Zip").value End If End If Else debug_print("update_track(): Logging obs as only an additional obs at previous location") End If If oRs("MaxRadius").value "XX" And hs.DeviceExistsRef(dev) -1 Then Select Case dev_label(i) Case "Position" If log_new Or new_rev_geo Then Dim sb as New StringBuilder sb.Append("") sb.Append(b.Position) sb.Append("") hs.SetDeviceString(dev,sb.ToString,True) End If Case "Map" Dim map_image as String = hs.GetIniSetting("MapImage",b.UserName,"","SnevlLatitude.ini ") hs.SetDeviceString(dev,"",True) Case "Map2" Dim map_image as String = hs.GetIniSetting("MapImage",b.UserName & "_2","","SnevlLatitude.ini") If map_image = "" Then make_map(b,2) map_image = hs.GetIniSetting("MapImage",b.UserName & "_2","","SnevlLatitude.ini") End If hs.SetDeviceString(dev,"",True) Case "Updated" If b.GotLocation Then hs.SetDeviceString(dev,b.LastUpdate.ToString("g"),True) Dim ts as TimeSpan = DateTime.Now.Subtract(b.LastUpdate) Dim iMaxUpdateDelta as Integer = Int32.Parse(hs.GetIniSetting("Tuning","MaxUpdateDelta","30", "SnevlLatitude.ini")) Dim UpdateDelta as Integer = Convert.ToInt32(ts.TotalMinutes) If UpdateDelta ") sb.Append(b.Latitude) sb.Append("") hs.SetDeviceString(dev,sb.ToString,True) Case "Longitude" Dim sb as New StringBuilder sb.Append("") sb.Append(b.Longitude) sb.Append("") hs.SetDeviceString(dev,sb.ToString,True) Case "ZIP" If new_rev_geo Then hs.SetDeviceString(dev,b.ZipCode,True) Case "City" If new_rev_geo Then hs.SetDeviceString(dev,b.City,True) Case "Street" If new_rev_geo Then Dim sb as New StringBuilder sb.Append("") sb.Append(b.Address) sb.Append("") hs.SetDeviceString(dev,sb.ToString,True) End If Case "Radius" hs.SetDeviceString(dev,b.Radius,True) hs.SetDeviceValue(dev,Int32.Parse(b.Radius)) Case "Altitude" hs.SetDeviceString(dev,b.Altitude.ToString(),True) Case "Trip" hs.SetDeviceString(dev,b.Trip,True) Case "Battery" hs.SetDeviceString(dev,b.Battery,True) End Select End If i += 1 Next If num_places = 0 Or (Not got_location) Then Exit Sub If same_time Then debug_print("For " & b.UserName & ", update time is the same as prev, so we do not update NEAR") Exit Sub End If For Each place as PlaceClass In places Dim strQry as String Dim distance as Single = dist(b.Latitude,b.Longitude,place.Lat,place.Lon) If distance "" Then near_str &= "," & place.Name Else near_str = place.Name End If End If Try strQry = "SELECT * FROM UserToPlaceDistances WHERE (UserName='" & b.UserName & "' AND PlaceName='" & place.Name.Replace("'","''") & "')" oRs = oConn.Execute(strQry) Do While Not oRs.EOF Dim dev as String = oRs("DeviceCode").value If dev.ToLower "xx" AndAlso hs.DeviceExistsRef(dev) -1 Then Dim near_item as String = b.UserName & "_" & place.Name.Replace("'","''") Dim num_misses as Integer = Int32.Parse(hs.GetIniSetting("NotNearCounts",near_item,"0"," SnevlLatitude.ini")) Dim sDist as Integer = distance * 10 If Not hs.IsOn(dev) And Not hs.IsOff(dev) Then ' Neither ON nor OFF hs.ExecX10(dev,"OFF") End IF If distance "xx" AndAlso hs.DeviceExistsRef(b.Dev.near) -1 Then hs.SetDeviceString(b.Dev.near,near_str,True) End IfEnd Sub'******************************************************** **********************************************'* make_devs() - Loop through all the device codes for this badge. For any that are not "XX" and '* don't yet exist, create them'******************************************************* ***********************************************Sub make_devs(ByVal b as BadgeClass) Dim dv as Scheduler.Classes.DeviceClass Dim dev_list() As String = {b.Dev.pos, b.Dev.lat, b.Dev.lon, b.Dev.zip, b.Dev.city, b.Dev.address, _ b.Dev.updated,b.Dev.map, b.Dev.map2, b.Dev.rad, b.Dev.near, b.Dev.alt, b.Dev.trip, b.Dev.battery} Dim dev_label() as String = {"Position","Latitude","Longitude","ZIP Code","City","Street Address", _ "Last Updated","Track Map","Track Map 2","Location Accuracy Radius","Near Places", _ "Altitude","Trip","Battery" } Dim strQry as String Dim i as Integer = 0 For Each dev as String In dev_list Dim label as String = b.UserName & " " & dev_label(i) If dev.ToUpper "XX" Then Dim dRef as Integer = hs.DeviceExistsRef(dev) If dRef -1 Then dv = hs.GetDeviceByRef(dRef) If dv.Location DEV_LOC Then debug_print("Can't create '" & label & "' device '" & dev & "' because it exists already.") debug_print("Device was found in location group '" & dv.location & "'") hs.WriteLog("Warning","SnevlLatitude Can't create '" & label & "' device '" & dev & "' because it exists already.") End If Else dv = hs.NewDeviceEx(label) dv.location = DEV_LOC dv.hc = dev.SubString(0,1).ToUpper dv.dc = dev.SubString(1) dv.dev_type_string = "Status Only" dv.misc = &h10 End If End If i += 1 Next If num_places = 0 Then Exit Sub For Each place as PlaceClass In places strQry = "SELECT * FROM UserToPlaceDistances WHERE (UserName='" & b.UserName & "' AND PlaceName='" & place.Name.Replace("'","''") & "')" oRs = oConn.Execute(strQry) Do While Not oRs.EOF Dim dev as String = oRs("DeviceCode").Value Dim label as String = b.UserName & " from " & place.Name & " Distance" If dev.ToUpper "XX" Then Dim dRef as Integer = hs.DeviceExistsRef(dev) If dRef -1 Then dv = hs.GetDeviceByRef(dRef) If dv.Location DEV_LOC Then debug_print("Can't create '" & label & "' device '" & dev & "' because it exists already.") debug_print("Device was found in location group '" & dv.location & "'") hs.WriteLog("Warning","SnevlLatitude Can't create '" & label & "' device '" & dev & "' because it exists already.") End If Else dv = hs.NewDeviceEx(label) dv.location = DEV_LOC dv.hc = dev.SubString(0,1).ToUpper dv.dc = dev.SubString(1) dv.dev_type_string = "Status Only" dv.misc = &h10 hs.SaveEventsDevices() hs.SetDeviceStatus(dev,3) End If End If oRs.MoveNext Loop Next Dim multimapdev as String = hs.GetIniSetting("MultiMap","MapDevice","XX","SnevlLatitude. ini") If multimapdev.ToUpper "XX" Then Dim label as String = "Multibadge Map" Dim dRef as Integer = hs.DeviceExistsRef(multimapdev) If dRef -1 Then dv = hs.GetDeviceByRef(dRef) If dv.Location DEV_LOC Then debug_print("Can't create '" & label & "' device '" & multimapdev & "' because it exists already.") debug_print("Device was found in location group '" & dv.location & "'") hs.WriteLog("Warning","SnevlLatitude Can't create '" & label & "' device '" & multimapdev & "' because it exists already.") End If Else dv = hs.NewDeviceEx(label) dv.location = DEV_LOC dv.hc = multimapdev.SubString(0,1).ToUpper dv.dc = multimapdev.SubString(1) dv.dev_type_string = "Status Only" dv.misc = &h10 hs.SaveEventsDevices() hs.SetDeviceString(multimapdev,"",True) End If End IfEnd Sub'******************************************************** **********************************************'* reverse_geocode() - Take the observed Lat/Lon and convert it to a street / city location'*************************************************** ***************************************************Sub reverse_geocode(ByRef b as BadgeClass) Dim xDoc as XMLDocument = New XMLDocument() Dim xNode as XMLNode Dim xNodeList as XMLNodeList Dim temp_addr as String = "" xDoc = New XMLDocument() Dim doc As String = "http://maps.google.com/maps/geo?q=" & b.latitude & "," & b.longitude & "&output=kml" Try xDoc.Load(doc) Catch ex As Exception Dim err_count as Integer = Int32.Parse(hs.GetIniSetting("Errors","RevGeocodeErrorCnt"," 0","SnevlLatitude.ini")) debug_print("Error reading Google Reverse geocode, error count = " & err_count.ToString & ", msg = " & ex.ToString()) debug_print("Was attempting to load '" & doc & "'") err_count += 1 If err_count MAX_REV_GEOCODE_XML_ERRORS Then hs.WriteLog("Error","SnevlLatitude failed to obtain Reverse Geocode from Google " & err_count.ToString & " consecutive times.") err_count = 0 End If hs.SaveIniSetting("Errors","RevGeocodeErrorCnt",err_count.To String,"SnevlLatitude.ini") Exit Sub End Try hs.SaveIniSetting("Errors","RevGeocodeErrorCnt","0","SnevlLa titude.ini") If debug AndAlso debug_xml Then If Not System.IO.Directory.Exists(hs.GetAppPath() & "\Logs") Then System.IO.Directory.CreateDirectory(hs.GetAppPath() & "\Logs") End If Dim debug_xml as String = "SnevlLatitude_RevGeo_" & b.UserName & "_" & DateTime.Now.ToString("yyyyMMdd_HHmmss") & ".XML" xDoc.Save(hs.GetAppPath() & "\Logs\" & debug_xml) debug_print("Parsing rev-geo XML that is in file: " & debug_xml) End If new_rev_geo = True Try xNode = xDoc.GetElementsByTagName("address")(0) If Not (xNode Is Nothing) Then b.Position = Left(xNode.InnerText,99) debug_print("RevGeo: using RevGeo for Position: " & b.Position) End If xNode = xDoc.GetElementsByTagName("Thoroughfare")(0) If Not (xNode Is Nothing) Then b.address = xNode.ChildNodes(0).InnerText debug_print("Top level thoroughfare = '" & b.address & "'") Else xNode = xDoc.GetElementsByTagName("AddressLine")(0) If Not (xNode Is Nothing) Then b.Address = xNode.InnerText debug_print("Top level thoroughfare (from addressline) = '" & b.address & "'") End If End If xNode = xDoc.GetElementsByTagName("PostalCode")(0) If Not (xNode Is Nothing) Then b.ZipCode = xNode.ChildNodes(0).InnerText debug_print("Top level postal code = '" & b.ZipCode & "'") End If Catch ex as Exception hs.writelog("SnevlLatitude","Error extracting reverse geocode data (block 1) - " & ex.message) debug_print("Error extracting reverse geocode data (block 1) - " & ex.message) End Try xNode = xDoc.GetElementsByTagName("AddressDetails")(0) If xNode Is Nothing Then hs.writelog("SnevlLatidue","Error - No AddressDetails in reverse_geocode()!") Exit Sub End If For Each cNode as XMLNode In xNode.ChildNodes Try If cNode.Name.ToLower = "addressline" Then temp_addr = cNode.InnerText ElseIf cNode.Name.ToLower = "country" Then For Each aNode as XMLNode In cNode.ChildNodes If aNode.Name.ToLower = "administrativearea" Then debug_print("AdministrativeArea-") For Each lNode as XMLNode In aNode.ChildNodes If lNode.Name.ToLower = "locality" Then debug_print("AdministrativeArea-Locality") For Each eNode as XMLNode In lNode.ChildNodes If eNode.Name.ToLower = "localityname" AndAlso b.City eNode.InnerText Then If b.City "" Then b.City = eNode.InnerText & ", " & b.City Else b.City = eNode.InnerText End If debug_print("AdministrativeArea-Locality-LocalityName (City):" & b.City) End If Next ElseIf lNode.Name.ToLower = "dependentlocality" Then debug_print("AdministrativeArea-DependentLocality") For Each eNode as XMLNode In lNode.ChildNodes If eNode.Name.ToLower = "dependentlocalityname" AndAlso b.City eNode.InnerText Then If b.City "" Then b.City = eNode.InnerText & ", " & b.City Else b.City = eNode.InnerText End If debug_print("AdministrativeArea-DependentLocality-DependentyLocalityName (City)") End If Next ElseIf lNode.Name.ToLower = "subadministrativearea" Then debug_print("AdministrativeArea-SubAdministrativeArea") For Each eNode as XMLNode In lNode.ChildNodes If eNode.Name.ToLower = "subadministrativeareaname" AndAlso b.City eNode.InnerText Then If b.City "" Then b.City = eNode.InnerText & ", " & b.City Else b.City = eNode.InnerText End If debug_print("AdministrativeArea-SubAdministrativeArea-SubAdministrativeAreaName (City)") ElseIf eNode.Name.ToLower = "locality" Then debug_print("AdministrativeArea-SubAdministrativeArea-Locality") For Each sNode as XMLNode In eNode.ChildNodes If sNode.Name.ToLower = "localityname" AndAlso b.City sNode.InnerText Then If b.City "" Then b.City = sNode.InnerText & ", " & b.City Else b.City = sNode.InnerText End If debug_print("AdministrativeArea-SubAdministrativeArea-Locality-LocalityName (City)") End If Next ElseIf eNode.Name.ToLower = "dependentlocality" Then debug_print("AdministrativeArea-SubAdministrativeArea-DependentLocality") For Each sNode as XMLNode In eNode.ChildNodes If sNode.Name.ToLower = "dependentlocalityname" AndAlso b.City sNode.InnerText Then If b.City "" Then b.City = sNode.InnerText & ", " & b.City Else b.City = sNode.InnerText End If debug_print("AdministrativeArea-SubAdministrativeArea-DependentLocality-DependentyLocalityName (City)") End If Next End If Next End If Next ElseIf aNode.Name.ToLower = "subadministrativearea" Then debug_print("SubAdministrativeArea") For Each eNode as XMLNode In aNode.ChildNodes If eNode.Name.ToLower = "subadministrativeareaname" AndAlso b.City eNode.InnerText Then If b.City "" Then b.City = eNode.InnerText & ", " & b.City Else b.City = eNode.InnerText End If debug_print("SubAdministrativeArea-SubAdministrativeAreaName (City)") ElseIf eNode.Name.ToLower = "locality" Then debug_print("SubAdministrativeArea-Locality") For Each sNode as XMLNode In eNode.ChildNodes If sNode.Name.ToLower = "localityname" AndAlso b.City sNode.InnerText Then If b.City "" Then b.City = sNode.InnerText & ", " & b.City Else b.City = sNode.InnerText End If b.City = Left(b.City,48) debug_print("SubAdministrativeArea-Locality-LocalityName (City)") End If Next End If Next ElseIf aNode.Name.ToLower = "locality" Then debug_print("Locality-") For Each eNode as XMLNode In aNode.ChildNodes If eNode.Name.ToLower = "localityname" AndAlso b.City eNode.InnerText Then If b.City "" Then b.City = eNode.InnerText & ", " & b.City Else b.City = eNode.InnerText End If debug_print("Locality-LocalityName (City)") End If Next End If Next End If Catch ex as Exception hs.writelog("SnevlLatitude","Error extracting reverse geocode data - " & ex.message) debug_print("Error extracting reverse geocode data - " & ex.message) End Try Next If b.Address = "" Then b.Address = temp_addr b.City = Left(b.City,48) debug_print("Results of rev-geo parsing: City = '" & b.City & "', Address = '" & b.Address & "', ZIP = '" & b.ZipCode & "'")End Sub'******************************************************** **********************************************'* make_map() - Make a static map image file showing the location of the user'******************************************************* ***********************************************Sub make_map(ByVal b As BadgeClass, ByVal map_num as Integer) Dim map_page As String Dim path_spec as String Dim first_lat as String Dim first_lon as String Dim old_file_name as String Dim file_name as String Dim map_width as String Dim map_height as String Dim num_points as Integer = 0 Dim TypeOfMap as String Dim map_tag as String Dim file_tag as String If map_num = 1 Then map_tag = "" file_tag = "" Else map_tag = "2" file_tag = "_2" End If TypeOfMap = hs.GetIniSetting("Tuning","MapSetting" & map_tag,"TRACK","SnevlLatitude.ini") map_width = hs.GetIniSetting("Tuning","MapWidth" & map_tag,"400","SnevlLatitude.ini") map_height = hs.GetIniSetting("Tuning","MapHeight" & map_tag,"400","SnevlLatitude.ini") If TypeOfMap = "NONE" Then old_file_name = hs.GetIniSetting("MapImage",b.UserName & file_tag,"","SnevlLatitude.ini") file_name = "SnevlLatitudeNoMap.png" hs.SaveIniSetting("MapImage",b.UserName & file_tag,file_name,"SnevlLatitude.ini") If old_file_name file_name And System.IO.File.Exists(hs.GetAppPath() & "\html\images\" & old_file_name) Then System.IO.File.Delete(hs.GetAppPath() & "\html\images\" & old_file_name) End If Exit Sub End If If map_num = 2 And b.Dev.map2.ToUpper = "XX" Then Exit Sub End If Dim map_marker_color as Boolean = Boolean.Parse(hs.GetIniSetting("Tuning","MapMarkerColorForma t","True","SnevlLatitude.ini")) Dim head_marker_color as String = hs.GetIniSetting("Tuning","HeadMarkerColor","blue","SnevlLat itude.ini") Dim ini_marker_color as String = hs.GetIniSetting("Tuning","MarkerColor","blue","SnevlLatitud e.ini") Dim track_length as Integer = Int32.Parse(hs.GetIniSetting("Tuning","TrackLength" & map_tag,"10","SnevlLatitude.ini")) Dim map_type as String = hs.GetIniSetting("Tuning","MapType" & map_tag,"roadmap","SnevlLatitude.ini") Dim map_page_sb as new StringBuilder("&markers=color:",2048) Dim path_spec_sb as New StringBuilder(1024) ' vars to use in pulling the last 10 locations out of the database ' Marker colors: Current pos is GREEN, then from newer to older transition from BLUE to RED Dim marker_color() as String = {"0x00ff00","0x0000ff","0x1f00df","0x3f00bf","0x5f009f", _ "0x7f007f","0x9f005f","0xbf003f","0xdf001f","0xff0000" } Dim strQry as String = "SELECT Name,Latitude,Longitude,LastDateTime FROM LocationHistory WHERE Name='" & _ b.UserName & "' ORDER BY LastDateTime DESC" oRs = oConn.Execute(strQry) If Not oRs.EOF Then ' The most recent point gets a map pin map_page_sb.Append(head_marker_color) If map_marker_color Then map_page_sb.Append("%7C") Else map_page_sb.Append("|label:0%7C") End If first_lat = oRs("Latitude").value first_lon = oRs("Longitude").value map_page_sb.Append(first_lat) map_page_sb.Append(",") map_page_sb.Append(first_lon) oRs.MoveNext num_points = 1 End If If TypeOfMap = "TRACK" Then If Not oRs.EOF Then ' If we have more than one point, build the front of the "path" format for Google path_spec_sb.Append("&path=color:0x0000ff|weight:5|") path_spec_sb.Append(first_lat) path_spec_sb.Append(",") path_spec_sb.Append(first_lon) End If Do While Not oRs.EOF And num_points "auto" Then map_page_sb.Insert(0,"/maps/api/staticmap?" & "zoom=" & zoom_level & "&size=" & map_width & "x" & map_height & "&maptype=" & map_type) Else map_page_sb.Insert(0,"/maps/api/staticmap?size=" & map_width & "x" & map_height & "&maptype=" & map_type) End If End If map_page_sb.Append("&sensor=false&format=gif") 'If b.UserName.ToLower = "carol" Then ' hs.writelog("debug","in make_map(), map_num = " & map_num.tostring & ", user = " & b.UserName) ' hs.writelog("debug",map_page_sb.ToString()) 'End If ' To prevent caching of the image, give each new image a different name, and delete the previous image old_file_name = hs.GetAppPath() & "\html\images\" & hs.GetIniSetting("MapImage",b.UserName & file_tag,"","SnevlLatitude.ini") file_name = "map" & b.UserName & file_tag & "_" & DateTime.Now.ToString("yyyyMMdd_HHmmss_f") & ".gif" hs.SaveIniSetting("MapImage",b.UserName & file_tag,file_name,"SnevlLatitude.ini") hs.GetUrlImage("http://maps.googleapis.com",map_page_sb.ToString(),true,80,hs.GetAp pPath & "/html/images/" & file_name) If System.IO.File.Exists(old_file_name) Then System.IO.File.Delete(old_file_name) End IfEnd Sub'******************************************************** **********************************************'* make_multi_map() - Make a static map image file showing multiple badges'***************************************************** *************************************************Sub make_multi_map() Dim myRs as Object Dim old_file_name as String Dim file_name as String Dim map_width as String = hs.GetIniSetting("Tuning","MapWidth","400","SnevlLatitude.in i") Dim map_height as String = hs.GetIniSetting("Tuning","MapHeight","400","SnevlLatitude.i ni") Dim map_type as String = hs.GetIniSetting("Tuning","MapType","roadmap","SnevlLatitude .ini") Dim multi_map_dev as String = hs.GetIniSetting("MultiMap","MapDevice","XX","SnevlLatitude. ini") Dim strQry As String Dim path_spec as String Dim map_page_sb as New StringBuilder("/maps/api/staticmap?size=" & map_width & "x" & map_height & "&maptype=" & _ map_type,2048) Dim multi_map_checked as Boolean = Boolean.Parse(hs.GetIniSetting("MultiMap","Enabled","False", "SnevlLatitude.ini")) 'hs.writelog("debug","make_multi_map()") If Not multi_map_checked Then old_file_name = hs.GetIniSetting("MultiMap","MapImageFile","","SnevlLatitude .ini") file_name = "SnevlLatitudeNoMap.png" hs.SaveIniSetting("MultiMap","MapImageFile",file_name,"Snevl Latitude.ini") If old_file_name file_name And System.IO.File.Exists(hs.GetAppPath() & "\html\images\" & old_file_name) Then System.IO.File.Delete(hs.GetAppPath() & "\html\images\" & old_file_name) End If 'hs.writelog("debug","make_multi_map(), exit because not checked") Exit Sub End If myRs = oConn.Execute("SELECT DISTINCT Name,UserID,UniqueID FROM Badges ORDER BY Name ASC") Do While Not myRs.EOF Dim user_tag as String = myRs("Name").value & "_" & myRs("UniqueID").value.ToString Dim inc_badge As Boolean = Boolean.Parse(hs.GetIniSetting("MultiMap","Badge_" & user_tag & _ "_Included","False","SnevlLatitude.ini")) If inc_badge Then strQry = "SELECT Name,Latitude,Longitude,LastDateTime FROM LocationHistory WHERE Name='" & _ myRs("Name").value & "' ORDER BY LastDateTime DESC" oRs = oConn.Execute(strQry) If Not oRs.EOF Then Dim marker_color as String = hs.GetIniSetting("MultiMap","Badge_" & user_tag & "_Color","blue","SnevlLatitude.ini") map_page_sb.Append("&markers=color:" & marker_color) map_page_sb.Append("%7C") map_page_sb.Append(oRs("Latitude").value) map_page_sb.Append(",") map_page_sb.Append(oRs("Longitude").value) End If End If myRs.MoveNext Loop map_page_sb.Append("&sensor=false&format=gif") 'hs.writelog("debug",map_page_sb.ToString()) ' To prevent caching of the image, give each new image a different name, and delete the previous image old_file_name = hs.GetIniSetting("MultiMap","MapImageFile","","SnevlLatitude .ini") file_name = "MultiBadgeMap_" & DateTime.Now.ToString("yyyyMMdd_HHmmss_f") & ".gif" hs.SaveIniSetting("MultiMap","MapImageFile",file_name,"Snevl Latitude.ini") hs.GetUrlImage("http://maps.googleapis.com",map_page_sb.ToString(),true,80,hs.GetAp pPath & "/html/images/" & file_name) If old_file_name "SnevlLatitudeNoMap.png" And System.IO.File.Exists(hs.GetAppPath() & "\html\images\" & old_file_name) Then System.IO.File.Delete(hs.GetAppPath() & "\html\images\" & old_file_name) End If If multi_map_dev "XX" AndAlso hs.DeviceExistsRef(multi_map_dev) -1 Then hs.SetDeviceString(multi_map_dev,"",True) End IfEnd Sub'******************************************************** **********************************************'* dist() - Compute the distance in miles between two places on the earth, where each location is '* defined by a latitude and longitude string pair.'****************************************************** ************************************************Function dist(ByVal lat1 as String, ByVal lon1 as String, ByVal lat2 as String, ByVal lon2 as String) as Single ' Convert the lat and lon strings to floating point radians Dim sLat1 as Single = parse_single(lat1)/57.2958 Dim sLon1 as Single = parse_single(lon1)/57.2958 Dim sLat2 as Single = parse_single(lat2)/57.2958 Dim sLon2 as Single = parse_single(lon2)/57.2958 Dim result as Single const earthRadius as Single = 3963.0 result = earthRadius * Math.ACos(Math.Sin(sLat1) * Math.Sin(sLat2) + Math.Cos(sLat1) * Math.Cos(sLat2) * Math.Cos(sLon1 - sLon2)) If Not use_miles Then result = result * 1.609344 End If Return resultEnd Function'*************************************************** ***************************************************'* meters_to_dist() - Convert the meters (from the radius field) to the distance of choice (miles or km)'******************************************************** **********************************************Function meters_to_dist(ByVal m as Integer) as Single If use_miles Then Return(m/1609.344) Else Return(m/1000.0) End IfEnd Function'*************************************************** ***************************************************'* fix_time() - For some reason, the Google latitude API returns a local time in California (I guess'* because that is where Google is HQ'd), but marked as Zulu (GMT) time. To correct it, we need'* to offset the time in California from GMT, which is either -7 hours if Daylight Savings Time'* is in effect or -8 hours if it is Daylight Standard Time.'****************************************************** ************************************************Function fix_time(ByVal sDT as String) as DateTime Dim sBeginDST as String = Get_Date(3,DayOfWeek.Sunday,2) ' DST starts 2nd Sunday in March Dim sEndDST as String = Get_Date(11,DayOfWeek.Sunday,1) ' DST ends 1st Sunday in November Dim BeginDST as DateTime = DateTime.Parse(sBeginDST).Date Dim EndDST as DateTime = DateTime.Parse(sEndDST).Date Dim dtNow as DateTime = DateTime.Now.Date Dim hr_offset as String If DateTime.Compare(BeginDST,dtNow) = 0 Then hr_offset = "7" Else hr_offset = "8" End If sDT = sDT.Replace("Z","-" & hr_offset & ":00") return DateTime.Parse(sDT)End Function'*************************************************** **************************************' Get_Date - returns the Nth of the specified month, e.g. 3rd Tuesday in March.' Args are: the Month #, the DayOfWeek, and the count.'***************************************************** ************************************Function Get_Date(ByVal mo as Integer, ByVal the_day as DayOfWeek, ByVal count as Integer) Dim i_day as Integer = 0 For i as Integer = 1 To 30 Dim date1 as New DateTime(DateTime.Now.Year,mo,i) If date1.DayOfWeek = the_day Then i_day += 1 If i_day = count Then return(DateTime.Now.Year.ToString & "/" & mo.ToString & "/" & i.ToString) End If End If NextEnd Function'*************************************************** ***************************************************'* upgrade_database() - Make sure the database version is up to date.'****************************************************** ************************************************Function upgrade_database(ByVal cur_version as Integer) as Boolean Dim StrQry as String Dim DevNearFound as Boolean = False Dim MaxNearFound as Boolean = False Dim DevMap2Found as Boolean = False If cur_version = 0 Then ' clean install; see if the database is actually an empty vertion 4 Dim btraced_found as Boolean = False oRs = oConn.OpenSchema(adSchemaTables) Do While Not oRs.EOF If oRs("TABLE_TYPE").value = "TABLE" Then Dim tnam as String = oRs("TABLE_NAME").value If tnam.ToLower = "btraced" Then btraced_found = True End If End If oRs.MoveNext Loop oRs.Close() If btraced_found Then hs.WriteLog("SnevlLatitude","Database appears to be version 4; No upgrade needed.") hs.SaveIniSetting("Version","DatabaseVersion","4","SnevlLati tude.ini") Return(True) End If End If If cur_version

    Leave a comment:


  • jayman13
    replied
    Originally posted by Gogs View Post
    When someone tampers or repairs something that is working perfectly it usually goes wrong, NO?

    However, on this occasion it's worked perfectly, even removed a small error I was receiving for the past few days. Good one Steve.

    Now all we have to do is wait for Apple to return from there extended holiday and catch up.

    BTW, the new version of Btraced (I have been corrected the t after the C is lower case, although I thought the BTraced gave it some importance, anyway) solves a lot of the issues and I am not sure whether it's Steve's script changes or the changes to Btraced, but, it suddenly has become a lot more accurate.

    Perhaps the US Gov has turned on a another Sat.
    I can also confirm the updated version of the app and Snevllatitude is working very well. Haven't come across any issues as yet (except for low battery life) and I got two phones running btraced.

    Leave a comment:


  • Gogs
    replied
    Hmm, V2.1

    Originally posted by stevea View Post
    The first message of the library thread (here) has been updated with the ZIP file for v2.1 of Snevl Latitude................... Steve
    When someone tampers or repairs something that is working perfectly it usually goes wrong, NO?

    However, on this occasion it's worked perfectly, even removed a small error I was receiving for the past few days. Good one Steve.

    Now all we have to do is wait for Apple to return from there extended holiday and catch up.

    BTW, the new version of Btraced (I have been corrected the t after the C is lower case, although I thought the BTraced gave it some importance, anyway) solves a lot of the issues and I am not sure whether it's Steve's script changes or the changes to Btraced, but, it suddenly has become a lot more accurate.

    Perhaps the US Gov has turned on a another Sat.

    Leave a comment:


  • stevea
    replied
    v2.1 posted

    The first message of the library thread (here) has been updated with the ZIP file for v2.1 of Snevl Latitude. The changes since v2.0 are:
    • Lots of changes to fix errors encountered by users who live where a comma (instead of a period) is used as the decimal separator.
    • Similarly, changes made to ensure a period is used as the decimal separotor for data sent to Google for reverse geo.
    • Fixed error for fresh installs, to not attempt to upgrade the database.
    • Correct handling of the zoom level for second static map.
    • Use the current locale culture info for formatting of the default config values.
    • More debug and error trapping.

    If upgrading from a previous version, install everything except the data directory to preserve your existing data.

    As always, post any comments, problems, or questions in this discussion thread.

    Steve

    Leave a comment:


  • stevea
    replied
    Originally posted by Loup View Post
    When HomeSeer receive the following error BTraced data;

    <TABLE border=0 cellSpacing=2 cellPadding=0 width="100%"><TBODY><TR><TD class=LOGDateTime0 noWrap align=left>2012-12-24 14:01:17 </TD><TD class=LOGType0 colSpan=3 align=left>Error </TD><TD class=LOGEntry0 colSpan=8 align=left>SnevlLatitude: Failure parsing new BTraced XML</TD></TR><TR><TD class=LOGDateTime1 noWrap align=left>2012-12-24 14:01:17 </TD><TD class=LOGType1 colSpan=3 align=left>Error </TD><TD class=LOGEntry1 colSpan=8 align=left>


    Thank you for your reply.

    </TD></TR></TBODY></TABLE>
    Yes, that is fixed in the new version as well. I hope to post in the day after Christmas.

    Steve

    Leave a comment:


  • Loup
    replied
    Originally posted by stevea View Post
    I am pretty sure I have fixed that problem in v2.1, which I hope to post on Wednesday. Are you using Btraced, or Google Latitude?

    Steve
    I use Btraced,

    Leave a comment:


  • Loup
    replied
    When HomeSeer receive the following error BTraced data;

    <TABLE border=0 cellSpacing=2 cellPadding=0 width="100%"><TBODY><TR><TD class=LOGDateTime0 noWrap align=left>2012-12-24 14:01:17 </TD><TD class=LOGType0 colSpan=3 align=left>Error </TD><TD class=LOGEntry0 colSpan=8 align=left>SnevlLatitude: Failure parsing new BTraced XML</TD></TR><TR><TD class=LOGDateTime1 noWrap align=left>2012-12-24 14:01:17 </TD><TD class=LOGType1 colSpan=3 align=left>Error </TD><TD class=LOGEntry1 colSpan=8 align=left>


    Thank you for your reply.

    </TD></TR></TBODY></TABLE>

    Leave a comment:


  • stevea
    replied
    Originally posted by Loup View Post
    Hi gentlemen, I have a question, It seems extraordinary version 2, version 1.9 worked very well since I instaler version 2 I still have the same error. Here is the error:

    <TABLE border=0 cellSpacing=2 cellPadding=0 width="100%"><TBODY><TR><TD class=LOGDateTime0 noWrap align=left>2012-12-24 13:49:44 </TD><TD class=LOGType0 colSpan=3 align=left>Error </TD><TD class=LOGEntry0 colSpan=8 align=left></TD></TR><TR><TD class=LOGDateTime1 noWrap align=left>2012-12-24 13:49:44 </TD><TD class=LOGType1 colSpan=3 align=left>Error </TD><TD class=LOGEntry1 colSpan=8 align=left></TD></TR></TBODY></TABLE>

    Can someone help me? Please
    I am pretty sure I have fixed that problem in v2.1, which I hope to post on Wednesday. Are you using Btraced, or Google Latitude?

    Steve

    Leave a comment:

Working...
X