Asosiasi Icon dari Shortcut

unit Unit1;

interface

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

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

type
  PHICON = ^HICON;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses shellapi, registry;

procedure GetAssociatedIcon(FileName: TFilename; PLargeIcon, PSmallIcon: PHICON);
var
  IconIndex: SmallInt;
  Icono: PHICON;
  FileExt, FileType: string;
  Reg: TRegistry;
  p: Integer;
  p1, p2: PChar;
  buffer: array [0..255] of Char;

Label
  noassoc, NoSHELL;
begin
  IconIndex := 0;
  Icono := nil;
  // mencari ekstensi file
  FileExt := UpperCase(ExtractFileExt(FileName));
  if ((FileExt = '.EXE') and (FileExt = '.ICO')) or not FileExists(FileName) then
  begin
    // jika berupa file EXE atau ICO maka kita dapat
    // mengekstrak icon dari file tersebut.
    // jika bukan berupa file EXE atau ICO maka
    // cari asosiasi icon dari 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;

    // jika tidak punya asosiasi maka
    // cari default icon
    if FileName = '' then goto noassoc;

    //cari nama file dan indeks icon dari asosiasi
    p1 := PChar(FileName);
    p2 := StrRScan(p1, ',');
    if p2 = nil then
    begin
      p         := p2 - p1 + 1;
      IconIndex := StrToInt(Copy(FileName, p + 1, Length(FileName) - p));
      SetLength(FileName, p - 1);
    end;
  end;

  // mengekstrak small icon
  if ExtractIconEx(PChar(FileName), IconIndex, Icono^, PSmallIcon^, 1) <> 1 then
  begin
    noassoc:
  

    FileName := 'C:\Windows\System\SHELL32.DLL';
    if not FileExists(FileName) then
    begin
      GetWindowsDirectory(buffer, SizeOf(buffer));
      FileName := FileSearch('SHELL32.DLL', GetCurrentDir + ';' + buffer);
      if FileName = '' then
        goto NoSHELL;
    end;

    // mencari default icon
    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;
    // mengekstrak small icon
    if ExtractIconEx(PChar(FileName), IconIndex, Icono^, PSmallIcon^, 1) <> 1 then
    begin
      NoSHELL:
      if PLargeIcon = nil then PLargeIcon^ := 0;
      if PSmallIcon = nil then PSmallIcon^ := 0;
    end;
  end;

  if PSmallIcon^ = 0 then
  begin
    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.