Извлечение MAINICON из любого exe файла.

[hapera2]

Нужно извлечь иконку из любой программы. Использовал:

 function GetShellFileIcon(const FileName : string) : HICON;
var SYSIL : THandle;
SFI : TSHFileInfo;
begin
Result:=0;
FillChar(SFI, SizeOf(SFI), 0);
SysIL := SHGetFileInfo(PChar(FileName), 0, SFI, SizeOf(SFI), SHGFI_LARGEICON or SHGFI_SYSICONINDEX);
if SysIL <> 0
then Result:=ImageList_GetIcon(SysIL, SFI.iIcon, 0)
else RaiseLastOSError;
end;

Вызывал таким образом:

icon1:=TIcon.Create;
icon1.Handle:=GetShellFileIcon(label2.caption);

icon1.SaveToFile('pricon.ico');
icon1.Free;

Все бы ничего, но вот только качество экспортированной иконки мягко говоря не очень.
А вот если бы извлекать группу иконок (icon group), как это делает Resource Hacker, было бы здорово. Есть идеи?

[hapera2]

Неужели нету идей в силу того чтобы из exe извлечь группу иконок в ico файл?

[indexx]

Попробовал код отсюда, качество нормальное. Что не устраивает?

[hapera2]

Функция извлекает 32/32 даже из обычной иконки 256/256
Как извлечь иконку правильно и со всеми размерами в формате ico?

[Аватар]

http://programmersforum.ru/showthread.php?t=254997

[hapera2]

Сообщение от Аватар

http://programmersforum.ru/showthread.php?t=254997

Можешь ткнуть пальцем, что именно оттуда брать? Там вроде речь немножечко не о том вроде...

[Аватар]

В конце есть все вплоть до получения HIcon. Из него файл можно примерно так

var xIcon: TIcon;
     IconHandle: HIcon;
...
  xIcon:=TIcon.Create;
  xIcon.Handle:=IconHandle;
  xIcon.SaveToFile('file.ico');
  xIcon.Free;

[hapera2]

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

type
  GRPICONDIR = packed record
    idReserved:Word;//зарезервировано, всегда 0
    idType:Word;    //тип образа: 1 - иконка, 0 - курсор
    idCount:Word;   //число иконок типа RT_ICON
  end;
  PGRPICONDIR = ^GRPICONDIR;

  GRPICONDIRENTRY = packed record
    bWidth:Byte;       //ширина иконки в пикселях (если больше 255, то 0)
    bHeight:Byte;      //высота иконки в пикселях (если больше 255, то 0)
    bColorCount:Byte;  //число цветов (если больше 255, то 0)
    bReserved:Byte;    //зарезервировано, всегда 0
    wPlanes:Word;      //?
    wBitCount:Word;    //глубина цвета, в битах
    dwBytesInRes:DWORD;//размер в байтах битового образа иконки
    nId:Word;          //ID ресурса иконки
  end;
  PGRPICONDIRENTRY = ^GRPICONDIRENTRY;

procedure TForm1.Button1Click(Sender: TObject);
var
 pElm: PGRPICONDIRENTRY;
   HRsrcIcon,DataIcon: THandle;
 LockIcon: Pointer;
    Icon: HIcon;
    pGrp: PGRPICONDIR;
    xIcon: TIcon;

     xModule: hModule;
begin
xModule:= LoadLibrary('C:\Windows\notepad.exe');
pElm:=PGRPICONDIRENTRY(DWORD(pGrp)+SizeOf(GRPICONDIR));
HRsrcIcon:=FindResource(xModule,MakeIntResource(pElm^.nId),RT_ICON);
DataIcon:=LoadResource(xModule,HRsrcIcon);
 LockIcon:=LockResource(DataIcon);
          Icon:=CreateIconFromResourceEx(LockIcon,SizeofResource(xModule,DataIcon),True,$00030000,0,0,LR_DEFAULTCOLOR);
       xIcon:=TIcon.Create;
  xIcon.Handle:=Icon;
  xIcon.SaveToFile('file.ico');
  xIcon.Free;

end;

end.

При нажатии на кнопку icon image is not valid.
Если в debug режиме запускать, на строке:

Icon:=CreateIconFromResourceEx(LockIcon,SizeofResource(xModule,DataIcon),True,$00030000,0,0,LR_DEFAULTCOLOR);

First chance exception at $75F172A1. Exception class $C0000005 with message 'access violation at 0x75f172a1: read of address 0x00000000'. Process Project1.exe (2436)

[hapera2]

Может по-проще что-то есть?

[indexx]

Не знаю попроще ли, но можно обратиться непосредственно к бинару, и вычитать файл побайтово. По этому способу без проблем вычитывал PNG картинки из различных RES файлов, и EXE.