对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