Однажды встретил одну идею для написания программы - грабер иконок. И вот после недолгого поиска решения задачи, мне удалось навоять следующее. При выборе пункта меню "Открыть", появляется диалог для выбора файла исполняемой программы, библиотеки DLL или иконки. После выбора файла мы получем имя этого файла без расширения. Далее извлекаем иконки или иконку и сохраняем их в специально созданную директорию.

Var HIco   : HIcon;
    TIco   : TIcon;
    Number : Integer;
...

procedure TForm1.mnuOpenClick(Sender: TObject);
Var I, J    : Integer;
    IcoName : String;
begin
 I:=0;
 J:=0;
 TIco:=TIcon.Create;
 If OpenDialog1.Execute Then
   Begin
     // Получаем имя файла без расширения
     Repeat
       Inc(J);
       If ExtractFileName(OpenDialog1.FileName)[J] <> '.' Then
         IcoName:=IcoName + ExtractFileName(OpenDialog1.FileName)[J];
       Form1.Caption:=IcoName;
     Until (Length(ExtractFileName(OpenDialog1.FileName))= 0) OR
           (ExtractFileName(OpenDialog1.FileName)[J] = '.');
     
     // Извлекаем иконки из файла
     Repeat
       HIco:=ExtractIcon(Handle, PChar(OpenDialog1.FileName), I);
       If HIco > 0 Then
         Begin
           TIco.Handle:=HIco;
           TIco.SaveToFile(ExtractFilePath(Application.ExeName) + 'Extract_Icons\' +
                           IcoName + '#' + IntToStr(I) + '.ico');
           Inc(I);
         End;
     Until HIco = 0;
   End;
 TIco.Free;
end;

А вот и второй способ решения задачи с использование компонента TImage. Здесь нет ничего нового, вот только теперь иконки можно наблюдать визуально:

... Var Image1 : TImage; ... begin ... Image1:=TImage.Create(Application); Image1.Parent:=Form1; // Извлекаем иконки из файла Repeat HIco:=ExtractIcon(Handle, PChar(OpenDialog1.FileName), I); If HIco > 0 Then Begin TIco.Handle:=HIco; Image1.Picture.Assign(TIco); Image1.Picture.SaveToFile(ExtractFilePath(Application.ExeName) + 'Extract_Icons\' + IcoName + '#' + IntToStr(I) + '.ico'); Inc(I); End; Until HIco = 0; Image1.Free; ... end;