26 (изменено: Xameleon, 2017-02-15 15:33:11)

Re: WSC: Script Component для чтения ресурсов из файлов через res протокол

Flasher, видимо на Win 7 эта картинка в ресурсах не существует. У меня на Win 10 выдаёт:

image/x-png

и сохраняет картинку успешно.

UPD

Выяснил. Взял Вашу shell32.dll, натравил на неё скрипт и получил такой же (неудачный) результат. Оказалось внутри ICON 1 лежит тело иконки без заголовка 32x32, а не PNG, как на Win 10. Файл создаётся, в него пишется тело этой ущербной иконки. Поэтому он и не открывается.

Передумал переделывать мир. Пашет и так, ну и ладно. Сделаю лучше свой !

27

Re: WSC: Script Component для чтения ресурсов из файлов через res протокол

Xameleon, интересный метод. Надо его поизучать на досуге как альтернативу ADODB.Stream / SAPI.spFileStream.
О наших баранах:
Вариант побитового парсинга уже реализован. Недостатки - налицо: чрезвычайно замудрено и медленно. Поскольку все параметры заданы жестко, а правила достаточно гибки - много иконок тупо не находит.
Вся прелесть предложенного тобой метода - в протоколе res:// , позволяющем запросто извлекать любые заданные ресурсы. Увы, видимо, придется смирится с его ограничениями:
- неспособностью извлекать ресурсы из неномерных секций;
- отсутствием возможности получить список доступных номеров.
Хотя, может быть, найдется новый гений и предложит решение хотя бы одной из этих проблем.

Flasher, как уже сказал Xameleon в res://shell32.dll/3/1 (Win7) никакой png-шки просто нет (там - обычная иконка без заголовка). Проще всего проверять на hta-шке

<HTML><BODY><IMG src="res://shell32.dll/3/1"></BODY></HTML>

Пусто? Тогда меняем во всех примерах res://shell32.dll/3/1 на res://c:\Program Files (x86)\Skype\Phone\Skype.exe/3/5 - там точно png-шка имеется.

28 (изменено: Xameleon, 2017-02-16 13:45:26)

Re: WSC: Script Component для чтения ресурсов из файлов через res протокол

mozers,

неспособностью извлекать ресурсы из неномерных секций;

Почему ? Ни кто не запрещает именованные извлекать через res.

Не уверен, что на семёрке есть эта иконка, взял первую попавшуюся из ieframe.dll на 10-ке.


<img src="res://ieframe.dll/2/CONTROL_HOT_120.BMP">

Вариант побитового парсинга уже реализован

Изучаю ! ) КРАЙНЕ ПОЛЕЗНЫЙ материал. ) Взял на заметку. Благодарю !

UPD

Поизучал код. ) Автор, как и я, подумал, что заголовок можно цеплять к иконке на основании размера её содержимого в байтах. Но я откинул эту идею, как кривое решение, а автор всё-таки реализовал.

Передумал переделывать мир. Пашет и так, ну и ладно. Сделаю лучше свой !

29

Re: WSC: Script Component для чтения ресурсов из файлов через res протокол

Xameleon

Ни кто не запрещает именованные извлекать через res.

Действительно так! А я, сделав лишь одну неудачную попытку, тут же поверил документации

// This is not correct.
"res://mydll.dll/#2/MYBITMAP"

Ну тогда осталась лишь одна реальная проблема - найти способ извлекать список имен ресурсов.

30

Re: WSC: Script Component для чтения ресурсов из файлов через res протокол

mozers

Ну тогда осталась лишь одна реальная проблема - найти способ извлекать список имен ресурсов.

Так в том то и дело, что и это Вы уже сделали, поделившись ссылкой.
Там уже всё это реализовано. ) Если причесать код, то должно получиться вполне удачное решение.

Передумал переделывать мир. Пашет и так, ну и ладно. Сделаю лучше свой !

31

Re: WSC: Script Component для чтения ресурсов из файлов через res протокол

Option Explicit

SaveSingleIcon "shell32.dll", "162"
SaveWholeIcon "g:\Total Commander\TOTALCMD.EXE", "MAINICON"

Sub SaveSingleIcon(resFile, iconID)
	Dim iconData, iconSize, iconHeader
	iconData = GetIconData(resFile, "3", iconID) ' Icon Entry
	If IsEmpty(iconData) Then
		WScript.Echo "res://" & resFile & "/3/" & iconID & " not found!" : Exit Sub
	End If
	With CreateObject("SAPI.spFileStream")
		If AscB(iconData) = &H89 Then ' ----- Save as PNG
			.Open iconID & ".png", 2
			.Write iconData
		Else ' ---------- Save as ICO
			.Open iconID & ".ico", 2
			' Общий заголовок (6 байт)
			.Write CInt(0) 'reserved
			.Write CInt(1) 'type
			.Write CInt(1) 'count

			' Заголовок иконки (16 байт)
			iconSize = CLng(LenB(iconData))
			Select Case iconSize
				Case 67624 : iconHeader = Array(CByte(128), CByte(128), CInt(32))
				Case 38056 : iconHeader = Array(CByte(96), CByte(96), CInt(32))
				Case 16936 : iconHeader = Array(CByte(64), CByte(64), CInt(32))
				Case 9640  : iconHeader = Array(CByte(48), CByte(48), CInt(32))
				Case 6760  : iconHeader = Array(CByte(40), CByte(40), CInt(32))
				Case 4264  : iconHeader = Array(CByte(32), CByte(32), CInt(32))
				Case 2440  : iconHeader = Array(CByte(24), CByte(24), CInt(32))
				Case 1720  : iconHeader = Array(CByte(20), CByte(20), CInt(32))
				Case 1128  : iconHeader = Array(CByte(16), CByte(16), CInt(32))
				Case 2216  : iconHeader = Array(CByte(32), CByte(32), CInt(8))
				Case 1384  : iconHeader = Array(CByte(16), CByte(16), CInt(8))
				Case 1736  : iconHeader = Array(CByte(24), CByte(24), CInt(8))
				Case 296   : iconHeader = Array(CByte(16), CByte(16), CInt(4))
				Case 744   : iconHeader = Array(CByte(32), CByte(32), CInt(4))
				Case 488   : iconHeader = Array(CByte(24), CByte(24), CInt(4))
				Case Else  : iconHeader = Array(CByte(32), CByte(32), CInt(0))
			End Select
			.Write CByte(32) 'width
			.Write CByte(32) 'height
			.Write CByte(32) 'colors
			.Write CByte(0) 'reserved
			.Write CInt(0) 'planes
			.Write CInt(0) 'bpp
			.Write iconSize 'size
			.Write CLng(6 + 16) ' offset
			' Содержимое иконки
			.Write iconData
		End If
		.Close
	End With
End Sub

Sub SaveWholeIcon(resFile, groupID)
	Dim groupData, imgCount, offset, pos, nImg, imgSize, arrResOffset

	groupData = GetIconData(resFile, "14", groupID) ' Group Icon
	If IsEmpty(groupData) Then
		WScript.Echo "res://" & resFile & "/14/" & groupID & " not found!" : Exit Sub
	End If
	With CreateObject("SAPI.spFileStream")
		.Open groupID & ".ico", 2

		' Общий заголовок группы иконок (6 байт)
		.Write CInt(GetValue(groupData, pos, 2)) 'reserved
		.Write CInt(GetValue(groupData, pos, 2)) 'type
		imgCount = GetValue(groupData, pos, 2)
		.Write CInt(imgCount) 'count

		' Заголовки иконок (по 16 байт каждая)
		Set arrResOffset = CreateObject("Scripting.Dictionary")
		offset = 6 + 16 * imgCount
		For nImg = 1 To imgCount
			.Write CByte(GetValue(groupData, pos, 1)) 'width
			.Write CByte(GetValue(groupData, pos, 1)) 'height
			.Write CByte(GetValue(groupData, pos, 1)) 'colors
			.Write CByte(GetValue(groupData, pos, 1)) 'reserved
			.Write CInt(GetValue(groupData, pos, 2)) 'planes
			.Write CInt(GetValue(groupData, pos, 2)) 'bpp
			imgSize = CLng(GetValue(groupData, pos, 4))
			.Write imgSize 'size
			arrResOffset.Add arrResOffset.Count, GetValue(groupData, pos, 2) ' offset
			.Write CLng(offset) ' offset
			offset = offset + imgSize
		Next

		' Содержимое иконок
		For nImg = 0 To arrResOffset.Count - 1
			.Write GetIconData(resFile, "3", arrResOffset.Item(nImg)) ' Icon Entry
		Next
		.Close
	End With
End Sub

' Возвращает 1/2/4 байтное число и новое смещение
Function GetValue(data, start, length)
	Dim val, s
	For s = 0 To length - 1
		val = val + AscB(MidB(data, start + s + 1, 1)) * 256 ^ s
	Next
	GetValue = val
	start = start + length
End Function

Function GetIconData(resFile, resType, resID)
	With CreateObject("MSXML2.XMLHTTP")
		.Open "GET", "res://" & resFile & "/" & resType & "/" & resID, False
		On Error Resume Next
		.Send
		GetIconData = .responseBody
	End With
End Function

Xameleon, похоже это - финальный вариант (за неделю не изменил ни строчки - так и выложил). Если есть желание - можешь включить в свой WSC:Script Component.

32

Re: WSC: Script Component для чтения ресурсов из файлов через res протокол

mozers, О ! Отлично ! ) А я пока что никак не успевал заняться. Как освобожусь от рабочих дел - изучу. Спасибо ! )

Передумал переделывать мир. Пашет и так, ну и ладно. Сделаю лучше свой !

33

Re: WSC: Script Component для чтения ресурсов из файлов через res протокол

Интересно, почему при подстановке %COMMANDER_EXE% вместо g:\Total Commander\TOTALCMD.EXE иконка сохраняется, но возникает неопознаная ошибка на строке с .Open "GET", "res://"?

mozers пишет:

Пусто? Тогда меняем во всех примерах res://shell32.dll/3/1 на res://c:\Program Files (x86)\Skype\Phone\Skype.exe/3/5 - там точно png-шка имеется.

А перед этим не забыть сменить систему на x64 и установить скайп.

34 (изменено: Xameleon, 2017-03-01 23:13:50)

Re: WSC: Script Component для чтения ресурсов из файлов через res протокол

Flasher, мда. Скайп не панацея. )

mozers, решил ещё подробнее поковырять "тело иконок". И тут заметил - в заголовке тела иконки имеем:

typedef struct tagBITMAPINFOHEADER {
  DWORD biSize;
  LONG  biWidth;
  LONG  biHeight;
  WORD  biPlanes;
  WORD  biBitCount;
  DWORD biCompression;
  DWORD biSizeImage;
  LONG  biXPelsPerMeter;
  LONG  biYPelsPerMeter;
  DWORD biClrUsed;
  DWORD biClrImportant;
} BITMAPINFOHEADER, *PBITMAPINFOHEADER;

А раз так, то этого вполне достаточно для составления заголовка иконки. Вот и переделал Ваш код слегка. Благодаря вашей заготовке разобрался с offset. Внёс следующие изменения:
1) Вместо XMLHTTP использовал CDO.Message
2) Переделал чтение группы иконок. Решил, что собирать весь заголовок по байтам накладно, поэтому сделал его блочное чтение из ресурсов, что подсократило код и количество вызовов "Write"
3) Для отдельных иконок стал собирать информацию из BITMAPINFOHEADER, который содержится в теле ресурса иконки


Option Explicit
Dim oResReader
Set oResReader = new cResReader
oResReader.Open "shell32.dll"

On Error Resume Next
With oResReader
	SaveToFile .ReadIcon("1"), "ICON1.png"
	SaveToFile .ReadIcon("2"), "ICON2.ico"
	SaveToFile .ReadIcon("3"), "ICON3.ico"
	SaveToFile .ReadIcon("4"), "ICON4.ico"
	SaveToFile .ReadIcon("5"), "ICON5.ico"
	SaveToFile .ReadIcon("6"), "ICON6.ico"
	SaveToFile .ReadIcon("7"), "ICON7.ico"
	SaveToFile .ReadIcon("8"), "ICON8.ico"
	SaveToFile .ReadIconGroup("62998"), "FULL_ICON.ico"
End With

MsgBox "DONE !",vbInformation

Sub SaveToFile(data, fileName)
	With CreateObject("ADODB.Stream")
		.Type = 1
		.Open
		.Write data
		.SaveToFile fileName, 2
	End With
End Sub

Class cResReader
	Dim FileName, Source
	Private Sub Class_Initialize()
		'Saving class name for using as source with err.raise
		Source = TypeName(Me)
	End Sub
		
	'Sub for selecting file for parsing
	Sub Open(Path)
		FileName = Path
	End Sub
	
	'Function for loading single icon
	Function ReadIcon(Id)
		Dim Stream, Buffer, ColorCount, BitCount
		'3 - RT_ICON
		Set Stream = ReadRes(3,Id)
		'Reading 5 field of BITMAPINFOHEADER [DWORD biSize; LONG biWIdth; LONG  biHeight; WORD  biPlanes; WORD  biBitCount]
		Buffer = Stream.Read(16)
		'Rewinding Stream for second use
		Stream.Position = 0
		'Checking for PNG prefix
		If InStrB(1,Buffer,ChrB(&H89) & ChrB(&H50) & ChrB(&H4E) & ChrB(&H47)) Then
			ReadIcon = Stream.Read
		Else
			'Calculating color Count
			BitCount = ToNum(MidB(Buffer,15,2))
			ColorCount = 2 ^ BitCount: if ColorCount > 32 Then ColorCount = 0
			'Building icon data
			With CreateObject("SAPI.spMemoryStream")
				.Write CInt(0)								'idReserved 	(must be 0)
				.Write CInt(1)								'idType			(must be 1)
				.Write CInt(1)								'idCount		(1 icon)
				.Write CByte(ToNum(MidB(Buffer,5,4)))		'bWIdth			(biWIdth)
				.Write CByte(ToNum(MidB(Buffer,9,4)))		'bHeight		(biHeight)
				.Write CByte(ColorCount)					'bColorCount	(2 ^ biBitCount [8,16,32] if more than 0)
				.Write CByte(0)								'bReserved		(always 0)
				.Write CInt(ToNum(MidB(Buffer,13,2)))		'wPlanes		(biPlanes)
				.Write CInt(BitCount)						'wBitCount		(biBitCount)
				.Write CLng(Stream.Size)					'dwBytesInRes	(stream.Size)
				.Write Clng(22)								'dwImageOffset
				.Write Stream.Read							
				ReadIcon = .GetData
			End With
		End if
	End Function
	
	'Function for loading icon group
	Function ReadIconGroup(GroupId)
		Dim Buffer, Count, Id, Offset, Size, Stream, i
		'Reading resource data (14 - RT_ICON_GROUP)
		Set Stream = ReadRes(14,GroupId)
		'Reading GRPICONDIR struct
		Buffer = Stream.Read(6)
		'Checking fields idReserved (must be 0) and IdType (1 for icons)
		If ToNum(MidB(Buffer,1,2)) <> 0 Then Err.Raise vbObjectError + 1, Source, "Invalid value in reserved field"
		If ToNum(MidB(Buffer,3,2)) <> 1 Then Err.Raise vbObjectError + 2, Source, "Invalid resource type"
		'Reading icons count
		Count = ToNum(MidB(Buffer,5,2))
		'Prepairing array for icon id-s (for future loading it's data)
		Redim Ids(Count-1)
		'Creating stream for data
		With CreateObject("SAPI.spMemoryStream")
			'Calculating first offset [GRPICONDIR size + GRPICONDIRENTRY size * icons Count]
			Offset = 6 + 16 * Count
			'Writing header to stream
			.Write Buffer
			For i=0 to Count-1
				'Reading Icon fields [bWidth, bHeight, bColors, bReserved, wPlanes, BitCount, dwBytesInRes] except [nId]
				Buffer = Stream.Read(12)
				'Writing ICON header block to stream
				.Write Buffer
				'Reading DWORD dwBytesInRes
				Size = Clng(ToNum(RightB(Buffer,4)))
				'Reading Icon Id for future reading icon data
				Ids(i) = ToNum(Stream.Read(2))
				'Writing DWORD dwImageOffset
				.Write CLng(Offset)
				'Calculating next Offset
				Offset = Offset + Size
			Next
			'Reading icon "bodies" from resource and writing to stream 
			For Each Id in Ids
				.Write ReadRes(3,Id).Read
			Next
			ReadIconGroup = .GetData
		End With
	End Function
	
	'Function for loading data from url
	Private Function ReadRes(ResType,Id)
		Set ReadRes = CreateObject("CDO.Message") _
		.AddAttachment("res://" & FileName & "/" & ResType & "/" & Id) _
		.GetDecodedContentStream
		'Enabling binary mode
		ReadRes.Type = 1
	End Function
	
	'Function for converting bytes to number
	Private Function ToNum(b)
		Dim i: For i = 1 To LenB(b)
			ToNum = ToNum Or AscB(MidB(b, i, 1)) * &H100 ^ (i - 1)
		Next
	End Function
End Class
Передумал переделывать мир. Пашет и так, ну и ладно. Сделаю лучше свой !