www.pudn.com > BeiJingBusSerchSystem.rar > bus.bas, change:2008-11-26,size:8877b


Attribute VB_Name = "mdlBus" 
Public gStation() As String '全局变量,保存所有公交站点名 
Public gBus() As String, gBusID() As Long   '全局变量,保存所有线路名和线路序号 
Sub GetStation()    '获取所有站点,保存到全局数组中 
    Dim cnn As New ADODB.Connection '定义数据库连接变量 
    Dim rst As New ADODB.Recordset  '定义记录集变量 
    Dim i As Long, j As Long 
    Dim Temp1   '保存记录集中的数据 
    cnn.ConnectionString = Conn '设置数据库连接字符串 
    cnn.Open    '打开数据库连接 
    Set rst = cnn.Execute("SELECT [station] FROM [station] GROUP BY [station]") '获取所有站点名 
    Temp1 = rst.GetRows '将记录集中的数据保存到数组中 
    rst.Close   '关闭记录集 
    cnn.Close   '关闭数据库连接 
     
    j = UBound(Temp1, 2)    '取得数组第2维的上界 
    ReDim gStation(j + 1) As String   '重定义全局数组 
    For i = 0 To j 
        gStation(i) = Temp1(0, i)   '将站点保存到全局数组中 
    Next 
End Sub 
 
Sub GetBusLine()    '获取所有线路信息,保存到全局数组中 
    Dim cnn As New ADODB.Connection '定义数据库连接变量 
    Dim rst As New ADODB.Recordset  '定义记录集变量 
    Dim i As Long, j As Long 
    Dim Temp1 
    cnn.ConnectionString = Conn '设置数据库连接字符串 
    cnn.Open    '打开数据库连接 
    Set rst = cnn.Execute("SELECT [id],[bus] FROM [bus]") '获取线路序号和线路名称 
    Temp1 = rst.GetRows '将记录集中的数据保存到数组中 
    rst.Close   '关闭记录集 
    cnn.Close   '关闭数据库连接 
     
    j = UBound(Temp1, 2)    '取得数组第2维的上界 
    ReDim gBusID(j) As Long, gBus(j) As String   '重定义全局数组 
    For i = 0 To j 
        gBusID(i) = Temp1(0, i)   '将线路序号保存到全局数组中 
        gBus(i) = Temp1(1, i)   '将线路名保存全局数组中 
    Next 
End Sub 
 
Public Function BusPerLine(ByVal busid As Long) As String() '获取指定线路序号经过的所有站点 
    Dim cnn As New ADODB.Connection '定义数据库连接变量 
    Dim rst As New ADODB.Recordset  '定义记录集变量 
    Dim Temp1, Temp2() As String 
    Dim str1 As String 
    Dim i As Long, j As Long 
    cnn.ConnectionString = Conn '设置数据库连接字符串 
    cnn.Open    '打开数据库连接 
    str1 = "SELECT [station] FROM [station] WHERE [busid]=" & busid & " ORDER BY [order]"   '查询指定线路的所有站点名,按站点顺序排序 
    Set rst = cnn.Execute(str1) '执行SQL语句 
    If Not rst.EOF Then '若查询到结果 
        Temp1 = rst.GetRows '将记录集中的数据保存到数组中 
        j = UBound(Temp1, 2)    '取得数组第2维的上界 
        ReDim Temp2(j) As String    '重定义动态数组 
        For i = 0 To j 
            Temp2(i) = Temp1(0, i)  '将取得的站点名保存到动态数组中 
        Next 
        BusPerLine = Temp2  '将动态数组中的值作为函数返回值 
    End If 
    rst.Close 
    cnn.Close 
End Function 
 
Public Function PassLine(ByVal sStation As String) As String()  '获取经过指定站点的所有线路序号 
    Dim cnn As New ADODB.Connection '定义数据库连接变量 
    Dim rst As New ADODB.Recordset  '定义记录集变量 
    Dim Temp1, Temp2() As String 
    Dim i As Long, j As Long 
    cnn.ConnectionString = Conn '设置数据库连接字符串 
    cnn.Open    '打开数据库连接 
     
    str1 = "SELECT [busid] FROM [station] WHERE [station]='" & sStation & "'"   '查询经过指定站点的线路序号 
    Set rst = cnn.Execute(str1) '执行SQL语句 
     
    Temp1 = rst.GetRows '将记录集中的数据保存到数组中 
     
    rst.Close 
    cnn.Close 
     
    j = UBound(Temp1, 2)    '取得数组第2维的上界 
    ReDim Temp2(j) As String   '重定义动态数组 
    For i = 0 To j 
        Temp2(i) = Temp1(0, i)  '将取得的线路序号保存到动态数组中 
    Next 
    PassLine = Temp2    '将动态数组中的值作为函数返回值 
End Function 
 
Public Sub BusSwitch(ByVal sStart As String, ByVal sEnd As String)  '乘车查询(直达部分) 
    Dim fs As Boolean, fe As Boolean, f1 As Integer '定义标志变量 
    Dim i As Long, j As Long, str1 As String    '定义临时变量 
    Dim Temp 
    fs = False  '设置出发站点标志 
    fe = False  '设置目的站点标志 
    GetStation  '将公交站点保存到全局数组中 
    GetBusLine  '将公交线路保存在全局数组中 
     
    For i = 0 To UBound(gStation)   '从全局站点数组中查找是否存在出发、目的站点 
        If sStart = gStation(i) Then fs = True  '有出发站点,设置标志变量为True 
        If sEnd = gStation(i) Then fe = True    '有目的站点,设置标志变量为True 
        If fs And fe Then Exit For  '若两个标志变量都为True,跳出循环 
    Next 
    If Not fs Then  '若出发站点标志为False 
        MsgBox "出发站点【" & sStart & "】不存在!", vbCritical + vbOKOnly, "警告"  '显示警告信息 
        Exit Sub    '退出当前过程 
    End If 
    If Not fe Then  '若目的站点标志为False 
        MsgBox "目的站点【" & sEnd & "】不存在!", vbCritical + vbOKOnly, "警告"    '显示警告信息 
        Exit Sub    '退出当前过程 
    End If 
    str1 = ""   '设置空字符串 
    For i = 0 To UBound(gBusID) '循环处理每一条线路 
        f1 = 0 
        Temp = BusPerLine(gBusID(i))    '获取指定线路所经过的站点,保存在数组中 
        For j = 0 To UBound(Temp) 
            If sStart = Temp(j) Then f1 = f1 + 1    '若出发站点在该线路经过的站点中,标志变量记数 
            If sEnd = Temp(j) Then f1 = f1 + 1  '若目的站点在该线路经过的站点中,标志变量记数 
            If f1 = 2 Then Exit For '标志变量为2,表示该线路可直达 
        Next 
        If f1 = 2 Then  '有直达车 
            str1 = str1 & gBusID(i) & ">" '保存直达车次 
        End If 
    Next 
    If str1 = "" Then '没有直达车 
        BusSwitch1 sStart, sEnd '调用一次换乘过程 
    Else    '有直达车 
        ShowLine 1, str1   '调用过程,显示乘车线路 
    End If 
End Sub 
 
Public Sub BusSwitch1(ByVal sStart As String, ByVal sEnd As String) '乘车查询(一次换乘) 
    Dim TempLine1, TempLine2, TempStation1, TempStation2    '定义临时变量 
    Dim i As Long, j As Long, k As Long, l As Long 
    Dim str1 As String 
    TempLine1 = PassLine(sStart)    '获取经过出发站点的所有线路 
    TempLine2 = PassLine(sEnd)  '获取经过目的站点的所有线路 
    str1 = "" 
    For i = 0 To UBound(TempLine1)  '循环处理经过出发站点的每一条线路 
        TempStation1 = BusPerLine(TempLine1(i)) '获取从出发站点经过的某线路的所有站点 
        For j = 0 To UBound(TempLine2)  '循环处理经过目的站点的每一条线路 
            TempStation2 = BusPerLine(TempLine2(j)) '获取从目的站点经过的某线路的所有站点 
            For k = 0 To UBound(TempStation1)   '循环处理经过出发站点的某一线路的所有站点 
                For l = 0 To UBound(TempStation2)   '循环处理经过目的站点的某一线路的所有站点 
                    If TempStation1(k) = TempStation2(l) Then   '成功找到相交站点 
                        str1 = str1 & TempLine1(i) & ">" & sStart & ">"  '从指定线路乘出发站点的车 
                        str1 = str1 & TempStation1(k) & ">" '到中转站点 
                        str1 = str1 & TempLine2(j) & ">" & sEnd & ">"   '换另一路到目的站点 
                    End If 
                Next 
            Next 
        Next 
    Next 
    If str1 = "" Then   '一次换乘无法到达 
        MsgBox "经过一次换乘,无法从【" & sStart & "】到达【" & sEnd & "】!", vbCritical + vbOKOnly, "警告"    '显示警告信息 
    Else 
        ShowLine 0, str1    '调用过程显示查询的乘车结果 
    End If 
End Sub 
 
Sub ShowLine(Switch As Integer, sBusLine As String) '显示查询的乘车结果 
    Dim Temp 
    Dim i As Long, j As Long, str1 As String 
    str1 = "" 
    sBusLine = Left(sBusLine, Len(sBusLine) - 1)    '去掉字符串后面的“>”符号 
    Temp = Split(sBusLine, ">") '用split函数将数据项分解到数组中 
    If Switch = 1 Then  '直达车 
        str1 = "可乘以下车次直达目的站点:" & vbNewLine 
        For i = 0 To UBound(Temp)   '循环输出每一条可以直达的线路 
            For j = 0 To UBound(gBusID) '根据线路序号查询线路名称 
                If Temp(i) = gBusID(j) Then 
                    str1 = str1 & "【" & gBus(j) & "】" & vbNewLine '输出一条直达线路 
                End If 
            Next 
        Next 
    Else    '一次换乘 
        str1 = "需要换乘才能到达目的地,可选以下方案:" & vbNewLine & vbNewLine 
        For i = 0 To UBound(Temp) Step 5    '循环输出每一种换乘方案 
            str1 = str1 & "方案" & i \ 5 + 1 & ":" & vbNewLine '输出方案号 
            For j = 0 To UBound(gBusID) '根据线路序号查询线路名称 
                If Temp(i) = gBusID(j) Then 
                    str1 = str1 & "从【" & gBus(j) & "】的【" & Temp(i + 1) & "】站出发,"  '输出出发信息 
                    Exit For 
                End If 
            Next 
            str1 = str1 & "到【" & Temp(i + 2) & "】站下车。" & vbNewLine   '输出到站信息 
            For j = 0 To UBound(gBusID) '根据线路序号查询线路名称 
                If Temp(i + 3) = gBusID(j) Then 
                    str1 = str1 & "换乘【" & gBus(j) & "】到【" & Temp(i + 4) & "】站下车。"    '输出换乘信息 
                    Exit For 
                End If 
            Next 
            str1 = str1 & vbNewLine & vbNewLine '每个方案后增加换行 
        Next 
    End If 
    frmFind.txtBusLine.Text = str1  '在文本框中显示具体的方案 
End Sub