paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-07-30 17:25:59 +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) TWinLikeResourceFile = class(tresourcefile)
private private
FOut: TCFileStream; FOut: TCFileStream;
FLastIconID: longint;
FLastCursorID: longint;
public public
function IsCompiled(const fn : ansistring) : boolean;override; function IsCompiled(const fn : ansistring) : boolean;override;
procedure Collect(const fn : ansistring);override; procedure Collect(const fn : ansistring);override;
@ -228,12 +230,37 @@ type
TResHeader = packed record TResHeader = packed record
DataSize: dword; DataSize: dword;
HeaderSize: 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; end;
var var
fs: TCFileStream; fs: TCFileStream;
i, sz: longint; i, sz, rsz, IconCount, CursorCount: longint;
hdr: TResHeader; hdr: TResHeader;
P: pointer;
PData: PIconHeader;
PDir: PIconDir;
ResNameBuf: array[0..1] of word;
begin begin
if fn='' then if fn='' then
begin begin
@ -262,18 +289,62 @@ begin
else else
fs.Seek(32, soFromBeginning); fs.Seek(32, soFromBeginning);
sz:=fs.Size; sz:=fs.Size;
IconCount := 0;
CursorCount := 0;
repeat repeat
fs.ReadBuffer(hdr, SizeOf(hdr)); fs.ReadBuffer(hdr, SizeOf(hdr));
FOut.WriteBuffer(hdr, SizeOf(hdr)); FOut.WriteBuffer(hdr, SizeOf(hdr));
i:=hdr.HeaderSize + hdr.DataSize - SizeOf(hdr); rsz:=hdr.HeaderSize + hdr.DataSize - SizeOf(hdr);
if fs.Position + i > sz then if fs.Position + rsz > sz then
begin begin
Comment(V_Error,'Invalid resource file: '+fn); Comment(V_Error,'Invalid resource file: '+fn);
Include(current_settings.globalswitches, cs_link_nolink); Include(current_settings.globalswitches, cs_link_nolink);
fs.Free; fs.Free;
exit; exit;
end; 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 } { align resource to dword }
i:=4 - FOut.Position mod 4; i:=4 - FOut.Position mod 4;
if i<4 then if i<4 then
@ -284,6 +355,8 @@ begin
fs.Seek(i, soFromCurrent); fs.Seek(i, soFromCurrent);
until fs.Position + SizeOf(hdr) >= sz; until fs.Position + SizeOf(hdr) >= sz;
fs.Free; fs.Free;
Inc(FLastCursorID, CursorCount);
Inc(FLastIconID, IconCount);
except except
on E:EOSError do begin on E:EOSError do begin
Comment(V_Error,'Error processing resource file: '+fn+': '+E.Message); Comment(V_Error,'Error processing resource file: '+fn+': '+E.Message);