EnumResources

'code submitted by Daniel Kaufmann (daniel@i.com.uy)
'In a form:
Private Sub Form_Load()
    Dim vFileName As String, vHandle As Long
    Me.AutoRedraw = True
    vFileName = "C:\Windows\System\kernel32.dll"
    'vFileName = "C:\Windows\Explorer.exe"
    vHandle = LoadLibraryEx(vFileName, 0, LOAD_LIBRARY_AS_DATAFILE)
    If vHandle = 0 Then
        Print "Invalid library"
        Exit Sub
    End If
    Dim i As resType
    Set f = Me
    For i = RT_FIRST To RT_LAST
        Print "Tipo: "; i,
        EnumResourceNames vHandle, i, AddressOf EnumResNameProc, 0
        Print
    Next
    FreeLibrary vHandle
End Sub
'In a module:
Public f As Form
Public Declare Function LoadLibraryEx Lib "kernel32" Alias "LoadLibraryExA" (ByVal lpLibFileName As String, ByVal hFile As Long, ByVal dwFlags As Long) As Long
Public Const LOAD_LIBRARY_AS_DATAFILE = &H2
Public Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
Public Declare Function EnumResourceNames Lib "kernel32" Alias "EnumResourceNamesA" (ByVal HModule As Long, ByVal lpType As resType, ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
'String management
Public Declare Function StrLen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As Long) As Long
Public Declare Function StrCpy Lib "kernel32" Alias "lstrcpyA" (ByVal lpString1 As String, ByVal lpString2 As Long) As Long
Private Const DIFFERENCE = 11
Public Enum resType 'Types of resources
    RT_FIRST = 1&
    RT_CURSOR = 1&
    RT_BITMAP = 2&
    RT_ICON = 3&
    RT_MENU = 4&
    RT_DIALOG = 5&
    RT_STRING = 6&
    RT_FONTDIR = 7&
    RT_FONT = 8&
    RT_ACCELERATOR = 9&
    RT_RCDATA = 10&
    RT_MESSAGETABLE = (11)
    RT_GROUP_CURSOR = (RT_CURSOR + DIFFERENCE)
    RT_GROUP_ICON = (RT_ICON + DIFFERENCE)
    RT_VERSION = (16)
    'RT_DLGINCLUDE = (17)
    'RT_PLUGPLAY = (19)
    'RT_VXD = (20)
    'RT_ANICURSOR = (21)
    'RT_ANIICON = (22)
    'RT_HTML = (23)
    RT_LAST = (16)
End Enum
Public Function EnumResNameProc(ByVal HModule As Long, ByVal lpszType As resType, ByVal lpszName As Long, ByVal lParam As Long) As Long
    Dim Nombre As String, IsNum As Boolean
    If (lpszName > &HFFFF&) Or (lpszName < 0) Then
        Nombre = PtrToVBString(lpszName)
        IsNum = False
    Else
        Nombre = CStr(lpszName)
        IsNum = True
    End If
    If IsNum Then
        f.Print Nombre + " ";
    Else
        f.Print """" + Nombre + """ ";
    End If
    EnumResNameProc = 1
End Function
Private Function PtrToVBString(ByVal lpszBuffer As Long) As String
    Dim Buffer As String, LenBuffer As Long
    LenBuffer = StrLen(lpszBuffer)
    Buffer = String(LenBuffer + 1, 0)
    StrCpy Buffer, lpszBuffer
    PtrToVBString = Left(Buffer, LenBuffer)
End Function

Close this window