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.

Anda Telah Membaca Asosiasi Icon dari Shortcut

Semoga Artikel Asosiasi Icon dari Shortcut Bisa Bermanfaat untuk kita semua. Jika Ada Hal yang ingin ditanyakan, Silahkan Komentar atau Hubungi kami via Web Chat yang tersedia