前往小程序,Get更优阅读体验!
立即前往
首页
学习
活动
专区
工具
TVP
发布
社区首页 >专栏 >VBA解压缩ZIP文件11——存在问题

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

作者头像
xyj
发布2020-08-04 16:26:40
7090
发布2020-08-04 16:26:40
举报
文章被收录于专栏:VBA 学习VBA 学习VBA 学习

解压功能实现了,但是还是存在问题的:

  • 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 Long
End Type

Private Nodes() As Node
Private pNode As Long
'树的root节点
Private root As Long

Private 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 Function

Private 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 i

End 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 + 1
End Function


Public Sub PrintOut()
    RPrintOut root, ""
End Sub

Private 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 If
End Function

Private Sub Class_Terminate()
    Erase Nodes
End Sub

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

本文参与 腾讯云自媒体分享计划,分享自微信公众号。
原始发表:2020-07-31,如有侵权请联系 cloudcommunity@tencent.com 删除

本文分享自 VBA 学习 微信公众号,前往查看

如有侵权,请联系 cloudcommunity@tencent.com 删除。

本文参与 腾讯云自媒体分享计划  ,欢迎热爱写作的你一起参与!

评论
登录后参与评论
0 条评论
热度
最新
推荐阅读
领券
问题归档专栏文章快讯文章归档关键词归档开发者手册归档开发者手册 Section 归档