'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
Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 107