利用Google Directions API (Google Map) http://code.google.com/intl/zh-CN/apis/maps/documentation/directions/
和VB.net 输入目的地(支持中文地址、经纬度等)计算出距离。
如:输入 北京|上海|天津
运行程序 会计算从A地出发依次到北京、上海、天津 三地的总距离,可选择是否包含返回的距离(天津到A地的距离)。
如果需要线路优化 可以参照API 介绍中的 optimize:true。开启后会自动安排路线。
已经在VB.net 2003 通过测试。
做的着急有些地方直接复制的,代码没有优化,有些重复,但不影响最终使用。
'需要以下命名空间 Imports System.web Imports System.Xml Imports System.IO '需要声明的变量 Dim gstrPatch As String = "C:\XXX\map.xml" Private Sub btnCalc_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnCalc.Click '判断输入的目的地是否为空。 If txtROAD_ROUTE.Text = "" Then Exit Sub Try If MsgBox("路程距离数据会受到网络、关键字的影响,可能与实际距离相差很大,仅供参考。", MsgBoxStyle.YesNo, "系统提示") = MsgBoxResult.No Then Exit Sub Dim arrROAD As String() Dim strWaypoints As String Dim i As Integer = 0 arrROAD = txtROAD_ROUTE.Text.Split("|") Dim arrCalc(arrROAD.Length - 1) As String '对搜索的目的地编码 For t As Integer = 0 To arrROAD.Length - 1 arrROAD(t) = HttpUtility.UrlEncode(arrROAD(t), System.Text.Encoding.UTF8) Next '编码重组 For t As Integer = 0 To arrROAD.Length - 2 If strWaypoints = "" Then strWaypoints = arrROAD(t) Else strWaypoints = strWaypoints & "|" & arrROAD(t) End If Next '39.049435,121.782503 为出发地 经纬度,可以替换成路名、地名等,注意中文请注意转码。 Dim strURL As String strURL = "<a href="http://maps.google.com/maps/api/directions/xml?origin=39.049435,121.782503&destination">http://maps.google.com/maps/api/directions/xml?origin=39.049435,121.782503&destination</a>=" & arrROAD(arrROAD.Length - 1) & _ "&waypoints=" & strWaypoints & _ "&sensor=false" Dim myWebClient As New System.Net.WebClient 'myWebClient.DownloadFile("<a href="http://maps.google.com/maps/api/directions/xml?origin=39.049435,121.782503&destination">http://maps.google.com/maps/api/directions/xml?origin=39.049435,121.782503&destination</a>=" & strdifang & "&waypoints=&sensor=false", "C:\msdn.xml") myWebClient.DownloadFile(strURL, gstrPatch) Dim xmlDoc As New XmlDocument Dim XmlFileName As String = gstrPatch If File.Exists(XmlFileName) Then xmlDoc.Load(XmlFileName) Dim nodeList As XmlNodeList = xmlDoc.SelectSingleNode("DirectionsResponse").ChildNodes Dim xn1 As XmlNode Dim xn2 As XmlNode Dim xn3 As XmlNode For Each xn1 In nodeList For Each xn2 In xn1 For Each xn3 In xn2 If xn3.Name = "distance" Then arrCalc(i) = xn3.ChildNodes.Item(1).InnerText i = i + 1 End If Next Next Next End If Dim douKM As Double Dim strLast As String If MsgBox("是否计算往返路程?", MsgBoxStyle.YesNo, "系统提示") = MsgBoxResult.Yes Then strURL = "<a href="http://maps.google.com/maps/api/directions/xml?origin">http://maps.google.com/maps/api/directions/xml?origin</a>=" & arrROAD(arrROAD.Length - 1) & "&destination=39.049435,121.782503" & _ "&sensor=false" myWebClient.DownloadFile(strURL, gstrPatch) '*计算 Dim xmlDoc2 As New XmlDocument Dim XmlFileName2 As String = gstrPatch If File.Exists(XmlFileName2) Then xmlDoc2.Load(XmlFileName2) Dim nodeList As XmlNodeList = xmlDoc2.SelectSingleNode("DirectionsResponse").ChildNodes Dim xn12 As XmlNode Dim xn22 As XmlNode Dim xn32 As XmlNode For Each xn12 In nodeList For Each xn22 In xn12 For Each xn32 In xn22 If xn32.Name = "distance" Then strLast = xn32.ChildNodes.Item(1).InnerText End If Next Next Next End If For r As Integer = 0 To arrCalc.Length - 1 douKM = douKM + CType(Replace(arrCalc(r), " km", ""), Double) Next douKM = douKM + CType(Replace(strLast, " km", ""), Double) Else For r As Integer = 0 To arrCalc.Length - 1 douKM = douKM + CType(Replace(arrCalc(r), " km", ""), Double) Next End If '显示距离 KM 单位 txtDISTANCE.Text = douKM Catch ex As Exception MsgBox("获取距离数据失败。") End Try End Sub