Un simple programa para buscar y extraer iconos.

Una imagen :



El codigo :

// Sex Icons 0.1
// Coded By Doddy H
 
unit sex;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, jpeg, ExtCtrls, ComCtrls, StdCtrls, ShellAPI, ImgList;
 
type
  TForm1 = class(TForm)
    Image1: TImage;
    GroupBox1: TGroupBox;
    Label1: TLabel;
    Edit1: TEdit;
    ListView1: TListView;
    Button1: TButton;
    GroupBox2: TGroupBox;
    Button2: TButton;
    ImageList1: TImageList;
    GroupBox3: TGroupBox;
    Image2: TImage;
 
    Image3: TImage;
    SaveDialog1: TSaveDialog;
    procedure Button1Click(Sender: TObject);
    procedure ListView1DblClick(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
procedure TForm1.Button1Click(Sender: TObject);
var
  buscar: TSearchRec;
  Icon: TIcon;
  listate: TListItem;
  getdata: SHFILEINFO;
  dirnow: string;
 
begin
 
  dirnow := Edit1.Text;
 
  ListView1.Items.Clear;
  Icon := TIcon.Create;
  ListView1.Items.BeginUpdate;
 
  if FindFirst(dirnow + '*.*', faAnyFile, buscar) = 0 then
  begin
    repeat
      if (buscar.Attr <> faDirectory) then
      begin
 
        with ListView1 do
        begin
 
          listate := ListView1.Items.Add;
 
          SHGetFileInfo(PChar(dirnow + buscar.Name), 0, getdata, SizeOf(getdata)
              , SHGFI_DISPLAYNAME);
          listate.Caption := buscar.Name;
 
          SHGetFileInfo(PChar(dirnow + buscar.Name), 0, getdata, SizeOf(getdata)
              , SHGFI_TYPENAME);
          listate.SubItems.Add(getdata.szTypeName);
 
          SHGetFileInfo(PChar(dirnow + buscar.Name), 0, getdata, SizeOf(getdata)
              , SHGFI_ICON or SHGFI_SMALLICON);
          Icon.Handle := getdata.hIcon;
          listate.ImageIndex := ImageList1.AddIcon(Icon);
 
          DestroyIcon(getdata.hIcon);
 
        end;
 
      end
 
      until FindNext(buscar) <> 0;
      FindClose(buscar);
    end;
 
    ListView1.Items.EndUpdate;
 
  end;
 
  procedure TForm1.Button2Click(Sender: TObject);
  begin
 
    if SaveDialog1.Execute then
    begin
      Image2.Picture.Icon.SaveToFile(SaveDialog1.FileName);
      ShowMessage('Icon Extracted');
    end;
 
  end;
 
  procedure TForm1.FormCreate(Sender: TObject);
  begin
 
    SaveDialog1.Title := 'Save your Icon';
    SaveDialog1.InitialDir := GetCurrentDir;
    SaveDialog1.DefaultExt := 'ico';
 
  end;
 
  procedure TForm1.ListView1DblClick(Sender: TObject);
 
  var
    acanow: TIcon;
    archivo: string;
    bajar: TSHFileInfo;
 
  begin
 
    archivo := Edit1.Text + ListView1.Selected.Caption;
    if FileExists(archivo) then
    begin
      acanow := TIcon.Create;
      SHGetFileInfo(PChar(archivo), 0, bajar, SizeOf(bajar), SHGFI_ICON);
      acanow.Handle := bajar.hIcon;
      Image2.Picture.Icon := acanow;
      acanow.Free;
    end;
  end;
 
end.
 
// The End ?
 

Si quieren bajarlo lo pueden hacer de aca