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

--------------------编程问答-------------------- 支持一下
哈哈,没试过在这论坛能不能把附件改名后上传为图片.我偶尔要上传附件时,一般是在本站博客里发的,再插入个链接指向一下 --------------------编程问答--------------------

--------------------编程问答--------------------

引用 2 楼 yanzi_kiki 的回复:

怎么感觉妳有点打酱油的感觉？！ --------------------编程问答-------------------- 其实你最后这个函数完全可以定义成一个枚举 --------------------编程问答-------------------- 支持折腾,不过这个功能好象不是特别有实用意义?

一般RES不是直接编译进去了嘛?

但凡是折腾VB6的都支持,哈哈 --------------------编程问答-------------------- 作者还用REM作注释，高手啊！GetResType可以定义成结构。 --------------------编程问答-------------------- 帮你推荐下吧。支持新人！ --------------------编程问答--------------------

什么意思```` --------------------编程问答--------------------

--------------------编程问答--------------------

--------------------编程问答-------------------- 除 --------------------编程问答-------------------- 除 --------------------编程问答-------------------- 除 --------------------编程问答--------------------

支持下 --------------------编程问答-------------------- 回帖可以得下载积分么
--------------------编程问答-------------------- 除 --------------------编程问答-------------------- 除 --------------------编程问答-------------------- 除 --------------------编程问答-------------------- 除 --------------------编程问答-------------------- 好好学习、借鉴。 --------------------编程问答-------------------- 顶一个，学习一下 --------------------编程问答-------------------- 除 --------------------编程问答-------------------- 支持

--------------------编程问答-------------------- 不是吧？新人？我居然看不明白啊。。。。 --------------------编程问答-------------------- 挺不错的，支持一下！ --------------------编程问答-------------------- 帮你推荐下吧。支持新人！ --------------------编程问答-------------------- 支持支持~继续加油 --------------------编程问答-------------------- 挺不错的，支持一下！ --------------------编程问答-------------------- 挺不错的，支持一下！ --------------------编程问答--------------------

引用 5 楼 myjian 的回复:

支持折腾,不过这个功能好象不是特别有实用意义?

一般RES不是直接编译进去了嘛?

但凡是折腾VB6的都支持,哈哈

想写个资源编辑器插件,可以添加 32Bit 的图标等。。

--------------------编程问答--------------------

引用 24 楼 guyue35 的回复:

不是吧？新人？我居然看不明白啊。。。。

学Vb挺长时间了。。只是第一次来这个论坛罢了 --------------------编程问答-------------------- 除 --------------------编程问答-------------------- 支持支持~- --------------------编程问答-------------------- 同楼主，我也来赚赚积分，不知道回复有分不？
--------------------编程问答--------------------

--------------------编程问答-------------------- 新人学习一下，谢谢分享 --------------------编程问答-------------------- 学习！！！努力学习中！ --------------------编程问答-------------------- 美化楼主代码：

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

--------------------编程问答-------------------- 学习了.....
--------------------编程问答-------------------- 学习！！！努力学习中！ --------------------编程问答-------------------- 刚学。还是看不懂啊 --------------------编程问答-------------------- 回想起当年学VB。 --------------------编程问答-------------------- 看大家这么热情更新下吧



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

--------------------编程问答-------------------- 除 --------------------编程问答-------------------- 其实你最后这个函数完全可以定义成一个枚举 --------------------编程问答-------------------- 残酷啊。研究
--------------------编程问答-------------------- 除 --------------------编程问答-------------------- 支持一下....... --------------------编程问答-------------------- 学习一下，很有用的 --------------------编程问答-------------------- 除 --------------------编程问答-------------------- 刚学。看不懂! --------------------编程问答-------------------- 我就看看，不说话 --------------------编程问答-------------------- 除 --------------------编程问答-------------------- 话说，新人都要报三围的…… --------------------编程问答-------------------- 支持一下，很久以前也用VB，后来工作了就不用了。 --------------------编程问答-------------------- 居然这样也可以，不是太逆天了吧 --------------------编程问答-------------------- 顶一个，新人不容易呀！ --------------------编程问答-------------------- 看不懂啊，，，，，要炸了 --------------------编程问答-------------------- 除

补充：VB ,  基础类