提取图标

图标在可执行文件里面实际上是一项资源.Windows提供了一个API函数来取出EXE里面的图标.函数原型为:  
          HICON           ExtractIcon(HINSTANCE           hInst,LPCTSTR           lpszExeFileName,UINT           nIconIndex);
          1.其中HINSTANCE           hInst参数为实例句柄,
          2.LPCTSTR           lpszExeFileName参数为需要操作的EXE,DLL,BMP或ICON等包含有图标资源的文件名,  
          3.UINT           nIconIndex参数为需要取出的图标在该EXE里面的索引(因为一个EXE文件里面可能含有多个图标)  
          .如果这个参数为0,那么将返回第一个图标,如果这个参数为-1,将返回该文件可能含有的所有图标数.如果该文件含有该索引图标,函数将返回  
          该图标的句柄,否则返回值NULL.  
 
          简单的看一个EXE文件的组成:EXE文件=文件头之类+图标资源+文件尾.也就是说,你不用管它的文件头和文件尾  
          之类,只要找到图标在该EXE里面的位置,然后用你的图标覆盖它即可.  
          不过需要注意的是,图标是有多种格式的,比如说16X16的16色,32X32的16色,16X16的32色等等.用这种方法更换图标的话必须注意格式要一致  
          .另外,ExtractIcon函数返回的将是32X32的16色图标.这是个很有趣的地方.也就是说,无论你操作的文件或图标格式是怎么样,它取出的都是  
          32X32的16色图标.而Delphi默认的那个图标就是这个格式的.  

//1+shellapi
Icon_Index:integer;           //2+
procedure TForm1.Extract_Icon;
           var
           icon_handle:            Longint;
           buffer:            array[0..1024]            of            Char;
           begin
           if not (FileExists(Edit1.Text)) then Exit;
           StrPCopy(Buffer,Edit1.Text);
           icon_handle:= ExtractIcon(self.Handle,            buffer,            icon_index);
           if Icon_Handle=0 then
           begin
           if Icon_Index=0 then
           begin
           Application.MessageBox('这个文件没有发现图标,请重新选择!','信息',MB_ICONINFORMATION+MB_OK);
           Image1.Visible:=False;
           end
           else
           Icon_Index:=Icon_Index-1;
           Exit;
           end;
           Image1.Picture.Icon.Handle:=icon_handle;
           Image1.Visible:=True;
           end;  
///
procedure TForm1.Button1Click(Sender: TObject); //提取图标
begin
OpenDialog1.Filter:='所有支持类型(*.EXE,*.DLL,*.OCX,*.ICL,*.ICO,*.BMP)|*.exe;*.dll;*.ocx;*.icl;*.ico;*.bmp|所有文件(*.*)|*.*';
           if OpenDialog1.Execute then
           begin
           Edit1.Text:=OpenDialog1.Filename;
           Icon_Index:=0;
           Extract_Icon;
           end;
end;
procedure TForm1.Button2Click(Sender: TObject);           //保存图标
begin
SaveDialog1.Filter:='图标文件(*.ICO)|*.ico';
           if SaveDialog1.Execute then
           begin
           if Copy(SaveDialog1.FileName,Length(SaveDialog1.FileName)-3,1)='.'then
           Image1.Picture.Icon.SaveToFile(SaveDialog1.FileName)
           else
           Image1.Picture.Icon.SaveToFile(SaveDialog1.FileName+'.ico');
           end;
end;

end.

///
unit Unit1;interfaceuses
    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
    Dialogs,shellapi, spSkinShellCtrls, StdCtrls, Mask, SkinBoxCtrls,
    SkinCtrls, ExtCtrls, ComCtrls, SkinTabs, SkinData, DynamicSkinForm;type
    TForm1 = class(TForm)
      spSkinPageControl1: TspSkinPageControl;
      spSkinTabSheet1: TspSkinTabSheet;
      spSkinTabSheet2: TspSkinTabSheet;
      spSkinSpeedButton1: TspSkinSpeedButton;
      spSkinSpeedButton2: TspSkinSpeedButton;
      spSkinSpeedButton3: TspSkinSpeedButton;
      spSkinEdit1: TspSkinEdit;
      spSkinOpenDialog1: TspSkinOpenDialog;
      spSkinSaveDialog1: TspSkinSaveDialog;
      spDynamicSkinForm1: TspDynamicSkinForm;
      spSkinData1: TspSkinData;
      spCompressedStoredSkin1: TspCompressedStoredSkin;
      spSkinGroupBox1: TspSkinGroupBox;
      Image1: TImage;
      spSkinMemo1: TspSkinMemo;
      procedure FormCreate(Sender: TObject);
      procedure spSkinSpeedButton1Click(Sender: TObject);
      procedure spSkinSpeedButton2Click(Sender: TObject);
      procedure spSkinSpeedButton3Click(Sender: TObject);
    private
    procedure     Extract_Icon;
    function     ChangeExeIcon(ExeFile,IconFile:string;Index:Integer=0):Boolean;
      { Private declarations }
    public
      { Public declarations }
    end;var
    Form1: TForm1;
    Icon_Index:integer;    //2+
implementation{$R *.dfm}
procedure TForm1.Extract_Icon;
    var
    icon_handle:     Longint;
    buffer:     array[0..1024]     of     Char;
    begin
    if not (FileExists(spSkinEdit1.Text)) then Exit;
    StrPCopy(Buffer,spSkinEdit1.Text);
    icon_handle:= ExtractIcon(self.Handle,     buffer,     icon_index);
    if Icon_Handle=0 then
    begin
    if Icon_Index=0 then
    begin
    Application.MessageBox('这个文件没有发现图标,请重新选择!','信息',MB_ICONINFORMATION+MB_OK);
    Image1.Visible:=False;
    end
    else
    Icon_Index:=Icon_Index-1;
    Exit;
    end;
    Image1.Picture.Icon.Handle:=icon_handle;
    Image1.Visible:=True;
    end;
function TForm1.ChangeExeIcon(ExeFile,IconFile:string;Index:Integer=0):Boolean;
    var  
    TempStream,NewIconMemoryStream:TMemoryStream;
    OldIconStrings,ExeStrings,ExeIconStrings:TStringStream;
    ExeIcon:TIcon;
    IconPosition,IconLength,IconHeadLength:Integer;  
    IconHandle:HICON;  
    ExeFileStream,IconFileStream:TFileStream;  
    begin  
    Result:=False;  
    IconHeadLength:=126;  
    if     (not     FileExists(ExeFile))     or     (not     FileExists(IconFile))     then     Exit;  
    try
    ExeFileStream:=TFileStream.Create(ExeFile,fmOpenReadWrite+fmShareDenyWrite);  
    ExeStrings:=TStringStream.Create('');  
    ExeStrings.Position:=0;  
    ExeFileStream.Position:=0;  
    ExeStrings.CopyFrom(ExeFileStream,0);  
    ExeIcon:=TIcon.Create;  
    IconHandle:=ExtractIcon(Application.Handle,Pchar(ExeFile),Index);  
    if     IconHandle<=1     then  
    begin  
    Application.MessageBox('EXE中没有找到该序列的图标!',Pchar(Application.Title),MB_ICONERROR+MB_OK);  
    Exit;  
    end;  
    ExeIcon.Handle:=IconHandle;  
    ExeIconStrings:=TStringStream.Create('');  
    ExeIcon.SaveToStream(ExeIconStrings);  
    ExeIcon.Free;
    IconLength:=ExeIconStrings.Size-IconHeadLength;
    ExeIconStrings.Position:=IconHeadLength;  
    OldIconStrings:=TStringStream.Create('');  
    OldIconStrings.Position:=0;
    ExeIconStrings.Position:=IconHeadLength;
    OldIconStrings.CopyFrom(ExeIconStrings,IconLength);
    ExeIconStrings.Free;  
    IconPosition:=Pos(OldIconStrings.DataString,ExeStrings.DataString);  
    ExeStrings.Free;    OldIconStrings.Free;
    IconFileStream:=TFileStream.Create(IconFile,fmOpenRead+fmShareDenyNone);  
    NewIconMemoryStream:=TMemoryStream.Create;  
    IconFileStream.Position:=IconHeadLength;  
    NewIconMemoryStream.Position:=0;  
    NewIconMemoryStream.CopyFrom(IconFileStream,IconFileStream.Size-IconHeadLength);  
    IconFileStream.Free;  
    if     IconPosition<=0     then  
    begin  
    Application.MessageBox('EXE中没有找到该图标的数据!',Pchar(Application.Title),MB_ICONERROR+MB_OK);
    Exit;  
    end;  
    if     IconLength<>NewIconMemoryStream.Size     then
    begin  
    TempStream:=TMemoryStream.Create;  
    ExeFileStream.Position:=IconPosition+IconLength-1;  
    TempStream.Position:=0;  
    TempStream.CopyFrom(ExeFileStream,ExeFileStream.Size-ExeFileStream.Position);  
    ExeFileStream.Position:=IconPosition-1;  
    NewIconMemoryStream.Position:=0;  
    ExeFileStream.CopyFrom(NewIconMemoryStream,0);  
    TempStream.Position:=0;  
    ExeFileStream.CopyFrom(TempStream,0);  
    ExeFileStream.Position:=0;  
    ExeFileStream.Size:=IconPosition+IconLength-1+TempStream.Size;  
    TempStream.Free;  
    end  
    else  
    begin  
    ExeFileStream.Position:=IconPosition-1;  
    NewIconMemoryStream.Position:=0;  
    ExeFileStream.CopyFrom(NewIconMemoryStream,0);  
    end;  
    NewIconMemoryStream.Free;
    Result:=True;
    finally  
    //ExeFileStream.Free;
    end;  
    end;
procedure TForm1.FormCreate(Sender: TObject);
begin
spSkinSpeedButton1.Caption:='取出图标';
spSkinSpeedButton2.Caption:='保存图标';
spSkinSpeedButton3.Caption:='更换图标';
spSkinpagecontrol1.activepage:=spSkintabsheet1;
end;procedure TForm1.spSkinSpeedButton1Click(Sender: TObject);
begin
spSkinOpenDialog1.Filter:='所有支持类型(*.EXE,*.DLL,*.OCX,*.ICL,*.ICO,*.BMP)|*.exe;*.dll;*.ocx;*.icl;*.ico;*.bmp|所有文件(*.*)|*.*';
    if spSkinOpenDialog1.Execute then
    begin
    spSkinEdit1.Text:=spSkinOpenDialog1.Filename;
    Icon_Index:=0;
    Extract_Icon;
    end;
end;procedure TForm1.spSkinSpeedButton2Click(Sender: TObject);
begin
spSkinSaveDialog1.Filter:='图标文件(*.ICO)|*.ico';
    if spSkinSaveDialog1.Execute then
    begin
    if Copy(spSkinSaveDialog1.FileName,Length(spSkinSaveDialog1.FileName)-3,1)='.'then
    Image1.Picture.Icon.SaveToFile(spSkinSaveDialog1.FileName)
    else
    Image1.Picture.Icon.SaveToFile(spSkinSaveDialog1.FileName+'.ico');
    end;
end;procedure TForm1.spSkinSpeedButton3Click(Sender: TObject);
var  
    ExeFile:String;  
    begin  
    spSkinOpenDialog1.Filter:='EXE文件(*.EXE)|*.exe';
    spSkinOpenDialog1.Title:='请选择需要更换图标的EXE';
    if spSkinOpenDialog1.Execute then
    begin
    ExeFile:=spSkinOpenDialog1.FileName;
    spSkinOpenDialog1.Filter     := '图标文件(*.ICO)|*.ico';
    spSkinOpenDialog1.Title:='请选择需要更换的图标文件';
    spSkinOpenDialog1.FileName:='';
    if     spSkinOpenDialog1.Execute     then
    if     ChangeExeIcon(ExeFile,spSkinOpenDialog1.FileName)     then
    Application.MessageBox('更换图标成功!',Pchar(Application.Title),MB_ICONINFORMATION+MB_OK)  
    else  
    Application.MessageBox('更换图标失败!',Pchar(Application.Title),MB_ICONERROR+MB_OK)  
    else  
    Exit;
    end;  
    end;

end.