📄 form1.frm
字号:
If Not dbr.EOF Then
Text1.Text = Text1.Text & "站点ID:" & dbr("city_id") & Chr(13) & Chr(10)
Text1.Text = Text1.Text & "经过道路:" & ciryroads(dbr("city_id")) & Chr(13) & Chr(10)
Else
Text1.Text = Text1.Text & "无此站点" & Chr(13) & Chr(10)
End If
dbr.Close
dbr.Open "select top 1 * from citys where city like '%%" & Text3.Text & "%%'", conn, 3, 3
Text1.Text = Text1.Text & "终止城市:" & Text3.Text & Chr(13) & Chr(10)
If Not dbr.EOF Then
Text1.Text = Text1.Text & "站点ID:" & dbr("city_id") & Chr(13) & Chr(10)
Text1.Text = Text1.Text & "经过道路:" & ciryroads(dbr("city_id")) & Chr(13) & Chr(10)
Else
Text1.Text = Text1.Text & "无此站点" & Chr(13) & Chr(10)
End If
dbr.Close
End Sub
Private Sub Command5_Click()
Text1.Text = roadofcitys(Text2.Text, Text3.Text)
End Sub
Private Sub Form_Load()
conn.ConnectionString = "driver={Microsoft Access Driver (*.mdb)};dbq=" & App.Path & "\way.mdb"
conn.Open
dbrs.Open "SELECT waypoints.ncity_id, waypoints.pcity_id FROM waypoints WHERE (((waypoints.city_id)=407))", conn, 1, 1
End Sub
Function add_province(province As String) As Long
Dim rs As New ADODB.Recordset
rs.Open "select top 1 * from provinces where province='" & province & "'", conn, 1, 3
If rs.RecordCount = 1 Then
add_province = rs("province_ID")
Else
rs.AddNew
rs("province") = province
rs.Update
Debug.Print rs("province_ID")
add_province = rs("province_ID")
End If
End Function
Function add_city(city As String, province_id As Long) As Long
Dim rs As New ADODB.Recordset
rs.Open "select top 1 * from citys where city='" & city & "'", conn, 1, 3
If rs.RecordCount = 1 Then
add_city = rs("city_ID")
Else
rs.AddNew
rs("city") = city
rs("province_id") = province_id
rs.Update
Debug.Print rs("city_ID")
add_city = rs("city_ID")
End If
End Function
Function add_way(way As String) As Long
Dim rs As New ADODB.Recordset
rs.Open "select top 1 * from ways where way='" & way & "'", conn, 1, 3
If rs.RecordCount = 1 Then
add_way = rs("way_ID")
Else
rs.AddNew
rs("way") = way
rs("class") = 1
rs.Update
Debug.Print rs("way_ID")
add_way = rs("way_ID")
End If
End Function
Function showncity(cityid As Long, Optional mpath$ = "0") As String
Dim dbr As New ADODB.Recordset
Dim tmp_city As String
If n = 8 Then Exit Function
If cityid = 52 Then n = 8: Exit Function
dbr.Open "SELECT waypoints.ncity_id, waypoints.pcity_id FROM waypoints WHERE (((waypoints.city_id)=" & cityid & ") and not (((waypoints.city_id) in(" & mpath$ & "))))", conn, 1, 1
Debug.Print mpath$
Do While Not dbr.EOF
' 'If dbr("ncity_id") <> -1 Then tmp_city = tmp_city & showcity(dbr("ncity_id")) & Chr(13) & Chr(10)
If dbr("ncity_id") <> -1 Then tmp_city = tmp_city & showncity(dbr("ncity_id"), mpath$ & "," & cityid) & Chr(13) & Chr(10)
If dbr("ncity_id") <> -1 Then tmp_city = tmp_city & showcity(dbr("ncity_id")) & Chr(13) & Chr(10)
If dbr("pcity_id") <> -1 Then tmp_city = tmp_city & showcity(dbr("pcity_id")) & Chr(13) & Chr(10)
dbr.MoveNext
Loop
showncity = tmp_city
dbr.Close
Set dbr = Nothing
End Function
Function showcity(cityid As Long) As String
Dim dbr As New ADODB.Recordset
dbr.Open "select top 1 city from citys where (city_id=" & cityid & ")", conn, 1, 1
showcity = dbr("city")
Debug.Print showcity
DoEvents
dbr.Close
Set dbr = Nothing
End Function
Function ciryroads(cityid As Long) As String
Dim dbr As New ADODB.Recordset
Dim tciryroads As String
dbr.Open "SELECT ways.way, ways.way_id FROM waypoints INNER JOIN ways ON waypoints.way_id = ways.way_id WHERE (((waypoints.city_id)=" & cityid & "))", conn, 1, 1
Do While Not dbr.EOF
tciryroads = tciryroads & dbr("way") & "--"
dbr.MoveNext
tciryroads = Left(tciryroads, Len(tciryroads) - 1)
ciryroads = tciryroads
Loop
End Function
Function roaddis(sw, ew, wayid) As Long
Dim startwpoint&
Dim endwpoint&
Dim dbrsql As String
Dim dbr As New ADODB.Recordset
dbr.Open "select top 1 waypoint_id from waypoints where (way_id=" & wayid & " and city_id=" & sw & ")", conn, 1, 1
startwpoint = dbr("waypoint_id")
dbr.Close
dbr.Open "select top 1 waypoint_id from waypoints where (way_id=" & wayid & " and city_id=" & ew & ")", conn, 1, 1
endwpoint = dbr("waypoint_id")
dbr.Close
If startwpoint > endwpoint Then
Debug.Print 1
dbrsql = "SELECT Sum([pdistance]) AS thesum FROM waypoints where (waypoint_id>= " & endwpoint & " and waypoint_id <= " & startwpoint & " and way_id = " & wayid & " )"
Else
Debug.Print 2
dbrsql = "SELECT Sum([ndistance]) AS thesum FROM waypoints where (waypoint_id>= " & startwpoint & " and waypoint_id < " & endwpoint & " and way_id = " & wayid & " )"
End If
dbr.Open dbrsql, conn, 1, 1
roaddis = dbr("thesum")
dbr.Close
End Function
Function roadofcitys(ByVal startcityname As String, ByVal endcityname As String) As String
Dim tmpstring
Dim startid&, endid&
startid = 0
endid = 0
Dim dbr As New ADODB.Recordset
tmpstring = ""
dbr.Open "select top 1 * from citys where city like '%%" & startcityname & "%%'", conn, 3, 3
tmpstring = tmpstring & "起始城市:" & startcityname & Chr(13) & Chr(10)
If Not dbr.EOF Then
tmpstring = tmpstring & "站点ID:" & dbr("city_id") & Chr(13) & Chr(10)
tmpstring = tmpstring & "经过道路:" & ciryroads(dbr("city_id")) & Chr(13) & Chr(10)
startid = dbr("city_id")
Else
tmpstring = tmpstring & "无此站点" & Chr(13) & Chr(10)
End If
dbr.Close
dbr.Open "select top 1 * from citys where city like '%%" & endcityname & "%%'", conn, 3, 3
tmpstring = tmpstring & "终止城市:" & endcityname & Chr(13) & Chr(10)
If Not dbr.EOF Then
tmpstring = tmpstring & "站点ID:" & dbr("city_id") & Chr(13) & Chr(10)
tmpstring = tmpstring & "经过道路:" & ciryroads(dbr("city_id")) & Chr(13) & Chr(10)
endid = dbr("city_id")
Else
tmpstring = tmpstring & "无此站点" & Chr(13) & Chr(10)
End If
dbr.Close
If startid <> 0 And endid <> 0 Then
tmpstring = tmpstring & "数据库包含起点和终点,可以寻找路径" & Chr(13) & Chr(10)
tmpstring = tmpstring & "寻找同一路段路径" & Chr(13) & Chr(10)
oneway = False
dbr.Open "SELECT ways.way_id, ways.way FROM ways WHERE (((ways.way_id)IN (SELECT waypoints.way_id FROM waypoints WHERE (((waypoints.city_id)=" & startid & "))))) AND (((ways.way_id) IN (SELECT waypoints.way_id FROM waypoints WHERE (((waypoints.city_id)=" & endid & ")))))", conn, 1, 1
Do While Not dbr.EOF
oneway = True
tmpstring = tmpstring & Chr(9) & "经过公路:" & dbr("way") & " ID:" & dbr("way_id") & Chr(13) & Chr(10)
tmpstring = tmpstring & Chr(9) & "里程:" & roaddis(startid, endid, dbr("way_id")) & Chr(13) & Chr(10)
dbr.MoveNext
Loop
dbr.Close
If oneway = False Then
tmpstring = tmpstring & "不存在同一路段路径,查找单中转点路径:" & Chr(13) & Chr(10)
dbrstr = "SELECT DISTINCT citys.city_id, citys.city FROM citys INNER JOIN waypoints ON citys.city_id = waypoints.city_id "
dbrstr = dbrstr & " WHERE (("
dbrstr = dbrstr & "(waypoints.city_id) In (SELECT waypoints.city_id FROM waypoints WHERE (((waypoints.way_id) In (SELECT waypoints.way_id FROM waypoints WHERE (((waypoints.city_id)=" & startid & "))))))"
dbrstr = dbrstr & " And "
dbrstr = dbrstr & "(waypoints.city_id) In (SELECT waypoints.city_id FROM waypoints WHERE (((waypoints.way_id) In (SELECT waypoints.way_id FROM waypoints WHERE (((waypoints.city_id)=" & endid & "))))))"
dbrstr = dbrstr & "))"
dbr.Open dbrstr, conn, 1, 1
toweay = False
Do While Not dbr.EOF
towway = True
tmpstring = tmpstring & Chr(9) & "经过城市:" & dbr("city") & " ID:" & dbr("city_id") & Chr(13) & Chr(10)
tmpstring = tmpstring & Chr(9) & Chr(9) & "中转里程:" & Chr(13) & Chr(10)
tmpstring = tmpstring & Chr(9) & Chr(9) & startcityname & "-" & dbr("city") & "里程:" & roaddis(startid, dbr("city_id"), wayid(startid, dbr("city_id"))) & "(" & wayname(startid, dbr("city_id")) & ")" & Chr(13) & Chr(10)
tmpstring = tmpstring & Chr(9) & Chr(9) & dbr("city") & "-" & endcityname & "里程:" & roaddis(dbr("city_id"), endid, wayid(dbr("city_id"), endid)) & "(" & wayname(dbr("city_id"), endid) & ")" & Chr(13) & Chr(10)
dbr.MoveNext
Loop
dbr.Close
End If
End If
roadofcitys = tmpstring
End Function
Function wayid(city1 As Long, city2 As Long) As Long
Dim dbr As New ADODB.Recordset
dbr.Open "SELECT ways.way_id, ways.way FROM ways WHERE (((ways.way_id)IN (SELECT waypoints.way_id FROM waypoints WHERE (((waypoints.city_id)=" & city1 & "))))) AND (((ways.way_id) IN (SELECT waypoints.way_id FROM waypoints WHERE (((waypoints.city_id)=" & city2 & ")))))", conn, 1, 1
wayid = dbr("way_id")
dbr.Close
End Function
Function wayname(city1 As Long, city2 As Long) As String
Dim dbr As New ADODB.Recordset
dbr.Open "SELECT ways.way_id, ways.way FROM ways WHERE (((ways.way_id)IN (SELECT waypoints.way_id FROM waypoints WHERE (((waypoints.city_id)=" & city1 & "))))) AND (((ways.way_id) IN (SELECT waypoints.way_id FROM waypoints WHERE (((waypoints.city_id)=" & city2 & ")))))", conn, 1, 1
wayname = dbr("way")
dbr.Close
End Function
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -