Title: How to get associated icon of a file shortcut
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.