Mega Code Archive

 
Categories / Delphi / Files
 

How to get associated icon of a file shortcut

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.