paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-06-02 19:18:34 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Fixed inclusion of multiple resource files with icons or cursors. Patch by Sergei Gorelkin modified by me to reduce memory usage. Bug #9459.

Browse Source 
git-svn-id: trunk@8324 -
This commit is contained in:
yury 2007-08-28 20:54:32 +00:00
parent 5bc156efea
commit 614dbe6a8c
1 changed files with 77 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

81
compiler/comprsrc.pas
View File

@ -45,6 +45,8 @@ type
TWinLikeResourceFile = class(tresourcefile)
private
FOut: TCFileStream;
FLastIconID: longint;
FLastCursorID: longint;
public
function IsCompiled(const fn : ansistring) : boolean;override;
procedure Collect(const fn : ansistring);override;
@ -228,12 +230,37 @@ type
TResHeader = packed record
DataSize: dword;
HeaderSize: dword;
ResTypeFlag: word;
ResTypeID: word;
end;
PIconHeader = ^TIconHeader;
TIconHeader = packed record
Reserved: word;
wType: word;
wCount: word;
end;
PIconDir = ^TIconDir;
TIconDir = packed record
bWidth: byte;
bHeight: byte;
bColorCount: byte;
bReserved: byte;
wPlanes: word;
wBitCount: word;
lBytesInRes: dword;
wNameOrdinal: word;
end;
var
fs: TCFileStream;
i, sz: longint;
i, sz, rsz, IconCount, CursorCount: longint;
hdr: TResHeader;
P: pointer;
PData: PIconHeader;
PDir: PIconDir;
ResNameBuf: array[0..1] of word;
begin
if fn='' then
begin
@ -262,18 +289,62 @@ begin
else
fs.Seek(32, soFromBeginning);
sz:=fs.Size;
IconCount := 0;
CursorCount := 0;
repeat
fs.ReadBuffer(hdr, SizeOf(hdr));
FOut.WriteBuffer(hdr, SizeOf(hdr));
i:=hdr.HeaderSize + hdr.DataSize - SizeOf(hdr);
if fs.Position + i > sz then
rsz:=hdr.HeaderSize + hdr.DataSize - SizeOf(hdr);
if fs.Position + rsz > sz then
begin
Comment(V_Error,'Invalid resource file: '+fn);
Include(current_settings.globalswitches, cs_link_nolink);
fs.Free;
exit;
end;
FOut.CopyFrom(fs, i);
{ Adjusting cursor and icon IDs }
if hdr.ResTypeFlag = $FFFF then { resource type is ordinal }
case hdr.ResTypeID of
1, 3:
{ cursor or icon resource }
begin
fs.ReadBuffer(ResNameBuf, SizeOf(ResNameBuf));
if ResNameBuf[0] = $FFFF then { resource name is ordinal }
if hdr.ResTypeID = 1 then
begin
Inc(ResNameBuf[1], FLastCursorID);
Inc(CursorCount);
end
else
begin
Inc(ResNameBuf[1], FLastIconID);
Inc(IconCount);
end;
FOut.WriteBuffer(ResNameBuf, SizeOf(ResNameBuf));
Dec(rsz, SizeOf(ResNameBuf));
end;
12, 14:
{ cursor or icon group resource }
begin
GetMem(P, rsz);
fs.ReadBuffer(P^, rsz);
PData := PIconHeader(P + hdr.HeaderSize - sizeof(hdr));
PDir := PIconDir(Pointer(PData) + sizeof(TIconHeader));
for i := 0 to PData^.wCount-1 do
begin
if hdr.ResTypeID = 12 then
Inc(PDir^.wNameOrdinal, FLastCursorID)
else
Inc(PDir^.wNameOrdinal, FLastIconID);
Inc(PDir);
end;
FOut.WriteBuffer(P^, rsz);
rsz:=0;
FreeMem(P);
end;
end;
{ copy rest of the resource data }
FOut.CopyFrom(fs, rsz);
{ align resource to dword }
i:=4 - FOut.Position mod 4;
if i<4 then
@ -284,6 +355,8 @@ begin
fs.Seek(i, soFromCurrent);
until fs.Position + SizeOf(hdr) >= sz;
fs.Free;
Inc(FLastCursorID, CursorCount);
Inc(FLastIconID, IconCount);
except
on E:EOSError do begin
Comment(V_Error,'Error processing resource file: '+fn+': '+E.Message);