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

LazReport, fix loading of old binary reports (older than version 28), modified patch from Tsvetoslav, issue #27179

Browse Source 
git-svn-id: trunk@49154 -
This commit is contained in:
jesus 2015-05-23 22:37:52 +00:00
parent 3be8873d05
commit a16431b3ac
2 changed files with 35 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
components/lazreport/source/lr_class.pas
View File

@ -20,7 +20,7 @@ uses
Dialogs, Menus, Variants, DB, Graphics, Printers, osPrinters, LazUTF8, DOM,
XMLWrite, XMLRead, XMLConf, LCLType, LCLIntf, TypInfo, LR_View, LR_Pars,
LR_Intrp, LR_DSet, LR_DBSet, LR_DBRel, LR_Const, DbCtrls, LazUtf8Classes,
LazLoggerBase;
LCLProc;
const
lrMaxBandsInReport = 256; //temp fix. in future need remove this limit
@ -2727,12 +2727,13 @@ var
i : Integer;
begin
{$IFDEF DebugLR}
DebugLn('%s.TfrView.LoadFromStream begin StreamMode=%d ClassName=%s',
[name,Ord(StreamMode),ClassName]);
DebugLn('%s.TfrView.LoadFromStream begin StreamMode=%d ClassName=%s Stream.Position=%d',
[name,Ord(StreamMode),ClassName, Stream.Position]);
{$ENDIF}
with Stream do
begin
// if StreamMode = smDesigning then
if (frVersion>27) or ((frVersion=27) and lrCanReadName(Stream)) or (StreamMode = smDesigning) then
begin
if frVersion >= 23 then
fName := ReadString(Stream)
@ -2806,7 +2807,7 @@ begin
end;
{$IFDEF DebugLR}
DebugLn('%s.TfrView.LoadFromStream end',[name]);
DebugLn('%s.TfrView.LoadFromStream end Position=%d',[name, Stream.Position]);
{$ENDIF}
end;

29
components/lazreport/source/lr_utils.pas
View File

@ -69,6 +69,7 @@ function lrStrToDateTime(AValue: string): TDateTime;
function lrExpandVariables(const S:string):string;
procedure lrNormalizeLocaleFloats(DisableLocale: boolean);
function lrConfigFolderName(ACreatePath: boolean): string;
function lrCanReadName(Stream: TStream): boolean;
procedure CanvasTextRectJustify(const Canvas:TCanvas;
const ARect: TRect; X1, X2, Y: integer; const Text: string;
@ -923,6 +924,34 @@ begin
raise EInOutError.Create(SysUtils.Format(lrsUnableToCreateConfigDirectoryS,[Result]));
end;
function lrCanReadName(Stream: TStream): boolean;
var
oldPosition: Int64;
aName: string;
n: Integer;
begin
// normally stream is seek-able so this should work....
oldPosition := stream.Position;
result := false;
try
try
n := stream.ReadWord;
setLength(aName, n);
stream.Read(aName[1], n);
if (n>0) and (stream.ReadByte=0) then begin
// unfortunately, objects names are not validated
// only check standard names here
while (n>0) and (aName[n] in ['a'..'z','A'..'Z','0'..'9','_']) do
dec(n);
result := (n=0);
end;
except
end;
finally
Stream.Position := oldPosition;
end;
end;
function UTF8Desc(S: string; var Desc: string): Integer;
// create Desc as an array with Desc[i] is the size of the UTF-8 codepoint
var