'force declaration of all variables
Option Explicit
'force lower bound of all arrays to 1
Option Base 1

'array to hold nodes except source
Dim S() As Integer

'array to hold distances
Dim D() As Integer

'array to hold next-hop route
Dim R() As Integer

'array used for deleting u from S
Dim Spare() As Integer

'node with lowest distance
Dim u As Integer

'node with edge with u
Dim v As Integer

'distance from source through u to v
Dim c As Integer

'integer used for counting loops
Dim i As Integer

'lowest weight
Dim weight As Integer

'size of network being measured
Dim size As Integer

'source node
Dim source As Integer

'integers used to find lowest u
Dim val1 As Integer
Dim val2 As Integer

'message displayed in inputboxes
Dim msg As String

'return code from opening IE
Dim lshell As Long

'used in error handling
Dim myerror



Private Sub GetDetails()
    'get the size of the net and the source
    On Error GoTo HandleErrors
    
    size = CInt(InputBox("How many nodes in the network?", "Number of Nodes"))
    source = CInt(InputBox("What is the source node?", "Source Node"))
    
HandleErrors:
Select Case Err.Number
Case 13
    msg = "You have entered an incorrect value, or "
    msg = msg & "you have decided to cancel the program."
    msg = msg & vbCrLf & vbCrLf
    msg = msg & "(If you choose not to cancel the program you can re-enter the value in question)"
    msg = msg & vbCrLf & vbCrLf
    msg = msg & "Do you want to cancel the program?"
    myerror = MsgBox(msg, vbCritical + vbYesNo, "Cancel Program?")
    
    If myerror = vbYes Then
        End
    Else
        Resume
    End If
    
End Select
End Sub

Private Sub InitArrays()
're-initialise the arrays to take into account size of net

ReDim S(size - 1)
ReDim D(size)
ReDim R(size)
End Sub

Private Sub FillS()
    'assume net is numbered logically.
    'fill Set S with numbers 1 to max size
    'except for source
    
    For i = 1 To size
        If i < source Then
            S(i) = i
        ElseIf i > source Then
            S(i - 1) = i
        End If
    Next
    
End Sub

Private Sub FillD()
    'get distances between source and other nodes
    'max size of integer type is 32767, so to allow
    'some leeway for adding and subtracting the numbers
    'we pretend 32500 is infinity
    On Error GoTo HandleErrors
    
    For i = 1 To size
        If i = source Then
            D(i) = 0
        Else
            msg = "What is the value of the edge between " & source & " and " & i & "?"
            msg = msg & vbCrLf & vbCrLf
            msg = msg & "Accept the default if no edge exists."
            D(i) = CInt(InputBox(msg, "Edge Values", 32500))
        End If
    Next

HandleErrors:
Select Case Err.Number
Case 13
    msg = "You have entered an incorrect value, or "
    msg = msg & "you have decided to cancel the program."
    msg = msg & vbCrLf & vbCrLf
    msg = msg & "(If you choose not to cancel the program you can re-enter the value in question)"
    msg = msg & vbCrLf & vbCrLf
    msg = msg & "Do you want to cancel the program?"
    myerror = MsgBox(msg, vbCritical + vbYesNo, "Cancel Program?")
    
    If myerror = vbYes Then
        End
    Else
        Resume
    End If
    
End Select
End Sub

Private Sub FillR()
    'once we know the nodes and the distances, we can make
    'some assumptions. if the distance is 32500, there is no
    'connection and r[i] is 0, if the distance is 0 then the
    'source must be the same as the destinantion. if any other
    'value is in d, then the destination is the same as the
    'current position in the loop
    
    For i = 1 To size
        If D(i) = 0 Then
            R(i) = source
        ElseIf D(i) = 32500 Then
            R(i) = 0
        Else
            R(i) = i
        End If
    Next
    
End Sub

Private Sub FindMin()
'to find the min, we take each value in S, and
'find its corresponding value in d. we then take
'the next value in s and its corresponding value.
'if the difference between the values is less than 0
'then we have the smaller of the 2 numbers.
'repeat this for all values in S

For i = 1 To UBound(S)
    
    val1 = D(S(i))
    
    
    'we have to take into account that val2 will
    'reach the end of S before val1, so we just loop
    'back a couple of places
    
    If i = UBound(S) And UBound(S) <> 1 Then
        val2 = D(S(i - 1))
    Else
        val2 = D(S(i + 1))
    End If
    
    If val1 - val2 < 0 Then
        u = S(i)
        weight = D(S(i))
    End If
Next
        
End Sub

Private Sub DeleteU()
    'to delete u from s we load all
    'the values from S into a spare array,
    'except for u. We clear set S, and
    'reload it from the spare array
    
        ReDim Spare((UBound(S) - 1))
        
        For i = 1 To UBound(S)
            If S(i) < u Then
                Spare(i) = S(i)
            ElseIf S(i) > u And i <> 1 Then
                Spare(i - 1) = S(i)
            End If
        Next
        
        
        ReDim S(UBound(Spare))
        S = Spare
        Erase Spare
    
End Sub
Private Sub FindEdges()
   'to find if a node is connected to u
   'we loop through each remaining value in
   'set s. This is much easier than asking
   'for the edges and then checking. We
   'assume that if the distance is 32500
   'there is no connection. we are treating
   '32500 as infinity. See comments for FillD()

On Error GoTo HandleErrors

For i = 1 To UBound(S)
        
        v = S(i)
    
    msg = "If node " & u & " is directly connected to " & v & ", enter the value."
    msg = msg & vbCrLf
    msg = msg & "If there is no direct connection accept the default."
        
    c = CInt(InputBox(msg, "Direct Connections to " & u, 32500))
    
    
    'this is were we work out the optimal distance
    If c <> 32500 Then
        c = D(u) + c
            If c < D(v) Then
                R(v) = R(u)
                D(v) = c
            End If
    End If
    
Next

HandleErrors:
Select Case Err.Number
Case 13
    msg = "You have entered an incorrect value, or "
    msg = msg & "you have decided to cancel the program."
    msg = msg & vbCrLf & vbCrLf
    msg = msg & "(If you choose not to cancel the program you can re-enter the value in question)"
    msg = msg & vbCrLf & vbCrLf
    msg = msg & "Do you want to cancel the program?"
    myerror = MsgBox(msg, vbCritical + vbYesNo, "Cancel Program?")
    
    If myerror = vbYes Then
        End
    Else
        Resume
    End If
    
End Select
End Sub

Private Sub CheckArrays()
    'procedure to check contents of array
    'removed from end code, not neccessary in executable file
    
    For i = 1 To UBound(S)
        Debug.Print "S(" & i & ") = " & S(i)
    Next
    
    For i = 1 To UBound(D)
        Debug.Print "d(" & i & ") = " & D(i)
    Next
    
    For i = 1 To UBound(R)
        Debug.Print "r(" & i & ") = " & R(i)
    Next

    Debug.Print "u = " & u
    Debug.Print "min weight = " & weight
End Sub
Private Sub PrintToFile()
    'code to print results to file
    'and open the .htm file in internet explorer
    'code is written for home PC. Will not
    'work on any other PC. Must Check into this
    'Use registry? System/Environment variables?
    
    Open App.Path & source & "_table.htm" For Output As #1
        Print #1, "<table width='75%' align=center>"
        Print #1, "<tr><td colspan =3><h1 align=center>Routing Table for Node " & source & "</h1></td></tr>"
        Print #1, "<tr align=center><td><h3>Destination Node</h3></td><td><h3>Distance to Node</h3></td><td><h3>Next-Hop Route</h3></td></tr>"
        For i = 1 To UBound(D)
            Print #1, "<tr align=center><td>" & (i) & "</td><td>" & D(i) & "</td><td>" & R(i)
        Next
    Close #1
    
    
    
    
End Sub


Sub Main()
GetDetails
InitArrays
FillS
FillD
FillR

Do Until UBound(S) = 1
    FindMin
    DeleteU
    FindEdges
    CheckArrays
Loop

PrintToFile
End Sub