paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-19 22:49:30 +02:00
Code Issues Packages Projects Releases Wiki Activity

added workaround for bug #3574

Browse Source 
git-svn-id: trunk@6637 -
This commit is contained in:
mattias 2005-01-18 22:26:10 +00:00
parent 58131f7541
commit cc5ecdae5c
3 changed files with 58 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
lcl/include/bitmap.inc
View File

@ -39,6 +39,7 @@ begin
OldPosition:=AStream.Position;
ReadSize:=AStream.Read(Signature, SizeOf(Signature));
Result:=(ReadSize=2) and (Signature[0]='B') and (Signature[1]='M');
//debugln('TestStreamIsBMP ',DbgStr(Signature[0]),' ',DbgStr(Signature[1]));
AStream.Position:=OldPosition;
end;
@ -509,14 +510,17 @@ procedure TBitmap.ReadStream(Stream: TStream; UseSize: boolean; Size: Longint);
procedure RaiseInvalidBitmapHeader;
begin
debugln('TBitmap.ReadStream.RaiseInvalidBitmapHeader');
debugln('TBitmap.ReadStream.RaiseInvalidBitmapHeader ',
'"',dbgMemStream(TCustomMemoryStream(Stream),30),'"');
raise EInOutError.Create(
'TBitmap.ReadStream: Invalid bitmap format (bmp,xpm,ico)');
end;
procedure RaiseInvalidSize;
begin
debugln('TBitmap.ReadStream.RaiseInvalidSize');
debugln('TBitmap.ReadStream.RaiseInvalidSize ',
' Size=',dbgs(Size),' Stream.Position=',dbgs(Stream.Position),
' Stream.Size=',dbgs(Stream.Size));
raise EInOutError.Create(
'TBitmap.ReadStream: Invalid size of bitmap stream (bmp,xpm,ico)');
end;
@ -527,6 +531,8 @@ var
StreamType: TBitmapNativeType;
ReaderClass: TFPCustomImageReaderClass;
MemStream: TCustomMemoryStream;
GetSize: Int64;
OldPosition: Int64;
begin
//debugln('TBitmap.ReadStream Stream=',DbgSName(Stream),' Stream.Size=',dbgs(Stream.Size),' Stream.Position=',dbgs(Stream.Position),' UseSize=',dbgs(UseSize),' Size=',dbgs(Size));
CacheStream:=nil;
@ -546,7 +552,11 @@ begin
// get image type
if CacheStream is TCustomMemoryStream then begin
MemStream:=TCustomMemoryStream(CacheStream);
if UseSize and (Size>MemStream.Size-MemStream.Position) then
OldPosition:=MemStream.Position;
GetSize:=MemStream.Size;
// workaround for TMemoryStream bug, reading Size sets Position to 0
MemStream.Position:=OldPosition;
if UseSize and (Size>GetSize-OldPosition) then
RaiseInvalidSize;
StreamType:=TestStreamBitmapNativeType(MemStream);
end else
@ -1268,6 +1278,9 @@ end;
{ =============================================================================
$Log$
Revision 1.95 2005/01/18 22:26:10 mattias
added workaround for bug 3574
Revision 1.94 2005/01/18 19:46:41 mattias
added stream size check for TBitmap

41
lcl/lclproc.pas
View File

@ -151,6 +151,9 @@ function DbgS(const e: extended): string;
function DbgS(const b: boolean): string;
function DbgSName(const p: TObject): string;
function DbgStr(const StringWithSpecialChars: string): string;
function dbgMemRange(P: PByte; Count: integer): string;
function dbgMemStream(MemStream: TCustomMemoryStream; Count: integer): string;
function dbgObjMem(AnObject: TObject): string;
function DbgS(const i1,i2,i3,i4: integer): string;
@ -1062,6 +1065,42 @@ begin
end;
end;
function dbgMemRange(P: PByte; Count: integer): string;
const
HexChars: array[0..15] of char = '0123456789ABCDEF';
var
i: Integer;
begin
Result:='';
if (p=nil) or (Count<=0) then exit;
SetLength(Result,Count*2);
for i:=0 to Count-1 do begin
Result[i*2+1]:=HexChars[PByte(P)[i] shr 4];
Result[i*2+2]:=HexChars[PByte(P)[i] and $f];
end;
end;
function dbgMemStream(MemStream: TCustomMemoryStream; Count: integer): string;
var
s: string;
begin
Result:='';
if (MemStream=nil) or (not (MemStream is TCustomMemoryStream)) or (Count<=0)
then exit;
Count:=Min(Count,MemStream.Size);
if Count<=0 then exit;
SetLength(s,Count);
Count:=MemStream.Read(s[1],Count);
Result:=dbgMemRange(PByte(s),Count);
end;
function dbgObjMem(AnObject: TObject): string;
begin
Result:='';
if AnObject=nil then exit;
Result:=dbgMemRange(PByte(AnObject),AnObject.InstanceSize);
end;
function DbgS(const i1, i2, i3, i4: integer): string;
begin
Result:=dbgs(i1)+','+dbgs(i2)+','+dbgs(i3)+','+dbgs(i4);
@ -1071,7 +1110,7 @@ function UTF8CharacterLength(p: PChar): integer;
begin
if p<>nil then begin
if ord(p^)<%11000000 then begin
// regular single byte character (#0 is single byte, this is pascal ;)
// regular single byte character (#0 is a character, this is pascal ;)
Result:=1;
end
else if ((ord(p^) and %11100000) = %11000000) then begin

2
lcl/lresources.pp
View File

@ -1704,6 +1704,8 @@ var
BinDataSize:=integer(stream.Size);
WriteLRSInteger(Output,BinDataSize);
Output.Write(Stream.Memory^, BinDataSize);
Stream.Position:=0;
//debugln('LRSObjectTextToBinary binary data "',dbgMemStream(Stream,30),'"');
finally
stream.Free;
end;