delphi 动态修改exe文件的图标

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, shellapi;

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Edit1: TEdit;
    Label2: TLabel;
    Edit2: TEdit;
    OpenDialog1: TOpenDialog;
    OpenDialog2: TOpenDialog;
    StatusBar1: TStatusBar;
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button2Click(Sender:TObject);
begin
	Close;
end;

procedure TForm1.Button1Click(Sender:TObject);
const
	readlen = 10; //每次读取字节数，可改变
	icolen = 766; //32*32图标长度,根据研究前126为图标头,后640为图标数据
var
	i, j, itemp, nPos:int64; //   nPos为目的图标在目的文件的位置
	ci, cj:array[0..readlen - 1] of char;
	SourceFile, DestFile:string; //如果要把记事本图标换成瑞星杀毒软件图标
	bOK:boolean; //则SourceFile='C:\windows\notepad.exe',DestFile:='C:\Program Files\rising\rav\ravmon.exe'
	SourceIcon, DestIcon:TIcon;
	SIconStream, s, sDest:TMemoryStream;
begin
  bOK := false;
  if OpenDialog1.Execute then
      SourceFile := OpenDialog1.FileName
  else
      exit;
  if AnsiUpperCase(ExtractFileExt(SourceFile)) <> '.EXE' then
  begin
      ShowMessage(AnsiUpperCase(ExtractFileExt(SourceFile)));
      exit;
  end;
  Edit1.Text := SourceFile;
  if OpenDialog2.Execute then
      DestFile := OpenDialog2.FileName
  else
      exit;
  if AnsiUpperCase(ExtractFileExt(DestFile)) <> '.EXE' then exit;
  Edit2.Text := DestFile;
  SourceIcon := TIcon.Create;
  case ExtractIcon(handle, PChar(SourceFile), UINT(-1)) of
    0:
    begin ShowMessage('源程序没有图标');
      exit;
    end;
    1:;
  else
      ShowMessage('源程序有多个图标,本程序选择第一个图标');
  end;
  SourceIcon.Handle := ExtractIcon(handle, PChar(SourceFile), 0);
      //选择第一个图标
  DestIcon := TIcon.Create;
        //选择第N个图标为   ExtractIcon(handle,PChar(Sourcefile), N - 1)
  case ExtractIcon(handle, PChar(DestFile), UINT(-1)) of
    0:
    begin 
      ShowMessage('目的程序没有图标');
      exit;
    end;
    1:;
  else
    ShowMessage('目的程序有多个图标,本程序选择第一个图标替换');
  end;
  DestIcon.Handle := ExtractIcon(handle, PChar(DestFile), 0); //选择第一个图标
  SIconStream := TMemoryStream.Create;
  DestIcon.SaveToStream(sIconStream);
  if sIconStream.size <> icolen then
  ShowMessage('SIcon.size<>icolen');
  SDest := TMemoryStream.Create;
  sDest.LoadFromFile(DestFile);
  i := 0;
  //j := 0; //以下程序查找目的图标在目的程序中的位置
  while i < sDest.size do
  begin
    itemp := i;
    j := 126;
    cj := '';
    while (string(ci) = string(cj)) and (i < SDest.size) and (j < icolen) do
    begin
      i := i + readlen;
      j := j + readlen;
      SDest.Position := i;
      SDest.read(ci, readlen);
      SiconStream.Position := j;
      SiconStream.Read(cj, readlen);
    end;
    if j < icolen then
      i := itemp + 1 //没找到
    else
    begin
      nPos := itemp; //找到
      bOK := true;
      break;
    end;
  end;
  if bOK = false then exit; //目标文件二进制码中未找到图标
  SIconStream.Clear; //将源程序图标存入
  SourceIcon.SaveToStream(SIconStream);
  SIconStream.position := 126;
  s := TMemoryStream.Create;
  sDest.Position := 0;
  s.CopyFrom(sDest, nPos); //将目的程序图标前数据拷入
  s.CopyFrom(SIconStream, 640); //将源程序图标拷入
  if sDest.size > sDest.Position + 640 then //将目的程序剩余数据拷入
  begin
    sDest.Position := sDest.Position + 640;
    s.CopyFrom(sDest, sDest.Size - sDest.Position);
  end;
  s.SaveToFile(Extractfilepath(application.exename) + 'Result.exe');
  SourceIcon.Free;
  DestIcon.Free; //改造好的程序存放在本目录Result.exe文件中
  SIconStream.Free;
  s.Free;
  sDest.Free;
  ShowMessage(Extractfilepath(application.exename) + 'Result.exe');
end;
  //以上程序可以将目的程序的第一个图标换成源程序的第一个图标,经实证很多程序有二个
  //或更多图标,转换原理相似,不在陈述
end.