用VB编写链表

  先定义一个节点类：

Node.cls

'******************************************************************
'**** 链表类
'**** 创建人：wkf
'**** 创建日期：2006-11-14

Option Explicit

Public member As Object
Public nextNode As Node

Public Sub nodeConstruction(ByRef mem As Object, Optional nextNode As Node = Nothing)
  Set member = mem
End Sub

链表类：

LinkedList.cls

'******************************************************************
'**** 链表类LinkedList
'**** 创建人：wkf
'**** 创建日期：2006-11-14

Option Explicit

Private count As Integer '链表中元素数量
Private pHead As Node  '指向表头
Private pEnd As Node  '指向表尾

'初始化链表
Private Sub Class_Initialize()
  count = 0
  Set pHead = Nothing
  Set pEnd = Nothing
End Sub

Public Function add(obj As Object) As Boolean '将指定元素追加到末尾
  On Error GoTo errHandle:
  Dim nod As Node
  Set nod = New Node
  Call nod.nodeConstruction(obj)
  If (count = 0) Then
    Set pHead = nod
    Set pEnd = nod
  Else
    Set pEnd.nextNode = nod
    Set pEnd = nod
  End If
  count = count + 1
  Exit Function
errHandle:
 add = False
End Function

'将指定元素追加到某一个位置,index从零开始
'如果index小于零，不插入任何值
'如果index大于链表的长度加1，则插入到末尾
Public Sub addExact(index As Integer, obj As Object)
  If index < 0 Then
    Exit Sub
  End If
  If index >= count Then
    Call add(obj)
    Exit Sub
  End If
  Dim nod As Node
  Set nod = New Node
  nod.nodeConstruction (obj)
  If (index = 0) Then
    Set nod.nextNode = pHead
    Set pHead = nod
    Exit Sub
  End If
  Dim n As Integer
  Dim ps As Node
  Set ps = pHead
  n = 0
  While n < index - 1
    Set ps = ps.nextNode
  Wend
  Set nod.member = ps.nextNode
  ps.nextNode = nod
End Sub

'清空列表
Public Sub clear()
  count = 0
  Set pHead = Nothing
  Set pEnd = Nothing
End Sub

'如果此列表包含指定元素，则返回 true。
Public Function contains(obj As Object) As Boolean
  Dim ps As Node
  Set ps = pHead
  While Not (ps Is Nothing)
    If (obj Is ps.member) Then
      contains = True
      Exit Function
    Else
      Set ps = ps.nextNode
    End If
  Wend
  contains = False
End Function

'返回此列表中指定位置处的元素。
Public Function getExact(index As Integer) As Object
  If (index < 0 Or count = 0) Then
    Set getExact = Nothing
    Exit Function
  End If
  If (index = 0) Then
    Set getExact = getFirst()
    Exit Function
  End If
  If (index >= count) Then
     Set getExact = Nothing
     Exit Function
  End If
  Dim n As Integer
  Dim ps As Node
  Set ps = pHead
  n = 0
  While n < index
    Set ps = ps.nextNode
    n = n + 1
  Wend
  Set getExact = ps.member
End Function

'返回此列表的第一个元素。
Public Function getFirst() As Object
  If (count = 0) Then
    Set getFirst = Nothing
  Else
    Set getFirst = pHead.member
  End If
End Function

'返回此列表的最后一个元素。
Public Function getLast() As Object
  If (count = 0) Then
    Set getLast = Nothing
  Else
    Set getLast = pEnd.member
  End If
End Function

'返回此列表中首次出现的指定元素的索引(从0开始计数)，
'如果列表中不包含此元素，则返回 -1。
Public Function indexOf(obj As Object) As Integer
  Dim index As Integer
  Dim ps As Node
  index = 0
  Set ps = pHead
  While Not (ps Is Nothing)
    If (obj Is ps.member) Then
      indexOf = index
      Exit Function
    Else
      Set ps = ps.nextNode
      index = index + 1
    End If
  Wend
  indexOf = -1
End Function

'找到但不移除此列表的头（第一个元素）。
Public Function peek() As Object
  Set peek = getFirst
End Function

'找到并移除此列表的头（第一个元素）。
Public Function remove() As Object
On Error GoTo errHandle:
  If (count = 0) Then
    Set remove = Nothing
    Exit Function
  End If
  Set remove = pHead.member
  Set pHead = pHead.nextNode
  count = count - 1
  If (count = 0) Then
    Set pEnd = Nothing
  End If
  Exit Function
errHandle:
  Set remove = Nothing
End Function

'移除此列表中指定位置处的元素。
Public Function removeExact(index As Integer) As Object
On Error GoTo errHandle:
  If (count = 0 Or index < 0) Then
    Set removeExact = Nothing
    Exit Function
  ElseIf (index = 0) Then
    Set removeExact = remove
    Exit Function
  ElseIf (index = count - 1) Then
    Set removeExact = removeLast
    Exit Function
  ElseIf (index > count - 1) Then
    Set removeExact = Nothing
    Exit Function
  End If
 
  Dim ps As Node
  Dim n As Integer
  Set ps = pHead
  For n = 0 To index - 2
    Set ps = ps.nextNode
  Next
  Set removeExact = ps.nextNode.member
  Set ps.nextNode = ps.nextNode.nextNode
  count = count - 1
  Exit Function
errHandle:
  Set removeLast = Nothing
End Function

'找到并移除此列表的头（第一个元素）。
Public Function removeFirst() As Object
  Set removeFirst = remove
End Function

'移除此列表中首次出现的指定元素。
Public Function removeObject(obj As Object) As Boolean
On Error GoTo errHandle:
  Dim index As Integer
  index = indexOf(obj)
  If (index = -1) Then
    removeObject = False
    Exit Function
  Else
    Call removeExact(index)
    removeObject = True
  End If
  Exit Function
errHandle:
  removeObject = False
End Function

'移除并返回此列表的最后一个元素
Public Function removeLast() As Object
On Error GoTo errHandle:
  If (count = 0) Then
    Set removeLast = Nothing
    Exit Function
  ElseIf (count = 1) Then
    Set removeLast = pHead.member
    Set pHead = Nothing
    Set pEnd = Nothing
    count = 0
    Exit Function
  End If
  Dim ps As Node
  Dim n As Integer
  Set ps = pHead
  For n = 0 To count - 3
    Set ps = ps.nextNode
  Next
  Set removeLast = ps.nextNode.member
  Set pEnd = ps
  Set ps.nextNode = Nothing
  count = count - 1
  Exit Function
errHandle:
  Set removeLast = Nothing
End Function

'返回此列表的元素数。
Public Function size() As Integer
  size = count
End Function