form1.frm

输入起点

  For i = 1 To W
     If a(i) > max Then
     max = a(i)
     End If
 Next
 ra.Close
 '公交换乘一次
 Dim biaoshi1, biaoshi2, biaoshi3 As Boolean '标识是不是存在站点
 biaoshi1 = biaoshi2 = biaoshi3 = False
 If max = 0 Then
 rb.Open "select * from xianlu", cnn, adOpenDynamic, adLockOptimistic
 ra.Open "select * from xianlu", cnn, adOpenDynamic, adLockOptimistic
 Do While (Not ra.EOF)
  rb.MoveFirst
 For i = 1 To ra.Fields.Count - 1
    If ra.Fields(i) = str1 Then
    biaoshi1 = True
     Do While (Not rb.EOF)
      For j = 1 To rb.Fields.Count - 1
         If rb.Fields(j) = str2 Then
           biaoshi2 = True
             Dim k, l As Integer
             For k = 1 To ra.Fields.Count - 1
                For l = 1 To rb.Fields.Count - 1
                  If ra.Fields(k) = rb.Fields(l) Then
                     biaoshi3 = True
                     If i < k Then
                         m = 1
                     Else
                         m = -1
                     End If
                    Dim str3 As String
                    For n = i To k Step m
                      str3 = str3 & ra.Fields(n) & " "
                    Next n
                    Text3.Text = Text3.Text & "你可以先乘坐公交" + Trim(ra.Fields(1)) + "你经过的站点是:" & str3 & Chr(13) + Chr(10)
                     If l < j Then
                         m = 1
                     Else
                         m = -1
                     End If
                    Dim str4 As String
                    For n = l To j Step m
                      str4 = str4 & rb.Fields(n) & " "
                    Next n
                    Text3.Text = Text3.Text & "再转坐" + Trim(rb.Fields(1)) + "经过的站点是:" & str4 & Chr(13) + Chr(10) & Chr(13) + Chr(10)
                    str3 = ""
                    str4 = ""
                  End If
                Next l
             Next k
           End If
        Next j
     rb.MoveNext
    
     Loop
     
  End If
   
 Next i
    ra.MoveNext

    
Loop
  If biaoshi1 = False Or biaoshi2 = False Then
     MsgBox "起始站或终点站不存在，请重新输入"
     Text1.Text = ""
     Text2.Text = ""
     Exit Sub
   End If
 End If
 If max = 0 And biaoshi3 = False Then
rb.Close
ra.Close
 rb.Open "select * from xianlu", cnn, adOpenDynamic, adLockOptimistic
 ra.Open "select * from xianlu", cnn, adOpenDynamic, adLockOptimistic
 rc.Open "select * from xianlu", cnn, adOpenDynamic, adLockOptimistic
 Dim pos2, pos3 As Integer
 Dim k1, l1 As Integer
 Dim biaoshi4, biaoshi5 As Boolean
 Dim jlweizhiA, jlweizhiB, jlweizhiC   As Integer
 jlweizhiA = 0
 jlweizhiB = 0
 jlweizhiC = 0
 biaoshi4 = biaoshi5 = False
 Do While (Not ra.EOF)
 For i = 2 To ra.Fields.Count - 1
    rb.MoveFirst
    jlweizhiB = 0
    If ra.Fields(i) = str1 Then
     Do While (Not rb.EOF)
        
       For j = 2 To rb.Fields.Count - 1
          If rb.Fields(j) = str2 Then
            For k = 2 To ra.Fields.Count - 1
                For l = 2 To rb.Fields.Count - 1
                 rc.MoveFirst
                 jlweizhiC = 0
                 Debug.Print rb.Fields(l)
                 Do While (Not rc.EOF)
                  For q = 2 To rc.Fields.Count - 1
                     If jlweizhiA <> jlweizhiC And rc.Fields(q) = ra.Fields(k) Then
                        biaoshi4 = True
                        k1 = q
                     End If

                     If jlweizhiC <> jlweizhiB And rc.Fields(q) = rb.Fields(l) Then
                        biaoshi5 = True
                        l1 = q
                     End If
                  Next q
             If biaoshi4 = True And biaoshi5 = True Then
                If i < k Then
                  m = 1
                Else
                  m = -1
                End If
                Dim str5 As String
                    For n = i To k Step m
                      str5 = str5 & ra.Fields(n) & " "
                    Next n
                    Text3.Text = Text3.Text & "你可以先乘坐公交" + Trim(ra.Fields(1)) + "你经过的站点是:" & str5 & Chr(13) + Chr(10)
               If k1 < l1 Then
                  m = 1
                Else
                  m = -1
                End If
                Dim str6 As String
                For n = k1 To l1 Step m
                      str6 = str6 & rc.Fields(n) & " "
                Next n
                Text3.Text = Text3.Text & "再转坐" + Trim(rc.Fields(1)) + "经过的站点是:" & str6 & Chr(13) + Chr(10)
                If l < j Then
                   m = 1
                Else
                   m = -1
                End If
                Dim str7 As String
                For n = l To j Step m
                      str7 = str7 & rb.Fields(n) & " "
                    Next n
                    Text3.Text = Text3.Text & "再转坐" + Trim(rb.Fields(1)) + "经过的站点是:" & str7 & Chr(13) + Chr(10) & Chr(13) + Chr(10)
                 str5 = "": str6 = "": str7 = ""
              End If
             biaoshi4 = False
             biaoshi5 = False
             rc.MoveNext
             jlweizhiC = jlweizhiC + 1
          Loop
        Next l
      Next k
      End If
    Next j
        rb.MoveNext
        jlweizhiB = jlweizhiB + 1
    
     Loop
     
  End If
   
 Next i
    jlweizhiA = jlweizhiA + 1
    ra.MoveNext
    
    
Loop
 
    
 End If

End Sub

Private Sub Command2_Click()
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
End Sub


Private Sub Command3_Click()
   End
End Sub


Private Sub Command4_Click()
   Text3.Text = ""
    Dim DATABASE As String
    DATABASE = "1.mdb"
    str1 = Text4.Text
    Dim str2 As String
    Dim cnn1 As New ADODB.Connection
    Dim rs As New ADODB.Recordset
    cnn1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + App.Path + "\" + DATABASE + ""
    cnn1.Open
    'str2 = "select * from xianlu where xianlu='" + Trim(str1) + "'"
    rs.Open "select * from xianlu where xianlu='" + Trim(str1) + "'", cnn1, adOpenDynamic, adLockOptimistic
    If rs.EOF = True Then
      MsgBox "你输入的站点不存在，请重新输入"
      Text4.Text = ""
      Exit Sub
    End If
    For i = 1 To rs.Fields.Count - 1
       Text3.Text = Text3.Text & rs.Fields(i) & " "
    Next i
    
End Sub

Private Sub Command5_Click()
  Dim cn As New ADODB.Connection
  Dim rs1 As New ADODB.Recordset
  Dim cmd As New ADODB.Command
  cn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + App.Path + "\" + DATABASE + ""
  cn.Open
 rs1.Open "select * from xianlu ", cnn1, adOpenDynamic, adLockOptimistic
 For i = 1 To rs1.Fields.Count - 1
    If rs1.Fields(i).Value Like "*" + Trim(Text2.Text) + "*" Then
    End If
  
  
End Sub




Private Sub List1_Click()
    If bs = 1 Then
      Text1.Text = List1.Text
    Else
      Text2.Text = List1.Text
    End If
End Sub

Private Sub List2_Click()
    Text4.Text = List2.Text
End Sub

Private Sub Text1_Change()
  List1.Clear
  Dim cn As New ADODB.Connection
  Dim rst As New ADODB.Recordset
  Dim SiteName As String
  Dim flag As Integer
  bs = 1
  cn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + App.Path + "\1.mdb"
  cn.Open
  rst.Open "select * from xianlu", cn, adOpenDynamic, adLockOptimistic
  Do While (Not rst.EOF And Text1.Text <> "")
  For i = 2 To rst.Fields.Count - 1
     If rst.Fields(i).Value Like "*" + Text1.Text + "*" Then
       For j = 0 To List1.ListCount
         If rst.Fields(i) = List1.List(j) Then
            flag = 1
       
         End If
        Next
       If flag <> 1 Then
          List1.AddItem rst.Fields(i)
       End If
     End If
     flag = 0
  Next
  rst.MoveNext
 Loop

End Sub

Private Sub Text2_Change()
List1.Clear
  Dim cn As New ADODB.Connection
  Dim rst As New ADODB.Recordset
  Dim SiteName As String
  Dim flag As Integer
  bs = 2
  cn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + App.Path + "\1.mdb"
  cn.Open
  rst.Open "select * from xianlu", cn, adOpenDynamic, adLockOptimistic
  Do While (Not rst.EOF And Text2.Text <> "")
  For i = 2 To rst.Fields.Count - 1
     If rst.Fields(i).Value Like "*" + Text2.Text + "*" Then
       For j = 0 To List1.ListCount
         If rst.Fields(i) = List1.List(j) Then
            flag = 1
       
         End If
        Next
       If flag <> 1 Then
          List1.AddItem rst.Fields(i)
       End If
     End If
     flag = 0
  Next
  rst.MoveNext
 Loop
End Sub

Private Sub Text4_Change()
    List2.Clear
  Dim cn As New ADODB.Connection
  Dim rst As New ADODB.Recordset
  Dim SiteName As String
  Dim flag As Integer
  cn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + App.Path + "\1.mdb"
  cn.Open
  rst.Open "select * from xianlu", cn, adOpenDynamic, adLockOptimistic
  Do While (Not rst.EOF And Text4.Text <> "")
  For i = 1 To 1
     If rst.Fields(i).Value Like "*" + Text4.Text + "*" Then
       For j = 0 To List2.ListCount
         If rst.Fields(i) = List2.List(j) Then
            flag = 1
       
         End If
        Next
       If flag <> 1 Then
          List2.AddItem rst.Fields(i)
       End If
     End If
     flag = 0
  Next
  rst.MoveNext
 Loop
End Sub