extracting any file icon

[xartas]

This is the full unit's source code for a program that extracts and saves file icons:

{Place 2 buttons, one open dialog, one save dialog, one image and one bevel on your main form. Note: I used Torry's buttons, replace them by standard buttons if you don't have Torry's components.}

unit IcExtractor;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, Torrybtn, ShellAPI;

type
TMainForm = class(TForm)
ExIcTorryButton: TTorryButton;
SvIcTorryButton: TTorryButton;
OpenIcDialog: TOpenDialog;
SaveIcDialog: TSaveDialog;
IconBevel: TBevel;
IconImage: TImage;
procedure ExIcTorryButtonClick(Sender: TObject);
procedure SvIcTorryButtonClick(Sender: TObject);
private
{ Private declarations }
function GetFileIcon(FileName: string; var DocType: string): TIcon;
public
{ Public declarations }
end;

var
MainForm: TMainForm;

implementation

{$R *.DFM}

function TMainForm.GetFileIcon(FileName: string; var DocType: string): TIcon;
var
Info: SHFILEINFO;
begin
FillChar(Info, SizeOf(Info), 0);
Result := TIcon.Create;
SHGetFileInfo(PChar(FileName), 0, Info, SizeOf(Info), SHGFI_ICON or SHGFI_TYPENAME);
DocType := Info.szTypeName;
Result.Handle := Info.hIcon;
end;

procedure TMainForm.ExIcTorryButtonClick(Sender: TObject);
var
Icon: TIcon;
DocType: string;
begin
with OpenIcDialog do
try
if not Execute then System.Exit;
Icon := GetFileIcon(FileName, DocType);
try
IconImage.Picture.Icon.Assign(Icon);
SvIcTorryButton.Enabled:=true;
finally
Icon.Free;
end;
finally
end;
end;

procedure TMainForm.SvIcTorryButtonClick(Sender: TObject);
begin
with SaveIcDialog do
try
SaveIcDialog.FileName:=Copy(ExtractFileName(OpenIcDialog.FileName),1,Length(ExtractFileName(OpenIcDialog.FileName))-Length(ExtractFileExt(ExtractFileName(OpenIcDialog.FileName))))+'.ico';
SaveIcDialog.FilterIndex:=1;
if not Execute then System.Exit;
IconImage.Picture.Icon.SaveToFile(FileName);
finally
end;
end;

end.