VBA编写Ribbon Custom UI编辑器08——实现ZIP的写入
时间:2022-07-24
本文章向大家介绍VBA编写Ribbon Custom UI编辑器08——实现ZIP的写入,主要内容包括其使用实例、应用技巧、基本知识点总结和需要注意事项,具有一定的参考价值,需要的朋友可以参考一下。
对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
- python3编码问题终结者--还搞不懂你来找我
- Pycharm集成PyQt4并使用
- python遍历一个目录,输出所有文件名
- pyqt4实现tab界面切换
- 腾讯云Fintech云端系列论坛首站北京,揭秘如何全链路赋能互联网金融
- Flask入门笔记(一)
- 刷脸还是指纹识别,that's a question
- c#:使用using关键字自动释放资源未必一定就会有明显好处
- MongoDB 学习笔记(原创)
- Silverlight:ScorllViewer随Tab键自动跟随子控件的Focus滚动
- 老域名做新站如何能快速得上首页?
- Silverlight:分包下载及SEO优化方案
- jQuery调用RESTful WCF示例(GET方法/POST方法)
- "RDLC"报表-参数传递及主从报表
- JavaScript 教程
- JavaScript 编辑工具
- JavaScript 与HTML
- JavaScript 与Java
- JavaScript 数据结构
- JavaScript 基本数据类型
- JavaScript 特殊数据类型
- JavaScript 运算符
- JavaScript typeof 运算符
- JavaScript 表达式
- JavaScript 类型转换
- JavaScript 基本语法
- JavaScript 注释
- Javascript 基本处理流程
- Javascript 选择结构
- Javascript if 语句
- Javascript if 语句的嵌套
- Javascript switch 语句
- Javascript 循环结构
- Javascript 循环结构实例
- Javascript 跳转语句
- Javascript 控制语句总结
- Javascript 函数介绍
- Javascript 函数的定义
- Javascript 函数调用
- Javascript 几种特殊的函数
- JavaScript 内置函数简介
- Javascript eval() 函数
- Javascript isFinite() 函数
- Javascript isNaN() 函数
- parseInt() 与 parseFloat()
- escape() 与 unescape()
- Javascript 字符串介绍
- Javascript length属性
- javascript 字符串函数
- Javascript 日期对象简介
- Javascript 日期对象用途
- Date 对象属性和方法
- Javascript 数组是什么
- Javascript 创建数组
- Javascript 数组赋值与取值
- Javascript 数组属性和方法
- 用了这个jupyter插件,我已经半个月没打开过excel了
- vue接入腾讯地图(二)【标注&定位实战】
- 图像处理笔记(4)----OpenCV对象追踪
- MySQL 数据恢复
- 【从0到1学习边缘容器系列2】之 边缘应用管理
- 【从0到1学习边缘容器系列-3】应用容灾之边缘自治
- Hacking with iOS: SwiftUI Edition - 里程碑:项目 13 - 15
- HDU 1896 优先队列用法
- 蓝桥杯省内模拟赛C++
- C++ STL (标准模板库) 详细内容讲解
- 蓝桥杯 试题 基础练习 分解质因数
- 蓝桥杯 试题 基础练习 FJ的字符串
- 蓝桥杯 试题 基础练习 龟兔赛跑预测
- 问题 1432: [蓝桥杯][2013年第四届真题]剪格子
- 问题 1426: [蓝桥杯][历届试题]九宫重排