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
- java学习之第五章编程题示例(初学篇)
- java第四章编程题(初学篇)
- java测试Unicode编码以及数组的运用(初学篇)
- HDUOJ---1754 Minimum Inversion Number (单点更新之求逆序数)
- HDUOJ-------1753大明A+B(大数之小数加法)
- HDUOJ---1754 I Hate It (线段树之单点更新查区间最大值)
- HDUOJ----1166敌兵布阵(线段树单点更新)
- poj----2155 Matrix(二维树状数组第二类)
- poj------2352 Stars(树状数组)
- HDUOJ-----2852 KiKi's K-Number(树状数组+二分)
- nyoj----522 Interval (简单树状数组)
- HDUOJ-----2838Cow Sorting(组合树状数组)
- HDUOJ---2642Stars(二维树状数组)
- HDUOJ -----Color the ball
- 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 数组属性和方法
- Android中WebView的基本配置与填坑记录大全
- Android开发实现ListView异步加载数据的方法详解
- Android开发实现AlertDialog中View的控件设置监听功能分析
- 详解Android 语音播报实现方案(无SDK)
- Android实现中轴旋转特效 Android制作别样的图片浏览器
- Android使用DrawerLayout实现双向侧滑菜单
- Android实现3D推拉门式滑动菜单源码解析
- Android编程处理窗口控件大小,形状,像素等UI元素工具类
- Android开发实现的Log统一管理类
- Android中可以作为Log开关的一些操作及安全性详解
- 实例详解Android Webview拦截ajax请求
- Android给布局、控件加阴影效果的示例代码
- XListView实现下拉刷新和上拉加载原理解析
- Android实现QQ侧滑(删除、置顶等)功能
- Android通过XListView实现上拉加载下拉刷新功能