Lstrlen всегда выдает одинаковое число (EnumResourceNames callback) - VB
Формулировка задачи:
Можете, пожалуйста, посмотреть на проект...
Бинарь на чем тестить, в комплекте.
lLen всегда = 9 (перечисляю тип ресурса - 10).
Остальная часть кода в файле проекта. Запустить, нажать F5.
Реально имена ресурсов должны быть такие:
Решение задачи: «Lstrlen всегда выдает одинаковое число (EnumResourceNames callback)»
textual
Листинг программы
Option Explicit Private Declare Function EnumResourceTypes Lib "kernel32.dll" Alias "EnumResourceTypesW" (ByVal hModule As Long, ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long Private Declare Function EnumResourceNames Lib "kernel32" Alias "EnumResourceNamesW" (ByVal hModule As Long, ByVal lpType As Long, ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long Private Declare Function EnumResourceLanguages Lib "kernel32" Alias "EnumResourceLanguagesW" (ByVal hModule As Long, ByVal lpType As Long, ByVal lpName As Long, ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long Private Declare Function FindResourceEx Lib "kernel32" Alias "FindResourceExW" (ByVal hModule As Long, ByVal lpType As Long, ByVal lpName As Long, ByVal wLanguage As Integer) As Long Private Declare Function SizeofResource Lib "kernel32" (ByVal hModule As Long, ByVal hResInfo As Long) As Long Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenW" (ByVal lpString As Long) As Long Private Declare Function lstrcpyn Lib "kernel32.dll" Alias "lstrcpynW" (ByVal lpString1 As Long, ByVal lpString2 As Long, ByVal iMaxLength As Long) As Long Private Declare Sub memcpy Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long) Dim ResTypes As New Collection Dim ResNames As Collection Dim ResLang As Collection Dim ResSize As Collection Public Sub EnumResources(PathToResourceFile As String) Dim hModule As Long Dim i As Long Dim j As Long Dim k As Long hModule = LoadLibrary(PathToResourceFile) If hModule Then If EnumResourceTypes(hModule, AddressOf EnumResTypeProcW, 0&) Then For i = 1 To ResTypes.Count Debug.Print "Type: " & ResTypes(i) Set ResNames = New Collection If EnumResourceNames(hModule, GetVarRef(ResTypes(i)), AddressOf EnumResNameProcW, 0&) Then For j = 1 To ResNames.Count Debug.Print " Name: " & ResNames(j) Set ResLang = New Collection Set ResSize = New Collection If EnumResourceLanguages(hModule, GetVarRef(ResTypes(i)), GetVarRef(ResNames(j)), AddressOf EnumResLangProcW, 0&) Then For k = 1 To ResLang.Count Debug.Print " Lang: " & ResLang(k) & " - " & ResSize(k) & " bytes" Next Else MsgBox "Error #" & Err.LastDllError & " with enumeration of Resource Languages." End If Next Else MsgBox "Error #" & Err.LastDllError & " with enumeration of Resource Names." End If Next Else MsgBox "Error #" & Err.LastDllError & " with enumeration of Resource Types." End If FreeLibrary hModule Else MsgBox "Cannot load file: " & PathToResourceFile End If End Sub Function EnumResLangProcW(ByVal hModule As Long, ByVal lpszType As Long, ByVal lpszName As Long, ByVal lpszLanguage As Integer, ByVal lParam As Long) As Long Dim hResInfo As Long Dim lSize As Long hResInfo = FindResourceEx(hModule, GetVarRef(lpszType), GetVarRef(lpszName), lpszLanguage) If hResInfo Then lSize = SizeofResource(hModule, hResInfo) ResLang.Add lpszLanguage ResSize.Add lSize EnumResLangProcW = True End Function Function EnumResNameProcW(ByVal hModule As Long, ByVal lpszType As Long, ByVal lpszName As Long, ByVal lParam As Long) As Long Dim sName As String Dim lName As Long Dim lLen As Long If (lpszName And &HFFFF0000) = 0& Then 'ID lName = lpszName And &HFFFF& ResNames.Add lName Else 'String lLen = lstrlen(lpszName) If lLen > 0 Then sName = Space$(lLen) lstrcpyn StrPtr(sName), lpszName, lLen + 1 ResNames.Add sName End If End If EnumResNameProcW = True End Function Function EnumResTypeProcW(ByVal hModule As Long, ByVal lpszType As Long, ByVal lParam As Long) As Boolean Dim sType As String, lLen As Long If IS_INTRESOURCE(lpszType) Then 'ID ResTypes.Add lpszType Else 'String lLen = lstrlen(lpszType) If lLen > 0 Then sType = Space$(lLen) lstrcpyn StrPtr(sType), lpszType, lLen + 1 ResTypes.Add sType End If End If EnumResTypeProcW = True End Function Public Function IS_INTRESOURCE(i As Long) As Boolean IS_INTRESOURCE = (i <= &HFFFF&) End Function Function GetVarRef(vVar As Variant) As Long If VarType(vVar) = vbLong Then GetVarRef = vVar Else GetVarRef = StrPtr(vVar) End Function
ИИ поможет Вам:
- решить любую задачу по программированию
- объяснить код
- расставить комментарии в коде
- и т.д