{enter a filename extension in the edit box and
click the button to locate the associated icon for that
file type from the windows registry
a note about this delphi 3 version
while a small icon is extracted and displayed in the image
it is displayed as a crappy looking large icon
and it is not possible to change the icon size without
raising an exception
this does not happen in delphi 5 and if you are using
version 3 this is a puzzle you might have to solve
to be able to access the small sized icon}

{http://www.awitness.org/delphi_pascal_tutorial/index.html}

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    Image1: TImage;
    Image2: TImage;
    Label1: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure RegistryIconExtraction;


  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject); {find icon for file extension}
begin
        If Edit1.Text<>'' then
           RegistryIconExtraction;
end;

procedure TForm1.RegistryIconExtraction;
var
    RegKey : TRegistry;
    IconPos : integer;
    Extension, AssocAppInfo, s : string;
    ExtractPath, FileName : string;
    IconHandle, PLargeIcon, PSmallIcon : HICON;


begin


     IconHandle := 0;  {init var}
     Extension := lowercase(Edit1.Text);
     if Extension[1] <> '.' then Extension := '.' + Extension;
     If (Extension='.exe') or (Extension='.ico') then begin
        Messagedlg('Extract ' + Extension + ' from a file' + chr(13) +
                   'rather than from the registry' + chr(13) +
                   'You can also substitute com icon for exe'
                   , mtinformation, [mbok],0);
        Exit;
     end;

     try
        RegKey := TRegistry.Create;
     except
         MessageDlg('Error creating Registry key', mtError, [mbok],0);
         Exit;
     end;
        {     KEY_QUERY_VALUE	grants permission to query subkey data.   }
     RegKey.RootKey := HKEY_CLASSES_ROOT; {set folder for icon info lookup}
     if RegKey.OpenKey(Extension, false) then begin {extension key exists?}
                                   {false -> do not create the key}
        try
        AssocAppInfo := RegKey.ReadString('');  {read app key}
        RegKey.CloseKey;
        except
         MessageDlg('Error opening registry key', mtError, [mbok],0);
         RegKey.Free;
         Exit;
        end;
     end;
     if ((AssocAppInfo <> '') and  {app key and icon info exists?}
            (RegKey.OpenKey(AssocAppInfo + '\DefaultIcon', false))) then begin
        try
         ExtractPath := RegKey.ReadString(''); {icon path}
         RegKey.CloseKey;
        except
         MessageDlg('Error reading Path string from registry key', mtError,
                    [mbok],0);
         RegKey.Free;
         Exit;
        end;
     end;
     RegKey.Free;  {free memory}


     {IconPos after comma in key  ie: C:\Program Files\Winzip\Winzip.Exe,0}

     {did we get a key for icon, does IconPos exist after comma seperator?}
     If ((ExtractPath <> '') and (pos(',', ExtractPath) <> 0)) then begin
        Label1.Caption:=ExtractPath;
        {Filename in registry key is before the comma seperator}
        FileName := Copy(ExtractPath, 1, Pos(',', ExtractPath) - 1);
        {extract the icon Index from after the comma in the ExtractPath string}

        try
           IconPos := StrToInt(copy(ExtractPath, Pos(',', ExtractPath) + 1,
                           Length(ExtractPath) - Pos(',', ExtractPath) + 1));
        except
            MessageDlg('Icon Position number did not exist in registry key',
                 mtError, [mbok], 0);
            Exit;
        end;
            {Filename : convert to Windows Api Pchar null terminated string
            IconPos : position icon in file - from registry key
            var Large and small HICON handles returned in PLarge/SmallIcon
            '1' = number of icons to retrieve}
        IconHandle := ExtractIconEx(PChar(FileName), IconPos,
                               PLargeIcon, PSmallIcon, 1);
        {IconHandle = 0 no icons  = 1 not exe dll or ico file-> default icon?}
        {otherwise IconHandle = handle to icon}
        If ((IconHandle <> 0) and (IconHandle <> 1)) then begin
                   If not (Image1.Picture.Icon.Empty) then
                        Image1.Picture.Icon.ReleaseHandle;
                   If not (Image2.Picture.Icon.Empty) then
                        Image2.Picture.Icon.ReleaseHandle;
                    Image1.Picture.Icon.Handle := PSmallIcon;
                    Image2.Picture.Icon.Handle := PLargeIcon;
        end;

     end;

     {failure -> default icon or check the Shell32.Dll, check all possible
     causes of the failure to find icon in code above}
     If ((ExtractPath = '') or (pos(',', ExtractPath) = 0) or (IconHandle = 0)
         or (IconHandle = 1)) then begin
            s := 'Registry search failed...';
             If ExtractPath = '' then
               s:= 'The Key did not exist or file extension not registered';
            If pos(',', ExtractPath) = 0 then
               s := 'No associated icon information';
            If IconHandle = 0 then
               s := 'No icons in file';
            MessageDlg(s, mtError, [mbok], 0);
     end;
end;



end.