新人第一帖,赚点分[Vb_RES 文档解析]

[土豆赛叩]

解析 vb生成的 RES文档 目前代码已解析完毕。 居然没法上传附件？？？？


作者:繁华过后

Option Explicit
                                                                 
Const RT_STRING = 6
Const RT_VERSION = 16
Const RT_MENU = 4
Const RT_ICON = 3
Const RT_HTML = 23
Const RT_FONTDIR = 7
Const RT_FONT = 8
Const RT_DIALOG = 5
Const RT_CURSOR = 1
Const RT_BITMAP = 2
Const RT_ANICURSOR = 21
Const RT_GROUP_CURSOR = 12
Const RT_GROUP_ICON = 14
Const RT_UNKNOWN = 0
Private Type RESOURCEHEADER
    DataSizeas     As Long
    HeaderSizeas   As Long
    ResTypeas      As Variant                                                   ' [Ordinal or name TYPE];
    ResNameas      As Variant                                                   '需要说明的就是这里的Type和Name，有可能是一个字符串，也有可能是一个双字节整型，所以用Variant[Ordinal or name NAME];
    DataVersionas  As Long
    MemoryFlagsas  As Integer
    LanguageIdas   As Integer
    Versionas      As Long
    Characteristicsas  As Long
    ResData()      As Byte                                                      '这是具体的数据，可以留给后续处理时使用，仅当DataSize<>0时才有
End Type
Dim Memory()       As Byte

Rem 参考资料 http://blog.csdn.net/unsigned/article/details/3305830
Rem 参考资料 http://msdn.microsoft.com/en-us/library/ms648009(VS.85).aspx
Rem 参考资料 http://bbs.csdn.net/topics/70112100

Rem 字符串表
Rem 编号相连的多个字符串会放入一个表内



Private Sub Command1_Click()
    Rem 当前地址指针
    Dim Index          As Long
    Rem 当前项开始的地址
    Dim BaseAddr         As Long
    Rem 数据大小
    Dim DataSizeas       As Long
    Rem 资源头大小
    Dim HeaderSizeas     As Long
    Rem 判断用 resname 和 restype 是字符串 还是 数值
    Dim ResNameJ          As Integer
    Dim ResTypeJ          As Integer
    Rem 储存 resname 和 restype 的数值
    Dim ResType            As Integer
    Dim ResName            As Integer
    Rem 储存 resname 和 restype 的字符串
    Dim lpResName         As String
    Dim lpResType         As String
    Rem 资源的附加信息
    Dim DataVersionas  As Long
    Dim MemoryFlagsas    As Integer
    Dim LanguageIdas    As Integer
    Dim Versionas         As Long
    Dim Characteristicsas     As Long
    Rem 字符串 解析相关
    Dim lStrStart As Long, lChr As Integer
    Dim ChrLength As Long, DataLength As Long
    Dim lStr As String
    DataLength = UBound(Memory()) + 1
    List1.Clear
    Rem  前面有一个 32字节的空结构
    Index = &H20
    Do
        Rem 清空变量
        ResType = 0
        ResName = 0
        Rem 是否完成？
        If Index + 4 >= DataLength Then
            Exit Do
        End If
        Rem 保存该结构地址 供 读取数据用
        BaseAddr = Index
        Rem 读取数据大小 头大小(包括 DataSizeas 和 HeaderSizeas)
        CopyMemory DataSizeas, Memory(Index), 4: Index = Index + 4
        CopyMemory HeaderSizeas, Memory(Index), 4: Index = Index + 4
        Rem 读取文件 Type解析
        CopyMemory ResTypeJ, Memory(Index), 2: Index = Index + 2
        Rem 解析 RES_Type 和 RES_Name
        Select Case ResTypeJ
            Case -1
                Rem 如果为-1 那么说明 后面跟着数值型 ResType
                CopyMemory ResType, Memory(Index), 2: Index = Index + 2
                CopyMemory ResNameJ, Memory(Index), 2: Index = Index + 2
                Rem 用同样的方法获取 RES_NAME
                If ResNameJ = -1 Then
                    CopyMemory ResName, Memory(Index), 2: Index = Index + 2
                    lpResName = CStr(ResName)
                Else
                    lStrStart = Index
                    Rem 解析 Name
                    Do
                        CopyMemory lChr, Memory(Index), 2: Index = Index + 2
                        If lChr = 0 Then
                            Rem 0为字符串结束符
                            ChrLength = Index - lStrStart - 2
                            lStr = Space(ChrLength / 2)
                            CopyMemory ByVal StrPtr(lStr), Memory(lStrStart), ChrLength
                            lpResName = lStr
                            Exit Do
                        End If
                    Loop
                End If
                lpResType = CStr(ResType)
            Case Else
                Rem 如果不为-1那么说明 后面跟着 UniCode 字符串
                Rem 解析 Type
                lStrStart = Index - 2
                Do
                    CopyMemory lChr, Memory(Index), 2: Index = Index + 2
                    If lChr = 0 Then
                        Rem 0为字符串结束符
                        ChrLength = Index - lStrStart - 2
                        lStr = Space(ChrLength / 2)
                        CopyMemory ByVal StrPtr(lStr), Memory(lStrStart), ChrLength
                        lpResType = lStr
                        Exit Do
                    End If
                Loop
                Rem 解析 Res_Name 类型
                CopyMemory ResNameJ, Memory(Index), 2: Index = Index + 2
                If ResNameJ = -1 Then
                    CopyMemory ResName, Memory(Index), 2: Index = Index + 2
                    lpResName = CStr(ResName)
                Else
                    lStrStart = Index - 2
                    Rem 解析 Name
                    Do
                        CopyMemory lChr, Memory(Index), 2: Index = Index + 2
                        If lChr = 0 Then
                            ChrLength = Index - lStrStart - 2
                            lStr = Space(ChrLength / 2)
                            CopyMemory ByVal StrPtr(lStr), Memory(lStrStart), ChrLength
                            lpResName = lStr
                            Exit Do
                        End If
                    Loop
                End If
        End Select
        If (ResType + ResName) Mod 4 <> 0 Then
            Rem 如果 (ResType + ResName) Mod 4 <> 0(看网上资料说 如果不为0  那只能是2) 则附加2字节信息
            Index = Index + 2
        End If
        Rem  读取相关信息
        CopyMemory DataVersionas, Memory(Index), 4: Index = Index + 4
        CopyMemory MemoryFlagsas, Memory(Index), 2: Index = Index + 2
        CopyMemory LanguageIdas, Memory(Index), 2: Index = Index + 2
        CopyMemory Versionas, Memory(Index), 4: Index = Index + 4
        CopyMemory Characteristicsas, Memory(Index), 4: Index = Index + 4
        Rem  计算上 资源的数据长度(下个资源地址  = 这个资源地址 + 头长度 + 数据长度)
        Index = BaseAddr + DataSizeas + HeaderSizeas
        Rem 4字节对齐？
        Dim IntEx As Long
        IntEx = Index \ 4
        IntEx = IntEx * 4
        Rem Vb的 CUSTOM 等自定义资源类型 可能是因为对齐原因吧 多了四个字节
        Rem Rc 编译的 自动4字节对齐了
        If Index <> IntEx Then
            Index = IntEx
            Index = Index + 4
        Else
            Index = IntEx
        End If
        Rem 资源中的位图 少了前面的16字节数据
        '        biSize As Long
        '        biWidth As Long
        '        biHeight As Long
        '        biPlanes As Integer
        '        biBitCount As Integer
        If ResType = RT_STRING Then
            Rem =======================================================开始处理字符串表
            Rem 字符串Id = 编号 / 16 + 1
            Dim StrLen As Integer, lpIndex As Long, Init As Boolean
            lpIndex = BaseAddr + HeaderSizeas                                   ' + 10
            Init = False
            Do
                CopyMemory StrLen, Memory(lpIndex), 2: lpIndex = lpIndex + 2
                If StrLen = 0 Then
                    If Init Then
                        Exit Do
                    Else
                        GoTo NextGo
                    End If
                End If
                Init = True
                lStr = Space(StrLen)
                CopyMemory ByVal StrPtr(lStr), Memory(lpIndex), StrLen * 2: lpIndex = lpIndex + StrLen * 2
                     MsgBox lStr, 16, "字符串表内容"
NextGo:
            Loop
            Rem =======================================================字符串表处理完毕
        End If
        '
        Debug.Print "BaseAddr", BaseAddr
        Debug.Print "DataSizeas", DataSizeas
        Debug.Print "HeaderSizeas", HeaderSizeas
        Debug.Print "ResName", lpResName
        Debug.Print "ResType", lpResType, GetResType(ResType)
        List1.AddItem lpResName & vbTab & lpResType & vbTab & GetResType(ResType)
        Debug.Print "DataVersionas", DataVersionas
        Debug.Print "MemoryFlagsas", MemoryFlagsas
        Debug.Print "LanguageIdas", LanguageIdas
        Debug.Print "Versionas", Versionas
        Debug.Print "Characteristicsas", Characteristicsas
        Debug.Print "==========================================================="
NextItem:
    Loop
End Sub
                                                                         
'工程1
'Resource
'
Private Sub Form_Load()
    GetPictureByte "Resource.RES", Memory()
End Sub
                                                                         
Public Function GetPictureByte(ImageFile As String, Memory() As Byte) As Byte
    Dim Filen As Integer
    Filen = FreeFile
    Erase Memory
    Open ImageFile For Binary As #Filen
        ReDim Memory(LOF(Filen) - 1) As Byte
        Get #Filen, , Memory
    Close #Filen
End Function
                                                                    
Public Function GetResType(lType As Integer) As String
    Select Case lType
        Case RT_UNKNOWN: GetResType = "未知类型资源(用户自定义)"
        Case RT_STRING: GetResType = "字符串表"
        Case RT_VERSION: GetResType = "版本信息"
        Case RT_MENU: GetResType = "菜单"
        Case RT_ICON: GetResType = "图标"
        Case RT_HTML: GetResType = "HTML资源"
        Case RT_FONTDIR: GetResType = "字体目录资源。"
        Case RT_FONT: GetResType = "字体资源"
        Case RT_DIALOG: GetResType = "对话框"
        Case RT_CURSOR: GetResType = "光标"
        Case RT_BITMAP: GetResType = "位图"
        Case RT_ANICURSOR: GetResType = "动画"
        Case RT_GROUP_CURSOR: GetResType = "与硬件无关的光标资源"
        Case RT_GROUP_ICON: GetResType = "独立于硬件的图标资源"
        Case Else: GetResType = lType
    End Select
End Function
                                                                    

[岭神]

支持支持~-

[lost09]

学习了.....

[wanghp1120]

学习！！！努力学习中！

[zyytxc]

刚学。还是看不懂啊

[rocklinsuv]

学习！！！努力学习中！

[cs_49]

回想起当年学VB。

[赵4老师]

美化楼主代码：

Option Explicit

Const RT_UNKNOWN      =  0
Const RT_CURSOR       =  1
Const RT_BITMAP       =  2
Const RT_ICON         =  3
Const RT_MENU         =  4
Const RT_DIALOG       =  5
Const RT_STRING       =  6
Const RT_FONTDIR      =  7
Const RT_FONT         =  8
Const RT_GROUP_CURSOR = 12
Const RT_GROUP_ICON   = 14
Const RT_VERSION      = 16
Const RT_ANICURSOR    = 21
Const RT_HTML         = 23
Private Type RESOURCEHEADER
    DataSizeas         As Long
    HeaderSizeas       As Long
    ResTypeas          As Variant ' [Ordinal or name TYPE];
    ResNameas          As Variant '需要说明的就是这里的Type和Name，有可能是一个字符串，也有可能是一个双字节整型，所以用Variant[Ordinal or name NAME];
    DataVersionas      As Long
    MemoryFlagsas      As Integer
    LanguageIdas       As Integer
    Versionas          As Long
    Characteristicsas  As Long
    ResData()          As Byte    '这是具体的数据，可以留给后续处理时使用，仅当DataSize<>0时才有
End Type
Dim Memory() As Byte

' 参考资料 http://blog.csdn.net/unsigned/article/details/3305830
' 参考资料 http://msdn.microsoft.com/en-us/library/ms648009(VS.85).aspx
' 参考资料 http://bbs.csdn.net/topics/70112100

' 字符串表
' 编号相连的多个字符串会放入一个表内



Private Sub Command1_Click()
    Dim Index             As Long    '当前地址指针
    Dim BaseAddr          As Long    '当前项开始的地址
    Dim DataSizeas        As Long    '数据大小
    Dim HeaderSizeas      As Long    '资源头大小
    Dim ResNameJ          As Integer '判断用 resname 和 restype 是字符串 还是 数值
    Dim ResTypeJ          As Integer
    Dim ResType           As Integer '储存 resname 和 restype 的数值
    Dim ResName           As Integer
    Dim lpResName         As String  '储存 resname 和 restype 的字符串
    Dim lpResType         As String
    Dim DataVersionas     As Long    '资源的附加信息
    Dim MemoryFlagsas     As Integer
    Dim LanguageIdas      As Integer
    Dim Versionas         As Long
    Dim Characteristicsas As Long
    Dim lStrStart As Long, lChr As Integer '字符串 解析相关
    Dim ChrLength As Long, DataLength As Long
    Dim lStr As String
    DataLength = UBound(Memory()) + 1
    List1.Clear
    Index = &H20 '前面有一个 32字节的空结构
    Do
        ResType = 0 '清空变量
        ResName = 0
        If Index + 4 >= DataLength Then '是否完成？
            Exit Do
        End If
        BaseAddr = Index '保存该结构地址 供 读取数据用
        CopyMemory DataSizeas  , Memory(Index), 4: Index = Index + 4 '读取数据大小 头大小(包括 DataSizeas 和 HeaderSizeas)
        CopyMemory HeaderSizeas, Memory(Index), 4: Index = Index + 4
        CopyMemory ResTypeJ    , Memory(Index), 2: Index = Index + 2 '读取文件 Type解析
        Select Case ResTypeJ '解析 RES_Type 和 RES_Name
            Case -1
                CopyMemory ResType , Memory(Index), 2: Index = Index + 2 '如果为-1 那么说明 后面跟着数值型 ResType
                CopyMemory ResNameJ, Memory(Index), 2: Index = Index + 2
                If ResNameJ = -1 Then '用同样的方法获取 RES_NAME
                    CopyMemory ResName, Memory(Index), 2: Index = Index + 2
                    lpResName = CStr(ResName)
                Else
                    lStrStart = Index
                    ' 解析 Name
                    Do
                        CopyMemory lChr, Memory(Index), 2: Index = Index + 2
                        If lChr = 0 Then
                            ChrLength = Index - lStrStart - 2 '0为字符串结束符
                            lStr = Space(ChrLength / 2)
                            CopyMemory ByVal StrPtr(lStr), Memory(lStrStart), ChrLength
                            lpResName = lStr
                            Exit Do
                        End If
                    Loop
                End If
                lpResType = CStr(ResType)
            Case Else
                ' 如果不为-1那么说明 后面跟着 UniCode 字符串
                ' 解析 Type
                lStrStart = Index - 2
                Do
                    CopyMemory lChr, Memory(Index), 2: Index = Index + 2
                    If lChr = 0 Then '0为字符串结束符
                        ChrLength = Index - lStrStart - 2
                        lStr = Space(ChrLength / 2)
                        CopyMemory ByVal StrPtr(lStr), Memory(lStrStart), ChrLength
                        lpResType = lStr
                        Exit Do
                    End If
                Loop
                ' 解析 Res_Name 类型
                CopyMemory ResNameJ, Memory(Index), 2: Index = Index + 2
                If ResNameJ = -1 Then
                    CopyMemory ResName, Memory(Index), 2: Index = Index + 2
                    lpResName = CStr(ResName)
                Else
                    lStrStart = Index - 2
                    ' 解析 Name
                    Do
                        CopyMemory lChr, Memory(Index), 2: Index = Index + 2
                        If lChr = 0 Then
                            ChrLength = Index - lStrStart - 2
                            lStr = Space(ChrLength / 2)
                            CopyMemory ByVal StrPtr(lStr), Memory(lStrStart), ChrLength
                            lpResName = lStr
                            Exit Do
                        End If
                    Loop
                End If
        End Select
        If (ResType + ResName) Mod 4 <> 0 Then ' 如果 (ResType + ResName) Mod 4 <> 0(看网上资料说 如果不为0  那只能是2) 则附加2字节信息
            Index = Index + 2
        End If
        ' 读取相关信息
        CopyMemory DataVersionas    , Memory(Index), 4: Index = Index + 4
        CopyMemory MemoryFlagsas    , Memory(Index), 2: Index = Index + 2
        CopyMemory LanguageIdas     , Memory(Index), 2: Index = Index + 2
        CopyMemory Versionas        , Memory(Index), 4: Index = Index + 4
        CopyMemory Characteristicsas, Memory(Index), 4: Index = Index + 4
        Index = BaseAddr + DataSizeas + HeaderSizeas '计算上 资源的数据长度(下个资源地址  = 这个资源地址 + 头长度 + 数据长度)
        ' 4字节对齐？
        Dim IntEx As Long
        IntEx = Index \ 4
        IntEx = IntEx * 4
        ' Vb的 CUSTOM 等自定义资源类型 可能是因为对齐原因吧 多了四个字节
        ' Rc 编译的 自动4字节对齐了
        If Index <> IntEx Then
            Index = IntEx
            Index = Index + 4
        Else
            Index = IntEx
        End If
        ' 资源中的位图 少了前面的16字节数据
        '        biSize     As Long
        '        biWidth    As Long
        '        biHeight   As Long
        '        biPlanes   As Integer
        '        biBitCount As Integer
        If ResType = RT_STRING Then
            ' =======================================================开始处理字符串表
            ' 字符串Id = 编号 / 16 + 1
            Dim StrLen As Integer, lpIndex As Long, Init As Boolean
            lpIndex = BaseAddr + HeaderSizeas ' + 10
            Init = False
            Do
                CopyMemory StrLen, Memory(lpIndex), 2: lpIndex = lpIndex + 2
                If StrLen = 0 Then
                    If Init Then
                        Exit Do
                    Else
                        GoTo NextGo
                    End If
                End If
                Init = True
                lStr = Space(StrLen)
                CopyMemory ByVal StrPtr(lStr), Memory(lpIndex), StrLen * 2: lpIndex = lpIndex + StrLen * 2
                     MsgBox lStr, 16, "字符串表内容"
NextGo:
            Loop
            ' =======================================================字符串表处理完毕
        End If
        '
        Debug.Print "BaseAddr"         , BaseAddr
        Debug.Print "DataSizeas"       , DataSizeas
        Debug.Print "HeaderSizeas"     , HeaderSizeas
        Debug.Print "ResName"          , lpResName
        Debug.Print "ResType"          , lpResType   , GetResType(ResType)
        List1.AddItem lpResName & vbTab & lpResType & vbTab & GetResType(ResType)
        Debug.Print "DataVersionas"    , DataVersionas
        Debug.Print "MemoryFlagsas"    , MemoryFlagsas    
        Debug.Print "LanguageIdas"     , LanguageIdas     
        Debug.Print "Versionas"        , Versionas        
        Debug.Print "Characteristicsas", Characteristicsas
        Debug.Print "==========================================================="
NextItem:
    Loop
End Sub

'工程1
'Resource
'
Private Sub Form_Load()
    GetPictureByte "Resource.RES", Memory()
End Sub

Public Function GetPictureByte(ImageFile As String, Memory() As Byte) As Byte
    Dim Filen As Integer
    Filen = FreeFile
    Erase Memory
    Open ImageFile For Binary As #Filen
        ReDim Memory(LOF(Filen) - 1) As Byte
        Get #Filen, , Memory
    Close #Filen
End Function

Public Function GetResType(lType As Integer) As String
    Select Case lType
        Case RT_UNKNOWN     : GetResType = "未知类型资源(用户自定义)"
        Case RT_STRING      : GetResType = "字符串表"                
        Case RT_VERSION     : GetResType = "版本信息"                
        Case RT_MENU        : GetResType = "菜单"                    
        Case RT_ICON        : GetResType = "图标"                    
        Case RT_HTML        : GetResType = "HTML资源"                
        Case RT_FONTDIR     : GetResType = "字体目录资源。"          
        Case RT_FONT        : GetResType = "字体资源"                
        Case RT_DIALOG      : GetResType = "对话框"                  
        Case RT_CURSOR      : GetResType = "光标"                    
        Case RT_BITMAP      : GetResType = "位图"                    
        Case RT_ANICURSOR   : GetResType = "动画"                    
        Case RT_GROUP_CURSOR: GetResType = "与硬件无关的光标资源"    
        Case RT_GROUP_ICON  : GetResType = "独立于硬件的图标资源"    
        Case Else           : GetResType = lType                     
    End Select
End Function

[土豆赛叩]

看大家这么热情 更新下吧

Option Explicit
Const RT_STRING = 6
Const RT_VERSION = 16
Const RT_MENU = 4
Const RT_ICON = 3
Const RT_HTML = 23
Const RT_FONTDIR = 7
Const RT_FONT = 8
Const RT_DIALOG = 5
Const RT_CURSOR = 1
Const RT_BITMAP = 2
Const RT_ANICURSOR = 21
Const RT_GROUP_CURSOR = 12
Const RT_GROUP_ICON = 14
Const RT_UNKNOWN = 0
Private Type BITMAPFILEHEADER
    bfType         As Integer
    bfSize         As Long
    bfReserved1    As Integer
    bfReserved2    As Integer
    bfOffBits      As Long
End Type
Private Type BITMAPINFOHEADER                                                   '40 bytes
    biSize         As Long
    biWidth        As Long
    biHeight       As Long
    biPlanes       As Integer
    biBitCount     As Integer
    biCompression  As Long
    biSizeImage    As Long
    biXPelsPerMeter As Long
    biYPelsPerMeter As Long
    biClrUsed      As Long
    biClrImportant As Long
End Type
Private Type IconHeader
    wReserved      As Integer                                                   '                                                    '       // 当前为0
    wType          As Integer                                                   '              // 图标在此等于1
    wCount         As Integer                                                   '            // 组件的数量
    padding        As Integer                                                   '            // 为使双字对齐的填充数据
End Type
Private Type ICONFILEHEADER                                                     '22bytes
    idReserved     As Integer                                                   '为0
    idType         As Integer                                                   '为1
    idCount        As Integer                                                   '文件中图标个数，为1
    bWidth         As Byte                                                      '宽，为16或32
    bHeight        As Byte                                                      ' 高，为16或32
    bColorCount    As Byte                                                      '调色盘颜色数量：16或255 或0
    bReserved      As Byte                                                      '为0
    wPlanes        As Integer                                                   '为1
    wBitCount      As Integer                                                   '每个像素占的位数
    dwBytesInRes   As Long                                                      '图标文件后四项总字节数
    dwImageOffset  As Long                                                      '图标文件头长度，为22
End Type
Private Type RESOURCEHEADER
    DataSizeas     As Long
    HeaderSizeas   As Long
    ResTypeas      As Variant                                                   ' [Ordinal or name TYPE];
    ResNameas      As Variant                                                   '需要说明的就是这里的Type和Name，有可能是一个字符串，也有可能是一个双字节整型，所以用Variant[Ordinal or name NAME];
    DataVersionas  As Long
    MemoryFlagsas  As Integer
    LanguageIdas   As Integer
    Versionas      As Long
    Characteristicsas  As Long
End Type
Dim Memory()       As Byte

Rem 参考资料 http://blog.csdn.net/unsigned/article/details/3305830
Rem 参考资料 http://msdn.microsoft.com/en-us/library/ms648009(VS.85).aspx
Rem 参考资料 http://bbs.csdn.net/topics/70112100
Rem 参考资料
Rem 参考资料
Rem 参考资料 http://blog.csdn.net/xilyu/article/details/1776283
Rem 字符串表
Rem 编号相连的多个字符串会放入一个表内
Private Sub Command1_Click()
    Rem 当前地址指针
    Dim Index          As Long
    Rem 当前项开始的地址
    Dim BaseAddr         As Long
    Rem 数据大小
    Dim DataSizeas       As Long
    Rem 资源头大小
    Dim HeaderSizeas     As Long
    Rem 判断用 resname 和 restype 是字符串 还是 数值
    Dim ResNameJ          As Integer
    Dim ResTypeJ          As Integer
    Rem 储存 resname 和 restype 的数值
    Dim ResType            As Integer
    Dim ResName            As Integer
    Rem 储存 resname 和 restype 的字符串
    Dim lpResName         As String
    Dim lpResType         As String
    Rem 资源的附加信息
    Dim DataVersionas  As Long
    Dim MemoryFlagsas    As Integer
    Dim LanguageIdas    As Integer
    Dim Versionas         As Long
    Dim Characteristicsas     As Long
    Rem 字符串 解析相关
    Dim lStrStart As Long, lChr As Integer
    Dim ChrLength As Long, DataLength As Long
    Dim lStr As String
    DataLength = UBound(Memory()) + 1
    List1.Clear
    Rem  前面有一个 32字节的空结构
    Index = &H20
    Do
        Rem 清空变量
        ResType = 0
        ResName = 0
        Rem 是否完成？
        If Index + 4 >= DataLength Then
            Exit Do
        End If
        Rem 保存该结构地址 供 读取数据用
        BaseAddr = Index
        Rem 读取数据大小 头大小(包括 DataSizeas 和 HeaderSizeas)
        CopyMemory DataSizeas, Memory(Index), 4: Index = Index + 4
        CopyMemory HeaderSizeas, Memory(Index), 4: Index = Index + 4
        Rem 读取文件 Type解析
        CopyMemory ResTypeJ, Memory(Index), 2: Index = Index + 2
        Rem 解析 RES_Type 和 RES_Name
        Select Case ResTypeJ
            Case -1
                Rem 如果为-1 那么说明 后面跟着数值型 ResType
                CopyMemory ResType, Memory(Index), 2: Index = Index + 2
                CopyMemory ResNameJ, Memory(Index), 2: Index = Index + 2
                Rem 用同样的方法获取 RES_NAME
                If ResNameJ = -1 Then
                    CopyMemory ResName, Memory(Index), 2: Index = Index + 2
                    lpResName = CStr(ResName)
                Else
                    lStrStart = Index
                    Rem 解析 Name
                    Do
                        CopyMemory lChr, Memory(Index), 2: Index = Index + 2
                        If lChr = 0 Then
                            Rem 0为字符串结束符
                            ChrLength = Index - lStrStart - 2
                            lStr = Space(ChrLength / 2)
                            CopyMemory ByVal StrPtr(lStr), Memory(lStrStart), ChrLength
                            lpResName = lStr
                            Exit Do
                        End If
                    Loop
                End If
                lpResType = CStr(ResType)
            Case Else
                Rem 如果不为-1那么说明 后面跟着 UniCode 字符串
                Rem 解析 Type
                lStrStart = Index - 2
                Do
                    CopyMemory lChr, Memory(Index), 2: Index = Index + 2
                    If lChr = 0 Then
                        Rem 0为字符串结束符
                        ChrLength = Index - lStrStart - 2
                        lStr = Space(ChrLength / 2)
                        CopyMemory ByVal StrPtr(lStr), Memory(lStrStart), ChrLength
                        lpResType = lStr
                        Exit Do
                    End If
                Loop
                Rem 解析 Res_Name 类型
                CopyMemory ResNameJ, Memory(Index), 2: Index = Index + 2
                If ResNameJ = -1 Then
                    CopyMemory ResName, Memory(Index), 2: Index = Index + 2
                    lpResName = CStr(ResName)
                Else
                    lStrStart = Index - 2
                    Rem 解析 Name
                    Do
                        CopyMemory lChr, Memory(Index), 2: Index = Index + 2
                        If lChr = 0 Then
                            ChrLength = Index - lStrStart - 2
                            lStr = Space(ChrLength / 2)
                            CopyMemory ByVal StrPtr(lStr), Memory(lStrStart), ChrLength
                            lpResName = lStr
                            Exit Do
                        End If
                    Loop
                End If
        End Select
        If (ResType + ResName) Mod 4 <> 0 Then
            Index = Index + 2
            Rem 2字节对齐
            Index = Index + 2
        End If
        Rem  读取相关信息
        CopyMemory DataVersionas, Memory(Index), 4: Index = Index + 4
        CopyMemory MemoryFlagsas, Memory(Index), 2: Index = Index + 2
        CopyMemory LanguageIdas, Memory(Index), 2: Index = Index + 2
        CopyMemory Versionas, Memory(Index), 4: Index = Index + 4
        CopyMemory Characteristicsas, Memory(Index), 4: Index = Index + 4
        Rem  计算上 资源的数据长度(下个资源地址  = 这个资源地址 + 头长度 + 数据长度)
        Index = BaseAddr + DataSizeas + HeaderSizeas
        Rem 字节对齐
        Dim IntEx As Long
        IntEx = Index \ 4
        IntEx = IntEx * 4
        Rem Rc 编译的 自动4字节对齐了 Vb编译的没有
        If Index <> IntEx Then
            Index = IntEx
            Index = Index + 4
        Else
            Index = IntEx
        End If
        Rem 资源中的位图 少了前面的16字节数据
        '        biSize As Long
        '        biWidth As Long
        '        biHeight As Long
        '        biPlanes As Integer
        '        biBitCount As Integer
        Dim Buff() As Byte
        If ResType = RT_ICON Then
            Rem [DIB头]
            Rem  [图标XOR（异或）掩码的颜色DIBits (Color DIBits of icon XOR mask)]
            Rem [AND（与）掩码的单色DIBits (Monochrome DIBits of AND mask)]
            ReDim Buff(DataSizeas - 1)
            CopyMemory Buff(0), Memory(BaseAddr + HeaderSizeas), DataSizeas
        ElseIf ResType = RT_GROUP_ICON Then
            Dim Hander As IconHeader
            Dim ICONDIR As ICONFILEHEADER
            Rem ICON头 记录着有几个图标和类型
            Rem 这里有个双字节对齐 得计算
            Rem  ICONDIR(有几个图标 就有几个 ICONDIR)
            CopyMemory Hander, Memory(BaseAddr + HeaderSizeas), 8
            Dim I As Long, NewAddr As Long
            '             MsgBox Hander.wCount, 16, DataSizeas
            For I = 1 To Hander.wCount
                CopyMemory ICONDIR, Memory(BaseAddr + HeaderSizeas + NewAddr), Len(ICONDIR)
                '  MsgBox ICONDIR.bHeight & "-" & ICONDIR.bWidth
                '   MsgBox ICONDIR.wBitCount
                NewAddr = NewAddr + Len(ICONDIR)
            Next
        ElseIf ResType = RT_BITMAP Then
            Dim DibHeader As BITMAPINFOHEADER
            Dim BmpHeader As BITMAPFILEHEADER
            Dim BmpMemory() As Byte
            Dim DataLen   As Long
            Dim Planes() As Byte
            Dim PlanesLen As Long
            Dim Filen      As Integer

[土豆赛叩]

            Rem DIB头
            Rem 位图调色板(可选)
            Rem 位图点阵
            CopyMemory DibHeader, Memory(BaseAddr + HeaderSizeas), LenB(DibHeader)
            Rem 文件标识
            BmpHeader.bfType = &H4D42
            Select Case DibHeader.biBitCount
                Case 24, 32
                    Rem 位图像素数据偏移
                    BmpHeader.bfOffBits = &H36
                    Rem 位图数据长度
                    DataLen = DibHeader.biSizeImage
                Case 8
                    Rem 位图像素数据偏移(带调色板)
                    BmpHeader.bfOffBits = &H36 + 1024
                    Rem 位图数据长度(带调色板)
                    DataLen = DibHeader.biSizeImage + 1024
                Case 4
                    Rem 位图像素数据偏移(带调色板)
                    BmpHeader.bfOffBits = &H36 + 64
                    Rem 位图数据长度(带调色板)
                    DataLen = DibHeader.biSizeImage + 64
                Case 16
                    Rem 位图像素数据偏移(带调色板)
                    BmpHeader.bfOffBits = &H36 + 1024 + 12
                    Rem 位图数据长度(带调色板)
                    DataLen = DibHeader.biSizeImage + 1024 + 12
            End Select
            Debug.Print DibHeader.biSizeImage
            Rem 位图文件总大小
            BmpHeader.bfSize = &H36 + DataLen
            ReDim BmpMemory(DataLen - 1)
            CopyMemory BmpMemory(0), Memory(BaseAddr + HeaderSizeas + LenB(DibHeader)), DataLen
            Filen = FreeFile
            Open lpResName & "-" & DibHeader.biBitCount & "-" & DibHeader.biCompression & ".Bmp" For Binary As #Filen
                Put #Filen, , BmpHeader
                Put #Filen, , DibHeader
                Put #Filen, , BmpMemory
            Close #Filen
        End If
        If ResType = RT_STRING Then
            Rem =======================================================开始处理字符串表
            Rem 字符串Id = 编号 / 16 + 1
            Dim StrLen As Integer, lpIndex As Long, Init As Boolean
            lpIndex = BaseAddr + HeaderSizeas                                   ' + 10
            Init = False
            Do
                CopyMemory StrLen, Memory(lpIndex), 2: lpIndex = lpIndex + 2
                If StrLen = 0 Then
                    If Init Then
                        Exit Do
                    Else
                        GoTo NextGo
                    End If
                End If
                Init = True
                lStr = Space(StrLen)
                CopyMemory ByVal StrPtr(lStr), Memory(lpIndex), StrLen * 2: lpIndex = lpIndex + StrLen * 2
                Rem           MsgBox lStr, 16, "字符串表内容"
NextGo:
            Loop
            Rem =======================================================字符串表处理完毕
        End If
        '        '
        '        Debug.Print "BaseAddr", BaseAddr
        '        Debug.Print "DataSizeas", DataSizeas
        '        Debug.Print "HeaderSizeas", HeaderSizeas
        '        Debug.Print "ResName", lpResName
        '        Debug.Print "ResType", lpResType, GetResType(ResType)
        List1.AddItem lpResName & vbTab & lpResType & vbTab & GetResType(ResType)
        '        Debug.Print "DataVersionas", DataVersionas
        '        Debug.Print "MemoryFlagsas", MemoryFlagsas
        '        Debug.Print "LanguageIdas", LanguageIdas
        '        Debug.Print "Versionas", Versionas
        '        Debug.Print "Characteristicsas", Characteristicsas
        '        Debug.Print "==========================================================="
NextItem:
    Loop
End Sub
                                                                         
'工程1
'Resource
'

Private Sub Form_Load()
    GetPictureByte "工程1.RES", Memory()
End Sub
                                                                         
Public Function GetPictureByte(ImageFile As String, Memory() As Byte) As Byte
    Dim Filen As Integer
    Filen = FreeFile
    Erase Memory
    Open ImageFile For Binary As #Filen
        ReDim Memory(LOF(Filen) - 1) As Byte
        Get #Filen, , Memory
    Close #Filen
End Function
                                                                    
Public Function SaveByte(ImageFile As String, MemoryEx() As Byte) As Byte
    On Error Resume Next
    Dim Filen As Integer
    Filen = FreeFile
    Open ImageFile For Binary As #Filen
        Put #Filen, , MemoryEx
    Close #Filen
End Function
                                                                    
Public Function GetResType(lType As Integer) As String
    Select Case lType
        Case RT_UNKNOWN: GetResType = "未知类型资源(用户自定义)"
        Case RT_STRING: GetResType = "字符串表"
        Case RT_VERSION: GetResType = "版本信息"
        Case RT_MENU: GetResType = "菜单"
        Case RT_ICON: GetResType = "图标"
        Case RT_HTML: GetResType = "HTML资源"
        Case RT_FONTDIR: GetResType = "字体目录资源。"
        Case RT_FONT: GetResType = "字体资源"
        Case RT_DIALOG: GetResType = "对话框"
        Case RT_CURSOR: GetResType = "光标"
        Case RT_BITMAP: GetResType = "位图"
        Case RT_ANICURSOR: GetResType = "动画"
        Case RT_GROUP_CURSOR: GetResType = "与硬件无关的光标资源"
        Case RT_GROUP_ICON: GetResType = "独立于硬件的图标资源"
        Case Else: GetResType = lType
    End Select
End Function
                                                                    

[QQ215712027]

其实你最后这个函数完全可以定义成一个枚举

[cccfdfd]

支持一下.......

[sky123468]

残酷啊。研究

[XJDUSZ]

刚学。看不懂!

[hjbgenius]

学习一下，很有用的

[wojiaozhutouqi]

我就看看，不说话

[神马被哪个妞占用了呢]

话说，新人都要报三围的……

[静谧的天狼星]

支持一下，很久以前也用VB，后来工作了就不用了。

[朝霞漫天繁星退却]

居然这样也可以，不是太逆天了吧

[hzfujr]

顶一个，新人不容易呀！

[vick3788]

看不懂啊，，，，，要炸了