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