解压zip_VBA解压缩ZIP文件11——存在问题

最新推荐文章于 2021-01-15 02:14:01 发布

i山河已秋i

最新推荐文章于 2021-01-15 02:14:01 发布

阅读量376

点赞数

文章标签：解压zip

本文链接：https://blog.csdn.net/weixin_34451330/article/details/112708858

版权

解压功能实现了，但是还是存在问题的：

1、速度慢！本人电脑测试解压一个12M文件，用时70秒左右！
2、内存释放有问题。
3、碰上压缩文件中有太大的文件的话，内存申请肯定会有问题，因为程序是把压缩数据、解压后数据直接存储在内存中的。
4、如果压缩文件中有超过2G的，会溢出Long类型，文件读取也会出问题

第2个问题是因为Huffman树的节点使用的是类模块，在内存释放上有点问题，目前没找到原因。

尝试使用数组去处理，测试内存释放应该是正常了，另外速度也提升了，12M文件，用时38秒左右！

使用数组记录节点的Huffman类模块：

Private Type Node    Weight As Long    Left As Long    Right As Long    Key As Long    Parent As LongEnd TypePrivate Nodes() As NodePrivate pNode As Long'树的root节点Private root As LongPrivate Const NULL_VALUE As Long = &H80000000'创建树结构Public Function Create(WeightValues() As Long, Keys() As Long) As Long    Dim inum As Long    inum = UBound(Keys)        InsertSort WeightValues, Keys, 0, inum    '节点的个数不会超过一颗最大层次的完整的2叉树    ReDim Nodes(2 ^ WeightValues(inum) * 2 - 1) As Node        root = NewNode(0, NULL_VALUE, NULL_VALUE, NULL_VALUE)        Dim parr As Long    Dim tmp As Long        Dim n As Long    n = root        Do Until parr = inum + 1            Do Until Nodes(n).Key = WeightValues(parr)            If Nodes(n).Weight = 2 Then                '新建左子树                tmp = NewNode(Nodes(n).Key + 1, NULL_VALUE, NULL_VALUE, n)                Nodes(n).Left = tmp                Nodes(n).Weight = Nodes(n).Weight - 1                n = tmp                            ElseIf Nodes(n).Weight = 1 Then                '新建右子树                tmp = NewNode(Nodes(n).Key + 1, NULL_VALUE, NULL_VALUE, n)                Nodes(n).Right = tmp                Nodes(n).Weight = Nodes(n).Weight - 1                n = tmp                            Else '= 0                n = Nodes(n).Parent            End If                    Loop        Nodes(n).Key = Keys(parr)        parr = parr + 1        n = Nodes(n).Parent    Loop    End Function'找到叶子节点的Key'从bitIndex位置，逐个读取cpByte中的Bit，直到叶子节点Function GetLeafKey(cpByte() As Byte, ByRef bitIndex As Long) As Long    Dim bValue As Long    Dim n As Long    n = root        'HuffmanTree里把叶子节点的Weight设置成了2    Do Until Nodes(n).Weight = 2        '逐个bit的去h中查找，到达叶子节点为止        bValue = GetBit(cpByte, bitIndex)        bitIndex = bitIndex + 1        '1的时候右        If bValue Then            n = Nodes(n).Right        Else            n = Nodes(n).Left        End If    Loop        GetLeafKey = Nodes(n).Key    End FunctionPrivate Function InsertSort(WeightValues() As Long, Keys() As Long, Low As Long, High As Long)    Dim i As Long, j As Long    Dim ShaoBing As Long, ShaoBing_tmp As Long        '先按arr_code_len排序    For i = Low + 1 To High        If WeightValues(i) < WeightValues(i - 1) Then            ShaoBing = WeightValues(i)             '设置哨兵            ShaoBing_tmp = Keys(i)                        j = i - 1            Do While WeightValues(j) > ShaoBing                WeightValues(j + 1) = WeightValues(j)                Keys(j + 1) = Keys(j)                j = j - 1                If j = Low - 1 Then Exit Do            Loop                        WeightValues(j + 1) = ShaoBing            Keys(j + 1) = ShaoBing_tmp        End If    Next iEnd Function'返回数组的下标Private Function NewNode(Key As Long, Left As Long, Right As Long, Parent As Long) As Long    Nodes(pNode).Weight = 2    Nodes(pNode).Key = Key        Nodes(pNode).Left = Left    Nodes(pNode).Right = Right    Nodes(pNode).Parent = Parent        NewNode = pNode    pNode = pNode + 1End FunctionPublic Sub PrintOut()    RPrintOut root, ""End SubPrivate Function RPrintOut(n As Long, str As String)    If Nodes(n).Weight = 2 Then        Debug.Print str, Nodes(n).Key                Exit Function    Else        RPrintOut Nodes(n).Left, str & "0"        RPrintOut Nodes(n).Right, str & "1"    End IfEnd FunctionPrivate Sub Class_Terminate()    Erase NodesEnd Sub

问题3和问题4因为一般应该也碰不到，真有那么大的问题，也不至于用VBA来解压！暂时就不想着去解决了。

在微信公众号回复zip获取完整代码。