【算法】VB6实现哈夫曼编码生成的类

有问题的话，欢迎留言。

类文件代码如下：

Private ContentString As String
Private ItemCount As Long
Private Nodes() As Node
Private Type Node
    preID As Long
    
    leftID As Long
    leftValue As Long
    
    rightID As Long
    rightValue As Long
    
    selfValue As Long
    selfContent As Integer
    
    visited As Integer
    binCode As Integer
End Type
Public Function Retrace(ByVal i As Long) As String
    Dim rStr As String
    Dim nP As Long 'now pointer
    Dim lastID As Long
    Dim c As Integer
   
    nP = getStartID(i)
    c = Nodes(nP).visited
    Do
        lastID = nP
        nP = Nodes(lastID).preID
        If Nodes(nP).leftID = lastID Then
            rStr = "0" & rStr
        ElseIf Nodes(nP).rightID = lastID Then
            rStr = "1" & rStr
        End If
        c = Nodes(nP).visited
    Loop While c <> 2
    Retrace = rStr
End Function
Public Function ShowTable() As String
    Dim i As Long
    Dim outStr As String
    For i = 1 To ItemCount
        If Nodes(i).selfContent = -1 Then
        Else
            outStr = outStr & "Char:" & Chr(Nodes(i).selfContent) & " Code:" & Retrace(Nodes(i).selfContent) & vbCrLf
        End If
    Next i
    ShowTable = outStr
End Function
Private Function getStartID(ByVal k As Integer)
    Dim i As Long
    For i = 1 To ItemCount
        If Nodes(i).selfContent = k Then
            getStartID = i
            Exit Function
        End If
    Next i
    getStartID = 0
End Function
Public Sub SetString(ByVal srcString As String)
    ContentString = srcString
End Sub

Public Function CreatHuffmanString()
    Dim minID1 As Long, minID2 As Long
    Call ScanString(ContentString)
    Do While CountNodes > 1
        minID1 = GetMin
        Nodes(minID1).visited = 1
        minID2 = GetMin
        Nodes(minID2).visited = 1
        'Stop
        'mark two of them as walked points
        ItemCount = ItemCount + 1
        'add point
        ReDim Preserve Nodes(ItemCount)
        'add information
        Nodes(ItemCount).leftID = minID1
        Nodes(ItemCount).leftValue = Nodes(minID1).selfValue
        Nodes(ItemCount).rightID = minID2
        Nodes(ItemCount).rightValue = Nodes(minID2).selfValue
        Nodes(ItemCount).selfContent = -1 '因为这个是创建的节点
        Nodes(ItemCount).selfValue = Nodes(ItemCount).leftValue + Nodes(ItemCount).rightValue
        Nodes(ItemCount).visited = 0
        'modify min1 and min2
        Nodes(minID1).preID = ItemCount
        Nodes(minID2).preID = ItemCount
        Debug.Print "ItemCount:" & ItemCount
        Debug.Print "Count Unvisited Nodes:" & CountNodes
        '
    Loop
    Debug.Print "ItemCount=" & ItemCount & "  GetFirstUnvisitID=" & GetFirstUnvisitID
    Nodes(GetFirstUnvisitID).visited = 2 '表示这个是最终节点
End Function
Private Sub ScanString(ByRef strContent As String)
    Dim i As Long
    Dim k() As Byte
    Dim s(255) As Long
    k = StrConv(strContent, vbFromUnicode)
    For i = 0 To UBound(k)
        s(k(i)) = s(k(i)) + 1
    Next i
    For i = 0 To 255
        If s(i) > 0 Then
            ItemCount = ItemCount + 1
            ReDim Preserve Nodes(ItemCount)
            Nodes(ItemCount).selfContent = i 'i是Ascii码，所以也是自己的信息
            Nodes(ItemCount).selfValue = s(i) '这里是重复次数，也就是权重
            Nodes(ItemCount).visited = 0 '初次创建，设置为未访问过
            Debug.Print "Ascii:" & i & " Weight:" & s(i)
        End If
    Next i
End Sub
Private Sub ByteFilter(ByRef j() As Byte)
    Dim i As Long
    Dim k As Long
    For k = 0 To UBound(j)
        
    Next k

End Sub
Private Function GetMin() As Long '没问题
    Dim i As Long
    Dim minValue As Long, minID As Long, visTime As Long
    minValue = GetFirstUnvisitValue + 1
    minID = GetFirstUnvisitID
    For i = 1 To ItemCount
        If Nodes(i).selfValue < minValue And Nodes(i).visited = 0 Then
            minValue = Nodes(i).selfValue
            minID = i
            visTime = visTime + 1 '记录可以访问的次数
        End If
    Next i
    If visTime = 0 Then
        GetMin = -1
        Exit Function
    End If
    GetMin = minID
    Debug.Print "getmin:" & GetMin
End Function
Private Function GetFirstUnvisitValue()
    Dim i As Long
    For i = 1 To ItemCount
        If Nodes(i).visited = 0 Then
            GetFirstUnvisitValue = Nodes(i).selfValue
            Exit Function
        End If
    Next i
    GetFirstUnvisitValue = -1
End Function
Private Function GetFirstUnvisitID()
    Dim i As Long
    For i = 1 To ItemCount
        If Nodes(i).visited = 0 Then
            GetFirstUnvisitID = i
            Exit Function
        End If
    Next i
    GetFirstUnvisitID = 0
End Function
Private Function CountNodes() 'return all avaliable nodes
    Dim i As Long
    Dim lngCount As Long
    If ItemCount < 1 Then CountNodes = 0: Exit Function
    For i = 1 To ItemCount
        If Nodes(i).visited = 0 Then
            lngCount = lngCount + 1
        End If
    Next i
    CountNodes = lngCount
End Function
Private Sub Class_Initialize()
    ItemCount = 0
    ReDim Nodes(ItemCount)
End Sub
Public Sub InitHuffman()
    ItemCount = 0
    ContentString = ""
    ReDim Nodes(ItemCount)
End Sub