paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-10 14:56:00 +02:00
Code Issues Packages Projects Releases Wiki Activity

lcl: fix range check error in lcl icon building from resource data by C Western (issue #0015541) + remove of ifdefs

Browse Source 
git-svn-id: trunk@23481 -
This commit is contained in:
paul 2010-01-18 07:53:16 +00:00
parent 989a3cf5c2
commit e25a2cdb71
2 changed files with 7 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
lcl/graphics.pp
View File

@ -1602,9 +1602,7 @@ type
function LazarusResourceTypeValid(const ResourceType: string): boolean; override; function LazarusResourceTypeValid(const ResourceType: string): boolean; override;
procedure LoadFromResourceName(Instance: THandle; const ResName: String); override; procedure LoadFromResourceName(Instance: THandle; const ResName: String); override;
procedure LoadFromResourceID(Instance: THandle; ResID: Integer); override; procedure LoadFromResourceID(Instance: THandle; ResID: Integer); override;
{$IFDEF FPC_HAS_WINLIKERESOURCES}
procedure LoadFromResourceHandle(Instance: THandle; ResHandle: TFPResourceHandle); procedure LoadFromResourceHandle(Instance: THandle; ResHandle: TFPResourceHandle);
{$ENDIF}
function BitmapHandleAllocated: boolean; override; function BitmapHandleAllocated: boolean; override;
function MaskHandleAllocated: boolean; override; function MaskHandleAllocated: boolean; override;
function PaletteAllocated: boolean; override; function PaletteAllocated: boolean; override;

21
lcl/include/icon.inc
View File

@ -642,13 +642,10 @@ begin
end; end;
procedure TCustomIcon.LoadFromResourceName(Instance: THandle; const ResName: String); procedure TCustomIcon.LoadFromResourceName(Instance: THandle; const ResName: String);
{$IFDEF FPC_HAS_WINLIKERESOURCES}
var var
ResType: TResourceType; ResType: TResourceType;
ResHandle: TFPResourceHandle; ResHandle: TFPResourceHandle;
{$ENDIF}
begin begin
{$IFDEF FPC_HAS_WINLIKERESOURCES}
ResType := GetResourceType; ResType := GetResourceType;
if ResType = nil then Exit; if ResType = nil then Exit;
@ -656,17 +653,13 @@ begin
if ResHandle = 0 then if ResHandle = 0 then
raise EResNotFound.Create(ResName); // todo: valid exception raise EResNotFound.Create(ResName); // todo: valid exception
LoadFromResourceHandle(Instance, ResHandle); LoadFromResourceHandle(Instance, ResHandle);
{$ENDIF}
end; end;
procedure TCustomIcon.LoadFromResourceID(Instance: THandle; ResID: Integer); procedure TCustomIcon.LoadFromResourceID(Instance: THandle; ResID: Integer);
{$IFDEF FPC_HAS_WINLIKERESOURCES}
var var
ResType: TResourceType; ResType: TResourceType;
ResHandle: TFPResourceHandle; ResHandle: TFPResourceHandle;
{$ENDIF}
begin begin
{$IFDEF FPC_HAS_WINLIKERESOURCES}
ResType := GetResourceType; ResType := GetResourceType;
if ResType = nil then Exit; if ResType = nil then Exit;
@ -674,15 +667,13 @@ begin
if ResHandle = 0 then if ResHandle = 0 then
raise EResNotFound.Create(''); // todo: valid exception raise EResNotFound.Create(''); // todo: valid exception
LoadFromResourceHandle(Instance, ResHandle); LoadFromResourceHandle(Instance, ResHandle);
{$ENDIF}
end; end;
{$IFDEF FPC_HAS_WINLIKERESOURCES}
procedure TCustomIcon.LoadFromResourceHandle(Instance: THandle; ResHandle: TFPResourceHandle); procedure TCustomIcon.LoadFromResourceHandle(Instance: THandle; ResHandle: TFPResourceHandle);
var var
GlobalHandle: TFPResourceHGlobal; GlobalHandle: TFPResourceHGlobal;
Dir: ^TGrpIconDir; Dir: ^TGrpIconDir;
DirEntry: TGrpIconDirEntry; DirEntry: ^TGrpIconDirEntry;
IconEntry: TIconDirEntry; IconEntry: TIconDirEntry;
i, offset: integer; i, offset: integer;
Stream: TMemoryStream; Stream: TMemoryStream;
@ -702,23 +693,26 @@ begin
Stream.Write(Dir^, SizeOf(TIconHeader)); Stream.Write(Dir^, SizeOf(TIconHeader));
// write icon entries headers // write icon entries headers
offset := Stream.Position + SizeOf(IconEntry) * LEtoN(Dir^.idCount); offset := Stream.Position + SizeOf(IconEntry) * LEtoN(Dir^.idCount);
DirEntry := @Dir^.idEntries[0];
for i := 0 to LEtoN(Dir^.idCount) - 1 do for i := 0 to LEtoN(Dir^.idCount) - 1 do
begin begin
DirEntry := Dir^.idEntries[i]; Move(DirEntry^, IconEntry, SizeOf(DirEntry^));
Move(DirEntry, IconEntry, SizeOf(DirEntry));
IconEntry.dwImageOffset := NtoLE(offset); IconEntry.dwImageOffset := NtoLE(offset);
inc(offset, LEtoN(IconEntry.dwBytesInRes)); inc(offset, LEtoN(IconEntry.dwBytesInRes));
Stream.Write(IconEntry, SizeOf(IconEntry)); Stream.Write(IconEntry, SizeOf(IconEntry));
Inc(DirEntry);
end; end;
// write icons data // write icons data
DirEntry := @Dir^.idEntries[0];
for i := 0 to LEtoN(Dir^.idCount) - 1 do for i := 0 to LEtoN(Dir^.idCount) - 1 do
begin begin
IconStream := TResourceStream.CreateFromID(Instance, LEtoN(Dir^.idEntries[i].nID), RT_ICON); IconStream := TResourceStream.CreateFromID(Instance, LEtoN(DirEntry^.nID), RT_ICON);
try try
Stream.CopyFrom(IconStream, IconStream.Size); Stream.CopyFrom(IconStream, IconStream.Size);
finally finally
IconStream.Free; IconStream.Free;
end; end;
Inc(DirEntry);
end; end;
Stream.Position := 0; Stream.Position := 0;
ReadData(Stream); ReadData(Stream);
@ -728,7 +722,6 @@ begin
FreeResource(GlobalHandle); FreeResource(GlobalHandle);
end; end;
end; end;
{$ENDIF}
function TCustomIcon.MaskHandleAllocated: boolean; function TCustomIcon.MaskHandleAllocated: boolean;
begin begin