首页
学习
活动
专区
工具
TVP
发布
社区首页 >专栏 >VBA编写Ribbon Custom UI编辑器08——实现ZIP的写入

VBA编写Ribbon Custom UI编辑器08——实现ZIP的写入

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

对Office文件的写入功能,因为并没有实现ZIP的压缩功能,程序只是将数据打包放入了ZIP中,customUI.xml并没有被压缩。

对ZIP文件的写入,涉及添加和替换2个功能,对外只公开添加功能,因为替换功能可以在内部判断是否存在文件,存在的情况下就使用替换功能,不存在的时候使用添加功能。

写入功能主要就是重写ZIP文件,只要清楚ZIP文件的结构,按文件结构的顺序逐个写入LocalFileHeader、数据流,然后写入全部的CentralDirectoryHeader以及最后的EndOfCentralDirectory:

对外公开的AddFile函数:

'添加一个文件到压缩包中
'FileName   需要添加的文件名称
'b          数据Byte数组
'Return     返回出错信息
Function AddFile(FileName As String, b() As Byte) As String
    '先检查是否存在同样的文件名称
    If dicFileName.Exists(FileName) Then
        '存在就替换
        ReplaceFile VBA.CLng(dicFileName.GetItem(FileName)), b
    Else
        '不存在就添加
        AddFileToZip FileName, b
        
        '添加到HashTable
        dicFileName.Add FileName, UBound(LFHs)
        
        ReDim Preserve FileArr(UBound(FileArr) + 1) As String
        FileArr(UBound(FileArr)) = FileName
    End If
    
End Function

真正的添加功能:

Private Function AddFileToZip(FileName As String, b() As Byte) As String
    Dim ilen As Long
    ilen = UBound(b) + 1
    
    Dim i As Long
    i = UBound(LFHs)
    '添加到最后面
    ReDim Preserve LFHs(i + 1) As LocalFileHeader
    ReDim Preserve CDHs(i + 1) As CentralDirectoryHeader
    
    i = i + 1
    LFHs(i) = LFHs(0)
    CDHs(i) = CDHs(0)
    
    '不管是添加或者替换都需要更新的字段信息
    updateData LFHs(i), CDHs(i), b
    
    '增加,需要更新的信息
    LFHs(i).FileName = FileName
    LFHs(i).bFileName = VBA.StrConv(FileName, vbFromUnicode)
    LFHs(i).FileNameLength = UBound(LFHs(i).bFileName) + 1
    LFHs(i).ExtraFieldLength = 0
    Erase LFHs(i).bExtraField
    
    CDHs(i).FileName = FileName
    CDHs(i).FileNameLength = LFHs(i).FileNameLength
    CDHs(i).ExtraFieldLength = LFHs(i).ExtraFieldLength
    CDHs(i).FileCommentLength = 0
    Erase CDHs(i).bExtraField, CDHs(i).bComment
    CDHs(i).LocalFileHeaderOffset = tEOCD.OffsetOfCD
    
    '在第一个CDH开始处写入新增加的LocalFileHeader
    cf.SeekFile tEOCD.OffsetOfCD, OriginF
    '第一个CDH的偏移要向后移动
    tEOCD.OffsetOfCD = tEOCD.OffsetOfCD + 30 + LFHs(i).FileNameLength + LFHs(i).ExtraFieldLength + LFHs(i).CompressedSize
    '更新EOCD的信息
    tEOCD.NumberOfCDRecordsOnThisDisk = i + 1
    tEOCD.TotalNumberOfCDRecords = i + 1
    tEOCD.SizeOfCD = tEOCD.SizeOfCD + 46 + CDHs(i).FileCommentLength + CDHs(i).FileNameLength + CDHs(i).ExtraFieldLength
    
    '写入LFH
    WriteLFH LFHs(i)
    '写入数据
    cf.WriteFile b
    '写入CDHs和EOCD
    WriteCDHs
End Function

替换功能:

Private Function ReplaceFile(FileIndex As String, b() As Byte) As String
    Dim i As Long
    Dim ilen As Long
    ilen = UBound(b) + 1
    
    Dim lOverOffset As Long '更新后的数据长度超过了多少
    lOverOffset = ilen - LFHs(FileIndex).CompressedSize
    
    '不管是添加或者替换都需要更新的字段信息
    updateData LFHs(FileIndex), CDHs(FileIndex), b
    
    Dim lOffset As Long
    '记录后面受到影响的数据
    Dim ds() As Datas
    
    
    If lOverOffset = 0 Then '修改后的大小和原来的一样,只需要改写FileIndex
        lOffset = CDHs(FileIndex).LocalFileHeaderOffset
    
        '写入LFH
        cf.SeekFile lOffset, OriginF
        WriteLFH LFHs(FileIndex)
        
        '写入数据
        cf.WriteFile b
    
        '写入CDH
        lOffset = tEOCD.OffsetOfCD
        '找到要修改的CDH
        For i = 0 To FileIndex - 1
            lOffset = lOffset + 46 + CDHs(i).FileNameLength + CDHs(i).ExtraFieldLength + CDHs(i).FileCommentLength
        Next
        cf.SeekFile lOffset, OriginF
        '写入CDH
        WriteCDH CDHs(FileIndex)

    
    ElseIf lOverOffset < 0 Then '文件变小了
        '读取所有数据,删除原文件,重新创建文件
        ReDim ds(UBound(FileArr)) As Datas
        For i = 0 To UBound(FileArr)
            If LFHs(i).CompressedSize > 0 Then
                '有些可能是目录,不需要记录
                getCompressedByteByIndex i, ds(i).b
            End If
            
            If i > FileIndex Then
                '修改CDHs中的偏移
                CDHs(i).LocalFileHeaderOffset = CDHs(i).LocalFileHeaderOffset + lOverOffset
            End If
        Next
        ds(FileIndex).b = b
        
        '修改EOCD
        tEOCD.OffsetOfCD = tEOCD.OffsetOfCD + lOverOffset
        
        '删除原文件
        cf.CloseFile
        VBA.Kill fn
        '重新创建文件
        cf.OpenFile fn, O_RDWR
        For i = 0 To UBound(FileArr)
            WriteLFH LFHs(i)
            cf.WriteFile ds(i).b
        Next
        
        '写入CDHs和EOCD
        WriteCDHs
        
    
    Else '文件变大了
        '要替换的数据超过了原来的范围,写入数据之前,把其他的数据都读取出来
        ReDim ds(UBound(FileArr)) As Datas
        For i = FileIndex + 1 To UBound(FileArr)
            If LFHs(i).CompressedSize > 0 Then
                '有些可能是目录,不需要记录
                getCompressedByteByIndex i, ds(i).b
            End If
            
            '修改CDHs中的偏移
             CDHs(i).LocalFileHeaderOffset = CDHs(i).LocalFileHeaderOffset + lOverOffset
        Next
        '现在需要修改的数据
        ds(FileIndex).b = b
        
        '修改EOCD中的偏移
        tEOCD.OffsetOfCD = tEOCD.OffsetOfCD + lOverOffset
        
        '从修改的文件的LFH开始写入
        lOffset = CDHs(FileIndex).LocalFileHeaderOffset
        cf.SeekFile lOffset, OriginF
        
        '写入修改的数据及受影响的数据
        For i = FileIndex To UBound(FileArr)
            '写入LFH
            WriteLFH LFHs(i)
            
            '写入数据
            If LFHs(i).CompressedSize > 0 Then
                cf.WriteFile ds(i).b
            End If
        Next
        
        '写入CDHs和EOCD
        WriteCDHs
    End If
    
End Function

其他函数:

'不管是添加或者替换都需要更新的字段信息
Private Function updateData(lfh As LocalFileHeader, cdh As CentralDirectoryHeader, b() As Byte) As Long
    Dim ilen As Long
    ilen = UBound(b) + 1
    
    lfh.CompressionMethod = 0
    lfh.CompressedSize = ilen
    lfh.UnZipSize = ilen

    Dim crc32 As CCRC
    Set crc32 = NewCCRC()
    lfh.CRC_32 = crc32.crc32(b)
    Set crc32 = Nothing
    
    cdh.CompressionMethod = lfh.CompressionMethod
    cdh.CompressedSize = lfh.CompressedSize
    cdh.UnZipSize = lfh.UnZipSize
    cdh.crc32 = lfh.CRC_32
End Function

'写入CentralDirectoryHeader
'CDHs是在EndOfCentralDirectory的前面的
'不管是增加还是替换,维护好CDHs,然后写入
Private Function WriteCDHs() As String
    Dim i As Long
    Dim b() As Byte
    
    For i = 0 To UBound(CDHs)
        WriteCDH CDHs(i)
    Next
    
    '写入EndOfCentralDirectory
    cf.WriteLong tEOCD.Signature
    cf.WriteInteger tEOCD.NumberOfThisDisk
    cf.WriteInteger tEOCD.DiskDirectoryStarts
    cf.WriteInteger tEOCD.NumberOfCDRecordsOnThisDisk
    cf.WriteInteger tEOCD.TotalNumberOfCDRecords
    cf.WriteLong tEOCD.SizeOfCD
    cf.WriteLong tEOCD.OffsetOfCD
    cf.WriteInteger tEOCD.CommentLength
    If tEOCD.CommentLength Then
        cf.WriteFile tEOCD.Comment
    End If
End Function

Private Function WriteCDH(cdh As CentralDirectoryHeader) As String
    cf.WriteLong cdh.Signature
    cf.WriteInteger cdh.VersionMadeBy
    cf.WriteInteger cdh.VersionNeeded
    cf.WriteInteger cdh.GeneralBitFlag
    cf.WriteInteger cdh.CompressionMethod
    cf.WriteInteger cdh.LastModifyTime
    cf.WriteInteger cdh.LastModifyDate
    cf.WriteLong cdh.crc32
    cf.WriteLong cdh.CompressedSize
    cf.WriteLong cdh.UnZipSize
    cf.WriteInteger cdh.FileNameLength
    cf.WriteInteger cdh.ExtraFieldLength
    cf.WriteInteger cdh.FileCommentLength
    cf.WriteInteger cdh.StartDiskNumber
    cf.WriteInteger cdh.InteralFileAttrib
    cf.WriteLong cdh.ExternalFileAttrib
    cf.WriteLong cdh.LocalFileHeaderOffset
    
    cf.WriteFile cdh.bFileName
    
    If cdh.ExtraFieldLength Then
        cf.WriteFile cdh.bExtraField
    End If
    
    If cdh.FileCommentLength Then
        cf.WriteFile cdh.bComment
    End If
End Function

Private Function WriteLFH(lfh As LocalFileHeader) As String
    Dim b() As Byte
    
    cf.WriteLong lfh.Signature
    cf.WriteInteger lfh.VersionExtract
    cf.WriteInteger lfh.GeneralBit
    cf.WriteInteger lfh.CompressionMethod
    cf.WriteInteger lfh.FileModiTime
    cf.WriteInteger lfh.FileModiDate
    cf.WriteLong lfh.CRC_32
    cf.WriteLong lfh.CompressedSize
    cf.WriteLong lfh.UnZipSize
    cf.WriteInteger lfh.FileNameLength
    cf.WriteInteger lfh.ExtraFieldLength

    cf.WriteFile lfh.bFileName
        
    If lfh.ExtraFieldLength Then
        cf.WriteFile lfh.bExtraField
    End If
End Function
本文参与 腾讯云自媒体分享计划,分享自微信公众号。
原始发表:2020-08-20,如有侵权请联系 cloudcommunity@tencent.com 删除

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

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

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

评论
登录后参与评论
0 条评论
热度
最新
推荐阅读
相关产品与服务
文件存储
文件存储(Cloud File Storage,CFS)为您提供安全可靠、可扩展的共享文件存储服务。文件存储可与腾讯云服务器、容器服务、批量计算等服务搭配使用,为多个计算节点提供容量和性能可弹性扩展的高性能共享存储。腾讯云文件存储的管理界面简单、易使用,可实现对现有应用的无缝集成;按实际用量付费,为您节约成本,简化 IT 运维工作。
领券
问题归档专栏文章快讯文章归档关键词归档开发者手册归档开发者手册 Section 归档