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

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


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

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

14   голосов , оценка 4.143 из 5
Похожие ответы