ospf.frm

利用VB开发的一个最短路径查询系统

VERSION 5.00
Begin VB.Form frmOSPF 
   Caption         =   "最短路径选择"
   ClientHeight    =   4650
   ClientLeft      =   3360
   ClientTop       =   2910
   ClientWidth     =   7170
   Icon            =   "OSPF.frx":0000
   LinkTopic       =   "Form2"
   LockControls    =   -1  'True
   ScaleHeight     =   4650
   ScaleWidth      =   7170
   Begin VB.TextBox Text1 
      Height          =   3375
      Left            =   240
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   5
      Top             =   1080
      Width           =   6735
   End
   Begin VB.CommandButton Command1 
      Caption         =   "打印最短路线"
      Height          =   495
      Left            =   4320
      TabIndex        =   4
      Top             =   360
      Width           =   2055
   End
   Begin VB.ComboBox Combo2 
      Height          =   300
      Left            =   1680
      TabIndex        =   2
      Text            =   "终点站"
      Top             =   600
      Width           =   1215
   End
   Begin VB.ComboBox Combo1 
      Height          =   300
      Left            =   240
      TabIndex        =   1
      Text            =   "起讫站"
      Top             =   600
      Width           =   1215
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      Caption         =   "终点站："
      Height          =   180
      Left            =   1800
      TabIndex        =   3
      Top             =   240
      Width           =   720
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "起讫站："
      Height          =   180
      Left            =   240
      TabIndex        =   0
      Top             =   240
      Width           =   720
   End
End
Attribute VB_Name = "frmOSPF"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim start, ends As Long
Dim JLH(1 To 300), LJD(1 To 300, 1 To 4), DST(1 To 300, 1 To 4) As Long
Dim BH(1 To 300), ADD(1 To 300) As String
Dim n As Integer
Dim vertexnum As Integer
Dim edgenum As Integer
Const max = 100000
Dim graph(0 To 300, 0 To 300) As Long
Dim visited(0 To 300) As Integer
Dim path(0 To 300) As Integer
Dim distance(0 To 90000) As Long

Private Function dijkstra(begin As Integer)
    Dim minedge, vertex, i, j, n, m, edges As Integer
    edges = 1
    visited(begin) = 1
    For i = 1 To vertexnum
        distance(i) = graph(begin, i)
'        Debug.Print distance(i)
    Next i
        distance(begin) = 0
              While (edges < vertexnum - 1)
                edges = edges + 1
                minedge = max
                For j = 1 To vertexnum
                    If visited(j) = 0 And minedge > distance(j) Then
                        vertex = j
                        minedge = distance(j)
                    End If
                Next j
                visited(vertex) = 1
                For n = 1 To vertexnum
                    If visited(n) = 0 And (distance(vertex) + graph(vertex, n)) < distance(n) Then
                        distance(n) = distance(vertex) + graph(vertex, n)
                        path(n) = vertex
                    End If
                Next
              Wend
End Function
Private Sub Command1_Click()
    Dim i, j As Integer
    Dim k As Integer
    Dim addname(1 To 100) As String
    
    Text1 = ""
        If start = 0 Or ends = 0 Then
        MsgBox "请选择起始站与终点站"
        Exit Sub
    End If
    For i = 1 To vertexnum
        visited(i) = 0
        path(i) = 1
    Next
    dijkstra (start)
    Text1 = "起讫站：" & ADD(start) & "  -->  " & "终点站：" & ADD(ends) & vbCrLf
    Text1 = Text1 & vbCrLf
    If distance(ends) = max Then
        Text1 = Text1 & "两站点间没有可联接的路线！"
        Exit Sub
    Else
        Text1 = Text1 & "它们之间的距离为： " & distance(ends) * 0.1 & "  Km" & vbCrLf
        Text1 = Text1 & vbCrLf
        Text1 = Text1 & "它们之间的最短路线为：" & vbCrLf
        Text1 = Text1 & vbCrLf
        Text1 = Text1 & ADD(start)
    End If
    k = ends
    j = 1
    Do
        addname(j) = ADD(k)
        k = path(k)
        j = j + 1
    Loop While (k <> 1)
    For j = j - 1 To 1 Step -1
        Text1 = Text1 & "--> " & addname(j)
    Next j
End Sub

Private Sub Form_Initialize()
    Dim i, j, k As Long
    Dim filename As String
    Dim buffers As String
    
    On Error Resume Next
    
    filename = App.path + "\" + "Add_Dst" + ".txt"
    Open filename For Input As #1
    If LOF(1) = 0 Then
        MsgBox "The lenth of the file is zero! Please Select it asgain。" & vbCrLf & "The file name is Add_Dst。"
        
        Exit Sub
    End If
    i = 1
    Do While Not EOF(1)
    Line Input #1, buffers
        BH(i) = Val(Mid$(buffers, 1, 3))
        ADD(i) = Mid$(buffers, 4, 4)
            Combo1.AddItem ADD(i)
            Combo2.AddItem ADD(i)
        LJD(i, 1) = Val(Mid$(buffers, 8, 3))    '邻接点的编号
        DST(i, 1) = Val(Mid$(buffers, 11, 2))    '与邻接点之间的距离
        LJD(i, 2) = Val(Mid$(buffers, 13, 3))
        DST(i, 2) = Val(Mid$(buffers, 16, 2))
        LJD(i, 3) = Val(Mid$(buffers, 18, 3))
        DST(i, 3) = Val(Mid$(buffers, 21, 2))
        LJD(i, 4) = Val(Mid$(buffers, 24, 3))
        DST(i, 4) = Val(Mid$(buffers, 27, 2))
        Kill buffers
        i = i + 1
    Loop
        n = i - 1
'       Debug.Print n
    Close #1
       
    vertexnum = n  '设置图的顶点数
    
    edgenum = 0
   
    For i = 1 To n
        For j = 1 To 4
            If LJD(i, j) = 0 Then Exit For
            edgenum = edgenum + 1    '获得图的边数
            graph(i, LJD(i, j)) = DST(i, j)   '从i点与其邻接点LJD(i,j)的距离
        Next
    Next

    For i = 0 To n
        For j = 0 To n
            If graph(i, j) = 0 Then
                graph(i, j) = max
            End If
        Next
    Next
End Sub
Private Sub Combo1_click()
    start = Combo1.ListIndex + 1      '获得起讫站的编号
End Sub

Private Sub Combo2_click()
    ends = Combo2.ListIndex + 1      '获得终点站的编号
End Sub