Получить иконку файла по ярлыку

Delphi , Графика и Игры , ICO

Оформил: DeeCo
Автор: http://www.swissdelphicenter.ch

{ 
  Comment: 
  The procedure GetAssociatedIcon, trys via Registry to get the 
  icon(should work for small and big icons) that is associated with 
  the files shown in the explorer. 

  This is not my work. But I want to distribute it to you, because 
  it was really hard to find a corresonding document. 
  Thanks SuperTrax. 
}


 { 
  Kommentar: 
  Die Prozedure GetAssociatedIcon versucht uber die Registrierung 
  das Icon der Datei, wie im Explorer angezeigt, herauszubekommen. 
  (Sollte fur grosse und kleine funktionieren) 

  Dies ist nicht mein Werk. Ich mochte es nur fur andere zuganglich 
  machen, weil ich sehr lange gebraucht habe, um ein entsprechendes 
  Dokument zu finden. 
}

 unit AIconos;

 interface

 uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   ExtCtrls, StdCtrls, FileCtrl;

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

 type
   PHICON = ^HICON;

 var
   Form1: TForm1;
   PLargeIcon, PSmallIcon: phicon;

 implementation

 uses shellapi, registry;

 {$R *.DFM}

 procedure GetAssociatedIcon(FileName: TFilename; PLargeIcon, PSmallIcon: PHICON);
 var
   IconIndex: SmallInt;  // Position of the icon in the file 
  Icono: PHICON;       // The LargeIcon parameter of ExtractIconEx 
  FileExt, FileType: string;
   Reg: TRegistry;
   p: Integer;
   p1, p2: PChar;
   buffer: array [0..255] of Char;

 Label
   noassoc, NoSHELL; // ugly! but I use it, to not modify to much the original code :( 
begin
   IconIndex := 0;
   Icono := nil;
   // ;Get the extension of the file 
  FileExt := UpperCase(ExtractFileExt(FileName));
   if ((FileExt  '.EXE') and (FileExt  '.ICO')) or not FileExists(FileName) then
   begin
     // If the file is an EXE or ICO and exists, then we can 
    // extract the icon from that file. Otherwise here we try 
    // to find the icon in the Windows Registry. 
    Reg := nil;
     try
       Reg := TRegistry.Create;
       Reg.RootKey := HKEY_CLASSES_ROOT;
       if FileExt = '.EXE' then FileExt := '.COM';
       if Reg.OpenKeyReadOnly(FileExt) then
         try
           FileType := Reg.ReadString('');
         finally
           Reg.CloseKey;
         end;
       if (FileType <> '') and Reg.OpenKeyReadOnly(FileType + '\DefaultIcon') then
         try
           FileName := Reg.ReadString('');
         finally
           Reg.CloseKey;
         end;
     finally
       Reg.Free;
     end;

     // If there is not association then lets try to 
    // get the default icon 
    if FileName = '' then goto noassoc;

     // Get file name and icon index from the association 
    // ('"File\Name",IconIndex') 
    p1 := PChar(FileName);
     p2 := StrRScan(p1, ',');
     if p2  nil then
     begin
       p         := p2 - p1 + 1; // Position de la coma 
      IconIndex := StrToInt(Copy(FileName, p + 1, Length(FileName) - p));
       SetLength(FileName, p - 1);
     end;
   end; //if ((FileExt  '.EX ... 

  // Try to extract the small icon 
  if ExtractIconEx(PChar(FileName), IconIndex, Icono^, PSmallIcon^, 1) <> 1 then
   begin
     noassoc:
     // That code is executed only if the ExtractIconEx return a value but 1 
    // There is not associated icon 
    // try to get the default icon from SHELL32.DLL 

    FileName := 'C:\Windows\System\SHELL32.DLL';
     if not FileExists(FileName) then
     begin  //If SHELL32.DLL is not in Windows\System then 
      GetWindowsDirectory(buffer, SizeOf(buffer));
       //Search in the current directory and in the windows directory 
      FileName := FileSearch('SHELL32.DLL', GetCurrentDir + ';' + buffer);
       if FileName = '' then
         goto NoSHELL; //the file SHELL32.DLL is not in the system 
    end;

     // Determine the default icon for the file extension 
    if (FileExt = '.DOC') then IconIndex := 1
     else if (FileExt = '.EXE') or (FileExt = '.COM') then IconIndex := 2
     else if (FileExt = '.HLP') then IconIndex := 23
     else if (FileExt = '.INI') or (FileExt = '.INF') then IconIndex := 63
     else if (FileExt = '.TXT') then IconIndex := 64
     else if (FileExt = '.BAT') then IconIndex := 65
     else if (FileExt = '.DLL') or (FileExt = '.SYS') or (FileExt = '.VBX') or
       (FileExt = '.OCX') or (FileExt = '.VXD') then IconIndex := 66
     else if (FileExt = '.FON') then IconIndex := 67
     else if (FileExt = '.TTF') then IconIndex := 68
     else if (FileExt = '.FOT') then IconIndex := 69
     else
       IconIndex := 0;
     // Try to extract the small icon 
    if ExtractIconEx(PChar(FileName), IconIndex, Icono^, PSmallIcon^, 1) <> 1 then
     begin
       //That code is executed only if the ExtractIconEx return a value but 1 
      // Fallo encontrar el icono. Solo "regresar" ceros. 
      NoSHELL:
       if PLargeIcon  nil then PLargeIcon^ := 0;
       if PSmallIcon  nil then PSmallIcon^ := 0;
     end;
   end; //if ExtractIconEx 

  if PSmallIcon^ 0 then
   begin //If there is an small icon then extract the large icon. 
    PLargeIcon^ := ExtractIcon(Application.Handle, PChar(FileName), IconIndex);
     if PLargeIcon^ = Null then
       PLargeIcon^ := 0;
   end;
 end;

 procedure TForm1.Button1Click(Sender: TObject);
 var
   SmallIcon, LargeIcon: HIcon;
   Icon: TIcon;
 begin
   if not (OpenDialog1.Execute) then
     Exit;
   Icon := TIcon.Create;
   try
     GetAssociatedIcon(OpenDialog1.FileName, @LargeIcon, @SmallIcon);
     if LargeIcon <> 0 then
     begin
       Icon.Handle := LargeIcon;
       Image2.Picture.icon := Icon;
     end;
     if SmallIcon <> 0 then
     begin
       Icon.Handle := SmallIcon;
       Image1.Picture.icon := Icon;
     end;
   finally
     Icon.Destroy;
   end;
 end;

 end.

Перевод контента на русский язык:

Это программное обеспечение Delphi, которое извлекает иконку, связанную с файлом, используя реестр Windows и Shell API. Вот разбивка кода:

Процедура GetAssociatedIcon

1. Процедура GetAssociatedIcon принимает три параметра: FileName (TFilename), PLargeIcon (PHICON, указатель на HICON) и PSmallIcon (также PHICON).
2. Она извлекает расширение файла из FileName.
3. Если файл является EXE или ICO-файлом, она пытается извлечь иконку напрямую из этого файла.
4. В противном случае, она пытается найти связанную иконку в реестре Windows, поиска расширения файла под ключом HKEY_CLASSES_ROOT и затем поиска умолчательной иконки для этого типа файлов.
5. Если не находит ассоциацию, она падает обратно к попытке получить умолчательную иконку из SHELL32.DLL.
6. Процедура возвращает большую иконку (PLargeIcon) и маленькую иконку (PSmallIcon), если они доступны.

Обработчик события Button1Click

1. Это обработчик события, который вызывается при клике кнопки "Открыть" (открывает диалоговое окно открытия).
2. Он извлекает имя файла из диалогового окна открытия с помощью OpenDialog1.FileName.
3. Он вызывает процедуру GetAssociatedIcon, передавая в нее имя файла и указатели на большие и маленькие иконки (LargeIcon и SmallIcon соответственно).
4. Если обе иконки доступны, он создает объект TIcon и присваивает ему большую иконку.
5. Затем он устанавливает свойство "picture" для двух контролов изображения (Image1 и Image2) с созданной иконкой.

Замечания

• Код использует реестр Windows и Shell API, что является специфичным для платформы Windows.
• Процедура GetAssociatedIcon не является robust и может не работать для всех типов файлов или сценариев. Например, она предполагает, что умолчательная иконка для типа файла хранится в реестре под тем же ключом, что и файл тип himself.
• Код использует устаревшие синтаксис Delphi и константы (например, TRegistry, HKEY_CLASSES_ROOT). Он может потребовать обновления, чтобы работать с современными версиями Delphi.

Альтернативное решение

Более robust подход будет использовать функции Windows API ExtractIconEx и GetClassLongW для извлечения ассоцированной иконки для файла. Вот пример:

uses
  WinAPI;

procedure GetAssociatedIcon(FileName: TFilename; out LargeIcon, SmallIcon: HICON);
var
  IconIndex: Integer;
begin
   // Извлекаем индекс иконки из реестра или расширения файла
  IconIndex := ...

   // Извлекаем большие и маленькие иконки с помощью ExtractIconEx
  if not ExtractIconEx(PChar(FileName), IconIndex, @LargeIcon, @SmallIcon, 1) then
    raise Exception.Create('Failed to extract icon');
end;

Этот подход более платформо-независим и гибок, чем оригинальный код. Однако он все еще зависит от Windows API и может потребовать дополнительной обработки ошибок и тестирования для различных типов файлов и сценариев.

Получение иконки файла по ярлыку: процедура GetAssociatedIcon получает иконку файла, связанную с ним в системе Windows, а также может извлечь иконку из файла или SHELL32.DLL.

Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS

:: Главная :: ICO ::