VBA解压缩ZIP文件03——解压准备工作

时间:2022-07-22
本文章向大家介绍VBA解压缩ZIP文件03——解压准备工作,主要内容包括其使用实例、应用技巧、基本知识点总结和需要注意事项,具有一定的参考价值,需要的朋友可以参考一下。

要解压缩ZIP文件,所以肯定需要读写文件的功能,为了方便,把VBA中对文件的读写功能进行一个简单的封装,方便使用。

ZIP文件压缩后,保存数据使用的最小单位是bit,注意不是Byte,计算机的1Byte=8bit,正常在VBA中操作的最小单位是Byte,为了方便读取bit位的数据,写几个简单的函数。

01

CFile文件读写

主要是使用类模块对文件操作Open、Put、Get等关键字的简单封装,这样使用起来就更加的方便。

Public Enum OpenAccess
    O_RDONLY
    O_WRONLY
    O_RDWR
End Enum

Public Enum SeekPos
    OriginF
    CurrentF
    EndF
End Enum

'注意大文件long类型会溢出
Private lFileLen As Long
Private num_file As Integer

'写入文件
Function WriteFile(b() As Byte) As Long
    Put #num_file, , b
End Function

'读取len(b)个byte
Function Read(b() As Byte) As Long
    Dim ilen As Long
    ilen = UBound(b) - LBound(b) + 1

    Dim iseek As Long
    iseek = VBA.Seek(num_file)
    If iseek + ilen > lFileLen Then
        ilen = lFileLen - iseek + 1
    End If

    Get #num_file, , b

    Read = ilen
End Function
'读取一个2Byte的整数
Function ReadInteger() As Integer
    Dim i As Integer
    Get #num_file, , i
    ReadInteger = i
End Function
'读取1个4Byte的整数
Function ReadLong() As Long
    Dim i As Long
    Get #num_file, , i
    ReadLong = i
End Function

'在offset处开始读取
Function ReadAt(b() As Byte, offset As Long) As Long
    SeekFile offset, 0
    ReadAt = Read(b)
End Function

'设置读取的位置
Function SeekFile(offset As Long, whence As SeekPos) As Long
    Dim iseek As Long
    iseek = VBA.Seek(num_file)

    'vba Seek是下标1开始
    If whence = SeekPos.OriginF Then
        iseek = 1 + offset
    ElseIf whence = SeekPos.CurrentF Then
        iseek = iseek + offset
    Else
        iseek = 1 + lFileLen - offset
    End If

    Seek #num_file, iseek

    SeekFile = iseek
End Function

'以字节方式读取文本
Function OpenFile(Filename As String, Optional m As OpenAccess = OpenAccess.O_RDWR) As Long
    '避免多次调用OpenFile的时候,前面的文件未关闭
    If num_file Then Close #num_file

    num_file = VBA.FreeFile

    Select Case m
        Case OpenAccess.O_RDONLY
        Open Filename For Binary Access Read As #num_file

        Case OpenAccess.O_WRONLY
        Open Filename For Binary Access Write As #num_file

        Case OpenAccess.O_RDWR
        Open Filename For Binary Access Read Write As #num_file

        Case Else

    End Select


    lFileLen = VBA.FileLen(Filename)
End Function

Function CloseFile()
    Close #num_file
End Function

Private Sub Class_Terminate()
    CloseFile
End Sub

02

bit位操作

计算机中1Byte=8bit,bit的排列顺序和数学中的个位、十位、百位……是一样的:

解压ZIP的过程中,需要不停的从压缩数据的Byte数组中读取需要的bit,实现几个简单的函数:

'取某一位的Bit
Function GetBitFromByte(b As Byte, ZeroBaseIndex As Long) As Long
    GetBitFromByte = VBA.CLng(b) And (2 ^ ZeroBaseIndex)
    If GetBitFromByte > 0 Then
        GetBitFromByte = 1
    Else
        GetBitFromByte = 0
    End If
End Function
'从Byte数组中取某一位的Bit
Function GetBit(b() As Byte, ZeroBaseIndex As Long) As Long
    '数组b中,开始的下标
    Dim bindex As Long
    bindex = ZeroBaseIndex  8

    GetBit = VBA.CLng(b(bindex)) And (2 ^ (ZeroBaseIndex Mod 8))
    If GetBit > 0 Then
        GetBit = 1
    Else
        GetBit = 0
    End If
End Function
'从Byte数组中取多位bit
' 0000 0000     0000 0000
' 7654 3210     fedc ba98
Function GetBits(b() As Byte, IndexFromZeroBase As Long, iBits As Long) As Long
    Dim i As Long
    Dim tmp As Long

    For i = 0 To iBits - 1
        tmp = GetBit(b, IndexFromZeroBase + i)
        tmp = BitMoveLeft(tmp, i)
        GetBits = GetBits Or tmp
    Next
End Function

'左移
Function BitMoveLeft(ByRef l As Long, num As Long) As Long
    Dim i As Long
    For i = 1 To num
        '会溢出 0x7FFF FFFF
        '判断第31位是否=1
        '不管等不等于1都把第31为置换为0,负数待处理
        l = l And &H3FFFFFFF
        l = l * 2
    Next

    BitMoveLeft = l
End Function

'右移
Function BitMoveRight(ByRef l As Long, num As Long) As Long
    Dim i As Long
    For i = 1 To num
        l = l  2
    Next

    BitMoveRight = l
End Function
'从Byte数组中取多位bit
'取出后的bit存储顺序倒置
Function GetBitsRev(b() As Byte, IndexFromZeroBase As Long, iBits As Long) As Long
    Dim i As Long
    Dim tmp As Long

    For i = 0 To iBits - 1
        tmp = GetBit(b, IndexFromZeroBase + i)
        tmp = BitMoveLeft(tmp, iBits - i - 1)
        GetBitsRev = GetBitsRev Or tmp
    Next
End Function