Код:
unit IconChanger;
interface
uses
Windows, Classes, SysUtils, Graphics;
procedure ChangeIcon(FileName, IconFile, ResName:string);
implementation
resourcestring
SInvalidFileName = 'Invalide filename %s';
type
TNewHeader = record
idReserved:WORD;
idType:WORD;
idCount:WORD;
end;
TResDirHeader = packed record
bWidth:Byte;
bHeight:Byte;
bColorCount:Byte;
bReserved:Byte;
wPlanes:WORD;
wBitCount:WORD;
lBytesInRes:Longint;
end;
TIconFileResDirEntry = packed record
DirHeader:TResDirHeader;
lImageOffset:Longint;
end;
TIconResDirEntry = packed record
DirHeader:TResDirHeader;
wNameOrdinal:WORD;
end;
PIconResDirGrp = ^TIconResDirGrp;
TIconResDirGrp = packed record
idHeader:TNewHeader;
idEntries:array[0..0] of TIconResDirEntry;
end;
PIconFileResGrp = ^TIconFileResDirGrp;
TIconFileResDirGrp = packed record
idHeader:TNewHeader;
idEntries:array[0..0] of TIconFileResDirEntry;
end;
TBeginUpdateRes=function(pFileName: PChar; bDeleteExistingResources: BOOL): THandle; stdcall;
TUpdateRes=function(hUpdate: THandle; lpType, lpName: PChar;
wLanguage: Word; lpData: Pointer; cbData: DWORD): BOOL; stdcall;
TEndUpdateRes=function(hUpdate: THandle; fDiscard: BOOL): BOOL; stdcall;
function MakeLangID:WORD;
begin
Result:=(SUBLANG_ENGLISH_US shl 10) or LANG_ENGLISH;
end;
procedure CheckFileName(Value:string);
begin
if (Trim(Value) = EmptyStr) or (not FileExists(Value)) then
raise Exception.Create(Format(SInvalidFileName, [Value]));
end;
procedure ChangeIcon(FileName, IconFile, ResName:string);
var
I:Integer;
Group:Pointer;
Header:TNewHeader;
FileGrp:PIconFileResGrp;
IconGrp:PIconResDirGrp;
IconGrpSize,
FileGrpSize:Integer;
Icon:TIcon;
Stream:TMemoryStream;
hUpdateRes:THandle;
begin
CheckFileName(FileName);
hUpdateRes:=BeginUpdateResource(PChar(FileName), False);
Win32Check(hUpdateRes <> 0);
CheckFileName(IconFile);
Icon:=TIcon.Create;
Icon.LoadFromFile(IconFile);
Stream:=TMemoryStream.Create;
try
Icon.SaveToStream(Stream);
finally
Icon.Free;
end;
Stream.Position:=0;
Stream.Read(Header, SizeOf(Header));
FileGrpSize := SizeOf(TIconFileResDirGrp) + (Header.idCount - 1) * SizeOf(TIconFileResDirEntry);
IconGrpSize := SizeOf(TIconResDirGrp) + (Header.idCount - 1) * SizeOf(TIconResDirEntry);
GetMem(FileGrp, FileGrpSize);GetMem(IconGrp, IconGrpSize);
Stream.Position:=0;
Stream.Read(FileGrp^, FileGrpSize);//loading icongroup
Group:=nil;
try
for I:=0 to FileGrp^.idHeader.idCount - 1 do //building icongroup from loaded entries
begin
with IconGrp^ do
begin
idHeader:=FileGrp^.idHeader;
idEntries[I].DirHeader:=FileGrp^.idEntries[I].DirHeader;
idEntries[I].wNameOrdinal:=I;//fixing Ordinals
end;
with FileGrp^.idEntries[I] do
begin
Stream.Seek(lImageOffset, soFromBeginning);
ReallocMem(Group, DirHeader.lBytesInRes);
Stream.Read(Group^, DirHeader.lBytesInRes);
Win32Check(UpdateResource(hUpdateRes,RT_ICON,PChar(MakeIntResource(I)),
MakeLangID, Group, DirHeader.lBytesInRes));
end;
end;
Win32Check(UpdateResource(hUpdateRes,RT_GROUP_ICON, PChar(ResName),
MakeLangID, IconGrp, IconGrpSize));//adding the icongroup
Win32Check(EndUpdateResource(hUpdateRes, False));
finally
Stream.Free;
FreeMem(FileGrp);
FreeMem(IconGrp);
FreeMem(Group);
end;
end;
var
hLib:HMODULE;
BeginUpdateRes:TBeginUpdateRes;
UpdateRes:TUpdateRes;
EndUpdateRes:TEndUpdateRes;
procedure GetFunctions(hLib:HMODULE);
begin
@BeginUpdateRes:=GetProcAddress(hLib,'BeginUpdateResourceA');
@UpdateRes:=GetProcAddress(hLib,'UpdateResourceA');
@EndUpdateRes:=GetProcAddress(hLib,'EndUpdateResourceA');
end;
initialization
if Win32Platform = VER_PLATFORM_WIN32_WINDOWS then
hLib:=LoadLibrary('unicows.dll') //for win9x
else
hLib:=GetModuleHandle('Kernel32.dll');//assuming Kernel32 is mapped
if hLib > 0 then GetFunctions(hLib);
finalization
if GetModuleHandle('unicows.dll') > 0 then
FreeLibrary(hLib);
end.
ChangeIcon('filename.exe','filename.ico', 'MAINICON'); |
