Lstrlen всегда выдает одинаковое число (EnumResourceNames callback) - VB
Формулировка задачи:
Можете, пожалуйста, посмотреть на проект...
Бинарь на чем тестить, в комплекте.
lLen всегда = 9 (перечисляю тип ресурса - 10).
Остальная часть кода в файле проекта. Запустить, нажать F5.
Реально имена ресурсов должны быть такие:
Листинг программы
- 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
- 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(StrPtr(lpszName))
- If lLen > 0 Then
- If lpszType = 10 Then Stop
- sName = Space$(lLen)
- lstrcpyn StrPtr(sName), lpszName, lLen + 1
- ResNames.Add sName
- End If
- End If
- EnumResNameProcW = True
- End Function
Решение задачи: «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
ИИ поможет Вам:
- решить любую задачу по программированию
- объяснить код
- расставить комментарии в коде
- и т.д