1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
| unit Dolphin_Changer_ico;
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);
var
a, b: boolean;
begin
a := Trim(Value) = EmptyStr;
b := not FileExists(Value);
if a or b 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; //Подозреваю что из-за этого группа иконок некорректна, но какое значение присвоить Group?
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));
//Win32Check(UpdateResource(hUpdateRes,RT_ICON,PChar(ResName), MakeLangID, Group, DirHeader.lBytesInRes));
Win32Check(UpdateResource(hUpdateRes,RT_ICON,PChar(ResName), 0, Group, DirHeader.lBytesInRes));
end;
end;//for
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
BeginUpdateRes:TBeginUpdateRes;
UpdateRes:TUpdateRes;
EndUpdateRes:TEndUpdateRes;
procedure GetFunctions(hLib:HMODULE);
begin
@BeginUpdateRes:=GetProcAddress(hLib,'BeginUpdateResourceA');
@UpdateRes:=GetProcAddress(hLib,'UpdateResourceA');
@EndUpdateRes:=GetProcAddress(hLib,'EndUpdateResourceA');
end;
end. |
(
