首页
学习
活动
专区
圈层
工具
发布
首页
学习
活动
专区
圈层
工具
MCP广场
社区首页 >专栏 >VBA解析复合文档06——改写数据流

VBA解析复合文档06——改写数据流

作者头像
xyj
发布2020-08-10 09:52:34
发布2020-08-10 09:52:34
69300
代码可运行
举报
文章被收录于专栏:VBA 学习VBA 学习
运行总次数:0
代码可运行

改写数据流和读取是类似的,只需要逐个扇区去处理就可以,需要注意的是,如果改写的数据长度比原来的数据长度变大了,这时候要注意是否会超越扇区的边界,如果超过了,那么就得改变文件的长度,处理起来就会很麻烦了,这种情况暂时就不进行改写。

代码语言:javascript
代码运行次数:0
运行
复制
'改写数据流
'dir_name   需要被改写的文件名称,是复合文档中的文件名称
'WriteBytes 需要改写为的数据Byte数组
'Return     返回出错信息
Function ReWriteStream(dir_name As String, WriteBytes() As Byte) As String
    If cf.h.Exists(dir_name) Then
        ReWriteStream = ReWriteStreamByDirIndex(VBA.CLng(cf.h.GetItem(dir_name)), WriteBytes)
    Else
        ReWriteStream = "复合文档:不存在的目录"
        Exit Function
    End If
End Function

Private Function ReWriteStreamByDirIndex(dirIndex As Long, WriteBytes() As Byte) As String
    '1仓storage 2流 5根
    If cf.ArrDir(dirIndex).ObjectType <> 2 Then
        ReWriteStreamByDirIndex = "复合文档:不是数据流"
        Exit Function
    End If
    If cf.ArrDir(dirIndex).StartingSectorID = Free_SID Then
        ReWriteStreamByDirIndex = "复合文档:流的大小为0"
        Exit Function
    End If
    
    Dim ilen As Long
    ilen = UBound(WriteBytes) + 1
    
    If cf.ArrDir(dirIndex).StreamSize < cf.Header.MiniStreamSize Then
        ReWriteStreamByDirIndex = ReWriteStreamMiniFAT(dirIndex, WriteBytes)
    Else
        ReWriteStreamByDirIndex = ReWriteStreamFAT(dirIndex, WriteBytes)
    End If
    
    '改写目录stream_size
    cf.ArrDir(dirIndex).StreamSize = ilen
    cf.r.SeekFile cf.ArrDir(dirIndex).lOffset + DIR_SIZE - 8, OriginF
    cf.r.WriteLong ilen
End Function

Private Function ReWriteStreamMiniFAT(dirIndex As Long, WriteBytes() As Byte) As String
    Dim ilen As Long
    ilen = UBound(WriteBytes) + 1
    
    '如果改写的数据超过了原来的范围,并且超越了扇区,需要报错
    If ilen > cf.ArrDir(dirIndex).StreamSize Then
        If ilen \ cf.lShortSectorSize > cf.ArrDir(dirIndex).StreamSize \ cf.lShortSectorSize Then
            ReWriteStreamMiniFAT = "复合文档:改写的数据超过了原来的范围,并且超越了扇区"
            Exit Function
        End If
    End If
    
    Dim b() As Byte
    ReDim b(cf.lShortSectorSize - 1) As Byte
    
    '找到改写开始的位置
    Dim miniSID As Long
    miniSID = cf.ArrDir(dirIndex).StartingSectorID
    
    Dim i As Long
    Dim p As Long
    
    Do Until miniSID = End_Of_Chain_SID
        '设置改写的位置
        cf.r.SeekFile getOffsetByMiniFATSID(miniSID), OriginF
        
        cf.r.Read b
        For i = 0 To cf.lShortSectorSize - 1
            b(i) = WriteBytes(p)
            p = p + 1
            
            If p = ilen Then
                ReDim Preserve b(p Mod cf.lShortSectorSize - 1) As Byte
                cf.r.WriteFile b
                Exit Function
            End If
        Next
        cf.r.WriteFile b
        
        '下一个扇区
        miniSID = cf.MiniFAT(miniSID)
    Loop
End Function

Private Function ReWriteStreamFAT(dirIndex As Long, WriteBytes() As Byte) As String
    Dim ilen As Long
    ilen = UBound(WriteBytes) + 1
    
    '如果改写的数据超过了原来的范围,并且超越了扇区,需要报错
    If ilen > cf.ArrDir(dirIndex).StreamSize Then
        If ilen \ cf.lSectorSize > cf.ArrDir(dirIndex).StreamSize \ cf.lSectorSize Then
            ReWriteStreamFAT = "复合文档:改写的数据超过了原来的范围,并且超越了扇区"
            Exit Function
        End If
    End If
    
    '找到改写开始的位置
    Dim sid As Long
    sid = cf.ArrDir(dirIndex).StartingSectorID
    
    Dim i As Long
    Dim p As Long
    Dim b() As Byte
    ReDim b(cf.lSectorSize - 1) As Byte
    
    Do
        '设置改写的位置
        cf.r.SeekFile getOffsetBySID(sid), OriginF
        
        For i = 0 To cf.lSectorSize - 1
            b(i) = WriteBytes(p)
            p = p + 1
            
            If p = ilen Then
                ReDim Preserve b(p Mod cf.lSectorSize - 1) As Byte
                cf.r.WriteFile b
                Exit Function
            End If
        Next
        cf.r.WriteFile b

        '下一个扇区
        sid = cf.FAT(sid)
    Loop
End Function
本文参与 腾讯云自媒体同步曝光计划,分享自微信公众号。
原始发表:2020-08-07,如有侵权请联系 cloudcommunity@tencent.com 删除

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

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

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

评论
登录后参与评论
0 条评论
热度
最新
推荐阅读
领券
问题归档专栏文章快讯文章归档关键词归档开发者手册归档开发者手册 Section 归档