前往小程序,Get更优阅读体验!
立即前往
首页
学习
活动
专区
工具
TVP
发布
社区首页 >专栏 >VBA解析复合文档07——Parse参数IReadWrite

VBA解析复合文档07——Parse参数IReadWrite

作者头像
xyj
发布2020-08-13 11:29:37
5550
发布2020-08-13 11:29:37
举报
文章被收录于专栏:VBA 学习

因为考虑到除了直接读取文件之外,还有可能直接传入一个已经读取好了的Byte数组,比如直接从2007版本以上的Excel中读取vbaProject.bin,所以定义了一个IReadWrite接口:

代码语言:javascript
复制
Function Read(b() As Byte) As Long

End Function
Function ReadByte() As Byte

End Function
Function ReadInteger() As Integer

End Function
Function ReadLong() As Long

End Function
Function ReadDate() As Date

End Function
'在offset处开始读取
Function ReadAt(b() As Byte, offset As Long) As Long

End Function

'设置读取的位置
Function SeekFile(offsetZeroBase As Long, whence As SeekPos) As Long

End Function

'写入文件
Function WriteFile(b() As Byte) As Long
    
End Function
Function WriteLong(l As Long) As Long
    
End Function

CFile类实现了这个接口,如果需要直接传入Byte数组,那么可以创建一个CBytes类,让这个类也实现IReadWrite接口:

代码语言:javascript
复制
Option Explicit

Implements IReadWrite

'下标为0的Byte数组
Private bSrc() As Byte
'当前读取的下标
Private pos As Long
'数组的长度
Private lLen As Long

'设置数据源
Property Let SetData(v() As Byte)
    bSrc = v
    lLen = UBound(bSrc) + 1
End Property
'获取数据源
Property Get GetData() As Byte()
    GetData = bSrc
End Property

Function Read(b() As Byte) As Long
    Dim i As Long
    Dim ilen As Long
    
    ilen = UBound(b) + 1
    If ilen + pos > lLen Then ilen = lLen + (lLen - pos)
    
    For i = 0 To ilen - 1
        b(i) = ReadByte()
    Next
    
    Read = ilen
End Function
Function ReadAt(b() As Byte, offset As Long) As Long
    pos = offset
    ReadAt = Read(b)
End Function
Function ReadByte() As Byte
    If pos >= lLen Then
        Exit Function
    End If
    
    ReadByte = bSrc(pos)
    pos = pos + 1
End Function
Function ReadInteger() As Integer
    Dim b1 As Byte, b2 As Byte
    
    b1 = ReadByte()
    b2 = ReadByte()
    
    ReadInteger = BitMoveLeftInt(VBA.CInt(b2), 8) Or VBA.CInt(b1)
End Function
Function ReadLong() As Long
    Dim l(4 - 1) As Long
    Dim i As Long
    
    For i = 0 To 4 - 1
        l(i) = VBA.CLng(ReadByte())
    Next
    
    ReadLong = BitMoveLeft(l(3), 3 * 8) Or BitMoveLeft(l(2), 2 * 8) Or BitMoveLeft(l(1), 1 * 8) Or l(0)
End Function

Function ReadDate() As Date
    Dim l(8 - 1) As Long
    Dim i As Long
    
    For i = 0 To 8 - 1
        l(i) = VBA.CLng(ReadByte())
    Next
    
    'TODO 待完成
    ReadDate = 0
End Function

Function SeekFile(offsetZeroBase As Long, whence As vbapIO.SeekPos) As Long
    If whence = SeekPos.OriginF Then
        pos = offsetZeroBase
    ElseIf whence = SeekPos.CurrentF Then
        pos = pos + offsetZeroBase
    Else
        pos = lLen - offsetZeroBase - 1
    End If
    
    SeekFile = pos
End Function
Function WriteFile(b() As Byte) As Long
    'TODO 待完成
End Function
Function WriteLong(l As Long) As Long
    'TODO 待完成
End Function

'实现接口
Private Function IReadWrite_Read(b() As Byte) As Long
    IReadWrite_Read = Read(b)
End Function
Private Function IReadWrite_ReadAt(b() As Byte, offset As Long) As Long
    IReadWrite_ReadAt = ReadAt(b, offset)
End Function
Private Function IReadWrite_ReadByte() As Byte
    IReadWrite_ReadByte = ReadByte()
End Function
Private Function IReadWrite_ReadDate() As Date
    IReadWrite_ReadDate = ReadDate()
End Function
Private Function IReadWrite_ReadInteger() As Integer
    IReadWrite_ReadInteger = ReadInteger()
End Function
Private Function IReadWrite_ReadLong() As Long
    IReadWrite_ReadLong = ReadLong()
End Function
Private Function IReadWrite_SeekFile(offsetZeroBase As Long, whence As vbapIO.SeekPos) As Long
    IReadWrite_SeekFile = SeekFile(offsetZeroBase, whence)
End Function
Private Function IReadWrite_WriteFile(b() As Byte) As Long
    IReadWrite_WriteFile = WriteFile(b)
End Function
Private Function IReadWrite_WriteLong(l As Long) As Long
    IReadWrite_WriteLong = WriteLong(l)
End Function

这样就算是直接读取好了的Bytes数组,也可以使用CBytes类作为参数传入Parse函数进行解析:

本文参与 腾讯云自媒体同步曝光计划,分享自微信公众号。
原始发表:2020-08-08,如有侵权请联系 cloudcommunity@tencent.com 删除

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

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

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

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