MartyConnelly
martyconnelly at shaw.ca
Sat Feb 3 20:03:04 CST 2007
Here is some code to footle around with it produces text route driving directions and distance from a starting lat/long to an ending one Just remember this is from a Virtual Earth server It isn't documented, I am still puzzling out. If you aren't paying for it there are no guarantees. it will work tomorrow If you wanted to get fancy you could add Yahoo Traffic and Construsction Info. Left in debug code to show what is happening ' This code takes about a second to return info. I don't know how 'you want to parse the returned string; but if this file was an XML file ' rather than html that would only take another second. 'This code fires off request to aspx Virtual Earth page ' sends start and end latitude/ 'returns route directions in text string 'direction, lat, long, distance 'Makes use of the XMLHTTPRequest object contained in msxml.dll. '?SendGrabRoute(48.0,-123.0,48.5,-123.5) Public Function SendGrabRoute(dStartLat As Double, dStartLon As Double, _ dEndLat As Double, dEndLon As Double) As String Dim strText As String Dim strPhoneNo As String Dim oHttp As Object Dim strURL As String Dim strRoute As String 'make use of the XMLHTTPRequest object contained in msxml.dll Set oHttp = CreateObject("Microsoft.XMLHTTP") 'oHttp.setRequestHeader "Content-Type", "application/x-www-form-urlencoded" 'oHttp.setRequestHeader "Content-Type", "text/xml" 'oHttp.setRequestHeader "Content-Type", "multipart/form-data" strURL = "http://local.live.com/directions.ashx?startlat=" & dStartLat & _ "&startlon=" & dStartLon & _ "&endlat=" & dEndLat & _ "&endlon=" & dEndLon Debug.Print strURL oHttp.Open "GET", strURL, False ' oHttp.Open "GET", "http://local.live.com/directions.ashx?startlat=48.0&startlon=-123.0&endlat=48.5&endlon=-123.5", False oHttp.setRequestHeader "Content-Type", "application/x-www-form-urlencoded" oHttp.send 'check the feedback from the Net File Debug.Print "Ready State =" & oHttp.ReadyState 'normal state =4 Debug.Print "Status =" & oHttp.Status 'normal status = 200 Debug.Print "Status Text =" & oHttp.StatusText Debug.Print oHttp.getAllResponseHeaders() 'Debug.Print "Response Body =" & oHttp.responseBody Dim strResponseBody As String strResponseBody = StrConv(oHttp.responseBody, vbUnicode) Debug.Print "Response Body =" & strResponseBody 'Debug.Print "Response Text =" & oHttp.responseText 'On Error Resume Next Set oHttp = Nothing Dim strAddrParts() As String ReDim strAddrParts(0) Dim i As Long Dim larrSize As Long Dim llast As Long ' maybe not the best parsing method in javascript use IndexOf strAddrParts = Split(strResponseBody, "new VE_RouteInstruction(") larrSize = UBound(strAddrParts) Debug.Print larrSize i = 0 strRoute = "" Do While i <= larrSize If i = larrSize Then ' strip out jpeg and extra lines on last line llast = InStr(1, strAddrParts(i), "]") strAddrParts(i) = Mid(strAddrParts(i), 1, llast - 1) 'Debug.Print "ver " & i & "=" & strAddrParts(i) strRoute = strRoute & strAddrParts(i) & vbCrLf ' Debug.Print strRoute Else ' Debug.Print "ver " & i & "=" & strAddrParts(i) strRoute = strRoute & strAddrParts(i) & vbCrLf ' Debug.Print strRoute End If i = i + 1 Loop SendGrabRoute = strRoute Exit Function ErrHandler: MsgBox Err.Number & vbCrLf & Err.Description, vbCritical & vbOKOnly & _ Err.Source End Function Arthur Fuller wrote: >Thanks! I'll look into that. > >-----Original Message----- >From: dba-sqlserver-bounces at databaseadvisors.com >[mailto:dba-sqlserver-bounces at databaseadvisors.com] On Behalf Of >MartyConnelly >Sent: January 25, 2007 3:45 PM >To: dba-sqlserver at databaseadvisors.com >Subject: Re: [dba-SQLServer] Route Planning > >Have a look at MapInfo's Routing Server >They have an office in Toronto. >They don't list prices. > > > > -- Marty Connelly Victoria, B.C. Canada