Строго не судите, могут быть косяки.
Руководствовался информацией с MSDN
Буду рад и благодарен любой помощи в:
1) Тестировании на разных ОС с разными языками. (смог проверить пока только на Win 7 и Win 10).
2) Нахождению багов в коде, если таковые имеются. (да наверняка !)
3) Допиливанию кода для чтения ресурсов других типов. (например VERSIONINFO).
Загнал функции в Class
Open - открытие ресурса (всего лишь принимает имя файла)
GetStrings - чтение строковой таблицы по ID
GetString - чтение строки по ID
GetIcon - чтение содержимого иконки
GetBitmap - чтение содержимого рисунка
- Код: Выделить всё
Option Explicit
Dim oDict, sTmp, sKey, i
Main
Sub Main()
Dim oResReader
Set oResReader = new cResReader
oResReader.Open "shell32.dll"
MsgBox "Чтение значения 5378 из STRING TABLE в shell32.dll: """ & oResReader.getString(5378) & """"
'Чтение всей таблицы значений из STRINGTABLE
Set oDict = oResReader.GetStrings(337)
For Each sKey in oDict.Keys
sTmp = sTmp & sKey & ": " & oDict(sKey) & vbCrlf
Next
MsgBox sTmp
MsgBox "Сейчас откроется изображение выгруженное из ресурсов"
With CreateObject("ADODB.Stream")
.Type = 1
.Open
.Write oResReader.GetIcon(203)
.SaveToFile "testImage.png", 2
CreateObject("WScript.Shell").Run "testImage.png"
End With
End Sub
'MsgBox resGetString("shell32.dll", 5388)
Class cResReader
Private oReader
Private sFile
Private Sub Class_Initialize()
Set oReader = CreateObject("MSXML2.XMLHTTP")
End Sub
'Открытие ресурса
Function Open(sFileName)
sFile = sFileName
Set Open = Me
End Function
'Получение одного текстового значения по ID
Function GetString(id)
GetString = GetStrings(id / 16 + 1)(id)
End Function
'Получение содержимого иконки по ID
Function GetIcon(id)
Const RT_ICON = 3
GetIcon = GetData(RT_ICON,id)
End Function
'Получение содержимого точечного изображения по ID
Function GetBitmap(id)
Const RT_BITMAP = 2
GetBitmap = GetData(RT_BITMAP,id)
End Function
Private Function GetData(vType, id)
With oReader
'Открытие ресурсов файла
.Open "GET","res://" & sFile & "/" & vType & "/" & id, False:.send
GetData = .responseBody
End With
End Function
'Получение таблицы значений
Function GetStrings(lId)
'Тип необходимого нам ресурса
Const RT_STRING = 6
Dim i, lLen, oDict, n
lId = Fix(lId)
'Создание массива для размещения элементов с запасом.
Set oDict = CreateObject("Scripting.Dictionary")
With oReader
'Открытие ресурсов файла
.Open "GET","res://" & sFile & "/" & RT_STRING & "/" & lId, False:.send
'Перебор содержимого responseBody
For i = 1 to LenB(.responseBody)
'Читаем первые 2 байта и получаем размер блока в байтах за ним
lLen = AscB(MidB(.responseBody,i,2))
'Проверяем, что длина не нулевая
if lLen > 0 Then oDict.Add (lId-1) * 16 + n, MidB(.responseBody,i + 2,lLen * 2)
'Наращиваем количество элементов
n = n + 1
'Смещение положения курсора чтения
i = i + lLen * 2 + 1
Next
End With
Set GetStrings = oDict
End Function
End Class
UPD: 09.02.2017. Вроде разобрался с ID-никами. Сделал 2 функции. Загрузка STRINGTABLE целиком в Dictionary и чтение конкретного значения по id
UPD: 09.02.2017 12:37 Переоформил код в Class.
UPD 10.02.2017 Убрал ошибку чтения ресурсов с нулевой длиной
