Question

delphi中 修改已生成exe文件的ico图标

在delphi中 修改已生成exe文件的ico图标
就是说软件可以选择修改自己的图标
解决后
加100分
是想在代码中实现的
就是说可以动态修改的

Answer 1

Project——Options...——Application，点击Load Icon...
可以修改icon

unit ICOEXE;

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;
Button1:TButton;
Button2:TButton;
OpenDialog1:TOpenDialog;
OpenDialog2:TOpenDialog;
StatusBar1:TStatusBar;
procedure Button2Click(Sender:TObject);
procedure Button1Click(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:\Progra
m 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(Source
file), 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;
{ repeat
SDest.Position:=i;
sDest.read(ci,Readlen);
SiconStream.Position:=j;
SIconStream.Read(cj,Readlen);
i:=i+Readlen;
j:=j+Readlen;
until (String(ci)=String(cj)) and (i<sDest.size) and (j<icolen);
} ci := '';
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.