Lstrlen всегда выдает одинаковое число (EnumResourceNames callback) - VB

Узнай цену своей работы

Формулировка задачи:

Можете, пожалуйста, посмотреть на проект... Бинарь на чем тестить, в комплекте. lLen всегда = 9 (перечисляю тип ресурса - 10).
Листинг программы
  1. Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenW" (ByVal lpString As Long) As Long
  2. Private Declare Function lstrcpyn Lib "kernel32.dll" Alias "lstrcpynW" (ByVal lpString1 As Long, ByVal lpString2 As Long, ByVal iMaxLength As Long) As Long
  3. Function EnumResNameProcW(ByVal hModule As Long, ByVal lpszType As Long, ByVal lpszName As Long, ByVal lParam As Long) As Long
  4. Dim sName As String
  5. Dim lName As Long
  6. Dim lLen As Long
  7. If (lpszName And &HFFFF0000) = 0& Then 'ID
  8. lName = lpszName And &HFFFF&
  9. ResNames.Add lName
  10. Else 'String
  11. lLen = lstrlen(StrPtr(lpszName))
  12. If lLen > 0 Then
  13. If lpszType = 10 Then Stop
  14. sName = Space$(lLen)
  15. lstrcpyn StrPtr(sName), lpszName, lLen + 1
  16. ResNames.Add sName
  17. End If
  18. End If
  19. EnumResNameProcW = True
  20. End Function
Остальная часть кода в файле проекта. Запустить, нажать F5. Реально имена ресурсов должны быть такие:

Решение задачи: «Lstrlen всегда выдает одинаковое число (EnumResourceNames callback)»

textual
Листинг программы
  1. Option Explicit
  2.  
  3. Private Declare Function EnumResourceTypes Lib "kernel32.dll" Alias "EnumResourceTypesW" (ByVal hModule As Long, ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
  4. 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
  5. 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
  6. 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
  7. Private Declare Function SizeofResource Lib "kernel32" (ByVal hModule As Long, ByVal hResInfo As Long) As Long
  8. Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
  9. Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
  10. Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenW" (ByVal lpString As Long) As Long
  11. Private Declare Function lstrcpyn Lib "kernel32.dll" Alias "lstrcpynW" (ByVal lpString1 As Long, ByVal lpString2 As Long, ByVal iMaxLength As Long) As Long
  12. Private Declare Sub memcpy Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
  13.  
  14. Dim ResTypes    As New Collection
  15. Dim ResNames    As Collection
  16. Dim ResLang     As Collection
  17. Dim ResSize     As Collection
  18.  
  19. Public Sub EnumResources(PathToResourceFile As String)
  20.  
  21.     Dim hModule As Long
  22.     Dim i       As Long
  23.     Dim j       As Long
  24.     Dim k       As Long
  25.    
  26.     hModule = LoadLibrary(PathToResourceFile)
  27.    
  28.     If hModule Then
  29.         If EnumResourceTypes(hModule, AddressOf EnumResTypeProcW, 0&) Then
  30.        
  31.             For i = 1 To ResTypes.Count
  32.                 Debug.Print "Type: " & ResTypes(i)
  33.                
  34.                 Set ResNames = New Collection
  35.                 If EnumResourceNames(hModule, GetVarRef(ResTypes(i)), AddressOf EnumResNameProcW, 0&) Then
  36.                
  37.                     For j = 1 To ResNames.Count
  38.                         Debug.Print "  Name: " & ResNames(j)
  39.                        
  40.                         Set ResLang = New Collection
  41.                         Set ResSize = New Collection
  42.                        
  43.                         If EnumResourceLanguages(hModule, GetVarRef(ResTypes(i)), GetVarRef(ResNames(j)), AddressOf EnumResLangProcW, 0&) Then
  44.                        
  45.                             For k = 1 To ResLang.Count
  46.                        
  47.                                 Debug.Print "    Lang: " & ResLang(k) & "  -  " & ResSize(k) & " bytes"
  48.                        
  49.                             Next
  50.                         Else
  51.                             MsgBox "Error #" & Err.LastDllError & " with enumeration of Resource Languages."
  52.                         End If
  53.                     Next
  54.                 Else
  55.                     MsgBox "Error #" & Err.LastDllError & " with enumeration of Resource Names."
  56.                 End If
  57.             Next
  58.         Else
  59.             MsgBox "Error #" & Err.LastDllError & " with enumeration of Resource Types."
  60.         End If
  61.         FreeLibrary hModule
  62.     Else
  63.         MsgBox "Cannot load file: " & PathToResourceFile
  64.     End If
  65.    
  66. End Sub
  67.  
  68. Function EnumResLangProcW(ByVal hModule As Long, ByVal lpszType As Long, ByVal lpszName As Long, ByVal lpszLanguage As Integer, ByVal lParam As Long) As Long
  69.    
  70.     Dim hResInfo    As Long
  71.     Dim lSize       As Long
  72.    
  73.     hResInfo = FindResourceEx(hModule, GetVarRef(lpszType), GetVarRef(lpszName), lpszLanguage)
  74.    
  75.     If hResInfo Then lSize = SizeofResource(hModule, hResInfo)
  76.    
  77.     ResLang.Add lpszLanguage
  78.     ResSize.Add lSize
  79.    
  80.     EnumResLangProcW = True
  81. End Function
  82.  
  83. Function EnumResNameProcW(ByVal hModule As Long, ByVal lpszType As Long, ByVal lpszName As Long, ByVal lParam As Long) As Long
  84.     Dim sName   As String
  85.     Dim lName   As Long
  86.     Dim lLen    As Long
  87.  
  88.     If (lpszName And &HFFFF0000) = 0& Then  'ID
  89.        lName = lpszName And &HFFFF&
  90.         ResNames.Add lName
  91.     Else                                    'String
  92.        lLen = lstrlen(lpszName)
  93.         If lLen > 0 Then
  94.             sName = Space$(lLen)
  95.             lstrcpyn StrPtr(sName), lpszName, lLen + 1
  96.             ResNames.Add sName
  97.         End If
  98.    End If
  99.    
  100.    EnumResNameProcW = True
  101. End Function
  102.  
  103. Function EnumResTypeProcW(ByVal hModule As Long, ByVal lpszType As Long, ByVal lParam As Long) As Boolean
  104.  
  105.     Dim sType As String, lLen As Long
  106.  
  107.     If IS_INTRESOURCE(lpszType) Then    'ID
  108.        ResTypes.Add lpszType
  109.     Else                                'String
  110.        lLen = lstrlen(lpszType)
  111.         If lLen > 0 Then
  112.             sType = Space$(lLen)
  113.             lstrcpyn StrPtr(sType), lpszType, lLen + 1
  114.             ResTypes.Add sType
  115.         End If
  116.     End If
  117.  
  118.     EnumResTypeProcW = True
  119. End Function
  120.  
  121. Public Function IS_INTRESOURCE(i As Long) As Boolean
  122.     IS_INTRESOURCE = (i <= &HFFFF&)
  123. End Function
  124.  
  125. Function GetVarRef(vVar As Variant) As Long
  126.     If VarType(vVar) = vbLong Then GetVarRef = vVar Else GetVarRef = StrPtr(vVar)
  127. End Function

ИИ поможет Вам:


  • решить любую задачу по программированию
  • объяснить код
  • расставить комментарии в коде
  • и т.д
Попробуйте бесплатно

Оцени полезность:

14   голосов , оценка 4.143 из 5

Нужна аналогичная работа?

Оформи быстрый заказ и узнай стоимость

Бесплатно
Оформите заказ и авторы начнут откликаться уже через 10 минут
Похожие ответы