Как извлечь иконку из файла ярлыка?

Previous  Top  Next

    
 

 

How to get icon from a shortcut file ?

 

I have found that if you use a ListView component,

to show a list of files in any folder that contains shortcuts,

then the shortcut icons do not appear correctly -

they do not show the true icon of the application to which they relate.

 

However, there is a a very useful feature of SHGetFileInfo,

which is SHGFI_LINKOVERLAY. This adds the shortcut "arrow",

which is shown in the bottom left corner of any shortcut icon.

The demo code below shows the basic use of the SHGFI_LINKOVERLAY feature.

I have added code to this demo, to distingiush between shortcut and non-shortcut files -

without this code, it will overlay the shortcut "arrow" irrespective of the file type.

 

To show the icon of a shortcut, the following code can be used as a demo:

 

1. Add the following components to a new project, and adjust their

properties according to the code below: }

Code:

// Code for DFM file:

 

object Form1: TForm1

Left = 379

Top = 355

Width = 479

Height = 382

Caption = 'Get Icon from Shortcut File'

Color = clBtnFace

Font.Charset = DEFAULT_CHARSET

Font.Color = clWindowText

Font.Height = -11

Font.Name = 'MS Sans Serif'

Font.Style = []

OldCreateOrder = False

PixelsPerInch = 96

TextHeight = 13

object ListView: TListView

   Left = 0

   Top = 73

   Width = 471

   Height = 275

   Align = alClient

   Columns = <

     item

       Width = 100

     end

     item

       Width = 100

     end>

   SmallImages = imgList

   TabOrder = 0

   ViewStyle = vsReport

end

object Panel: TPanel

   Left = 0

   Top = 0

   Width = 471

   Height = 73

   Align = alTop

   TabOrder = 1

   object btnGetFile: TButton

     Left = 16

     Top = 8

     Width = 75

     Height = 25

     Caption = 'Get file'

     TabOrder = 0

     OnClick = btnGetFileClick

   end

   object btnGetIcon: TButton

     Left = 104

     Top = 8

     Width = 75

     Height = 25

     Caption = 'Get icon'

     TabOrder = 1

     OnClick = btnGetIconClick

   end

   object edFileName: TEdit

     Left = 16

     Top = 40

     Width = 441

     Height = 21

     TabOrder = 2

   end

end

object dlgOpen: TOpenDialog

   Filter = 'Shortcut files|*.lnk|All files|*.*'

   Options = [ofHideReadOnly, ofNoDereferenceLinks,

     ofEnableSizing]  // - this is important !

   Left = 248

   Top = 8

end

object imgList: TImageList

   BlendColor = clWhite

   BkColor = clWhite

   Masked = False

   ShareImages = True

   Left = 216

   Top = 8

end

end

 

Code:

// 2. Add the code to the PAS file below:

 

unit cdShortCutIcon;

 

interface

 

uses

Windows, Messages, SysUtils, Variants, Graphics, Controls, Forms,

Dialogs, Buttons, ExtCtrls, StdCtrls, StrUtils, ShellAPI,

CommCtrl, ImgList, ComCtrls, Classes;

 

type

TForm1 = class(TForm)

   dlgOpen: TOpenDialog;

   ListView: TListView;

   imgList: TImageList;

   Panel: TPanel;

   btnGetFile: TButton;

   btnGetIcon: TButton;

   edFileName: TEdit;

   procedure btnGetFileClick(Sender: TObject);

   procedure btnGetIconClick(Sender: TObject);

private

   { Private declarations }

public

   { Public declarations }

end;

 

var

Form1: TForm1;

 

implementation

 

{$R *.dfm}

 

procedure TForm1.btnGetFileClick(Sender: TObject);

begin

{ choose file to get icon from }

if dlgOpen.Execute then edFileName.Text := dlgOpen.FileName;

end;

 

procedure TForm1.btnGetIconClick(Sender: TObject);

var

Icon : TIcon;

ListItem : TListItem;

shInfo : TSHFileInfo;

sFileType : string;

begin

{ initialise ListView and Icon }

ListView.SmallImages := imgList;

Icon := TIcon.Create;

 

try

   ListView.Items.BeginUpdate;

   ListItem := listview.items.add;{ Initialise ListView.Item.Add }

 

   { get details about file type from SHGetFileInfo }

   SHGetFileInfo(PChar(edFileName.Text), 0, shInfo,

     SizeOf(shInfo), SHGFI_TYPENAME);

   sFileType := shInfo.szTypeName;

 

   { is this a shortcut file ? }

   if shInfo.szTypeName = 'Shortcut' then

     SHGetFileInfo(PChar(edFileName.Text), 0, shInfo, SizeOf(shInfo),

       SHGFI_LINKOVERLAY or SHGFI_ICON or

       SHGFI_SMALLICON or SHGFI_SYSICONINDEX)

   else

     { ...otherwise treat it as a normal file}

     SHGetFileInfo(PChar(edFileName.Text), 0, shInfo, SizeOf(shInfo),

       SHGFI_ICON or SHGFI_SMALLICON or

       SHGFI_SYSICONINDEX);

 

   { assign icon }

   Icon.Handle := shInfo.hIcon;

 

   { List File name, Icon and FileType in ListView}

   ListItem.Caption := ExtractFileName(edFileName.Text);    //...add filename

   ListItem.SubItems.Add(sFileType); //...and filetype..

   ListItem.ImageIndex := imgList.AddIcon(Icon); //...and icon.

finally

   ListView.Items.EndUpdate; //..free memory on icon and clean up.

   sFileType := '';

   Icon.Free;

end;

end;

 

 

end.

©Drkb::02348

 

 


 

 

 

Code:

{  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.

}

 

 

 

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.

 

 

 

©Drkb::02349

http://delphiworld.narod.ru/

DelphiWorld 6.0