VBA解析VBAProject 03——解析dir流

在VBAProject中，dir流保存了一些VBA代码的重要信息，所以解析VBAProject的时候一并进行了解析。

dir流的结构请参考官方文档的2.3.4.2 dir Stream。

这里主要解析VBA模块的3个信息：

Public Enum ModuleTypeEnum
    ProceduralModule = &H21
    ClassModule = &H22 'document module, class module, or designer module
End Enum

Public Type ModuleInfo
    SName As String
    Offset As Long
    IType As ModuleTypeEnum
End Type

Offset：VBA代码在具体的模块流中起始的位置。

实现代码：

Function GetModuleInfo(DirBytes() As Byte, ret() As ModuleInfo) As String
    Dim iLen As Long
    Dim p As Long
    
    iLen = UBound(DirBytes) - LBound(DirBytes) + 1
    
'    type projectModules struct {
'        Id             int16 // 必须是0x000f
'        Size           int32 // 必须是 0x00000002
'        Count int16
'        Project_Cookie projectCookie // 8 bytes
'        //Modules
'    }
'    type projectCookie struct {
'        Id     int16 // 必须是0x0013
'        Size   int32 // 必须是 0x00000002
'        Cookie int16 // MUST be ignored on read. MUST be 0xFFFF on write
'    }

    
    Do While 1
        If DirBytes(p) = &HF And DirBytes(p + 1) = &H0 Then 'projectModules.Id = 0x000f
                
            If (DirBytes(p + 2) = &H2) And ((DirBytes(p + 3) Or DirBytes(p + 4) Or DirBytes(p + 5)) = &H0) Then 'projectModules.Size = 0x00000002
                
                If DirBytes(p + 8) = &H13 And DirBytes(p + 9) = &H0 Then 'projectCookie.Id = 0x0013
                    
                    If (DirBytes(p + 10) = &H2) And ((DirBytes(p + 11) Or DirBytes(p + 12) Or DirBytes(p + 13)) = &H0) Then 'projectModules.Size = 0x00000002
                        Exit Do
                    Else
                        GoTo pAdd
                    End If
                
                Else
                    GoTo pAdd
                End If
                
            Else
                GoTo pAdd
            End If 'projectModules.Size = 0x00000002
                
            
        Else 'projectModules.Id = 0x000f
pAdd:
            p = p + 1
            If p > iLen - 16 Then
                GetModuleInfo = "DIR流：不符合dir格式。"
                Exit Function
            End If
        End If
    Loop

    
    '模块数量
    Dim moduleCount As Integer
    moduleCount = Bytes2Int(DirBytes, p + 6)
    ReDim ret(moduleCount - 1) As ModuleInfo
    
    p = p + 16
    Dim i As Long, j As Long
    Dim ModuleNameLen As Long
    Dim ModuleName() As Byte
    For i = 0 To moduleCount - 1
'        type moduleName struct {
'            Id               int16 // 必须是0x0019
'            SizeOfModuleName int32
'            // Dim ModuleName() As Byte
'        }
        Do While Not (DirBytes(p) = &H19 And DirBytes(p + 1) = &H0)
            p = p + 1
            If p > iLen - 1 Then
                GetModuleInfo = "DIR流：解析moduleName出错了。"
                Exit Function
            End If
        Loop
        
        p = p + 2
        ModuleNameLen = Bytes2Long(DirBytes, p)
        p = p + 4
        p = p + ModuleNameLen
        
'        type moduleNameUnicode struct {
'            Id                      int16 // 必须是0x0047
'            SizeOfModuleNameUnicode int32
'            // Dim ModuleNameUnicode() As Byte
'        }
        
        p = p + 2
        ModuleNameLen = Bytes2Long(DirBytes, p)
        p = p + 4
        ReDim ModuleName(ModuleNameLen - 1) As Byte
        For j = 0 To ModuleNameLen - 1
            ModuleName(j) = DirBytes(p + j)
        Next
        p = p + ModuleNameLen

        ret(i).SName = ModuleName
        
'        type moduleStreamName struct {
'            Id               int16 // 必须是0x001A
'            SizeOfStreamName int32
'            // Dim StreamName() As Byte
'        }
        p = p + 2
        ModuleNameLen = Bytes2Long(DirBytes, p)
        p = p + 4
        p = p + ModuleNameLen


'        type moduleStreamNameUnicode struct {
'            Reserved int16
'            SizeOfStreamNameUnicode int32
'            // Dim StreamNameUnicode() As Byte
'        }
        p = p + 2
        ModuleNameLen = Bytes2Long(DirBytes, p)
        p = p + 4
        p = p + ModuleNameLen
        
'        type moduleStreamNameUnicode struct {
'            Reserved int16
'            SizeOfStreamNameUnicode int32
'            // Dim StreamNameUnicode() As Byte
'        }
        p = p + 2
        ModuleNameLen = Bytes2Long(DirBytes, p)
        p = p + 4
        p = p + ModuleNameLen

'        type moduleDocStringUnicode struct {
'            Reserved int16
'            SizeOfDocStringUnicode int32
'            // Dim DocStringUnicode() As Byte
'        }
        p = p + 2
        ModuleNameLen = Bytes2Long(DirBytes, p)
        p = p + 4
        p = p + ModuleNameLen
        
'        type moduleOffset struct {
'            Id         int16 // 必须是0x0031
'            Size int32
'            TextOffset int32
'        }
        p = p + 2
        ModuleNameLen = Bytes2Long(DirBytes, p)
        p = p + 4
        ret(i).Offset = Bytes2Long(DirBytes, p)
        p = p + 4
        
'        type moduleHelpContext struct {
'            Id          int16 // 必须是0x001E
'            Size int32
'            HelpContext int32
'        }
        p = p + 2
        p = p + 4
        p = p + 4
        
'        type moduleCookie struct {
'            Id     int16 // 必须是0x002C
'            Size   int32 // 必须是 0x00000002
'            Cookie int16 // MUST be 0xFFFF on write
'        }
        p = p + 2
        p = p + 4
        p = p + 2

'        type moduleType struct {
'            Id int16 //       '0x0021  procedural module
'            // '0x0022 document module, class module, or designer module
'            Reserved int32 //'必须是 0x00000000。必须忽略
'        }
        ret(i).IType = Bytes2Int(DirBytes, p)
        p = p + 2
        p = p + 4

    Next
End Function