Merged revision(s) 49121 #336bdda458, 49154 #a16431b3ac from trunk:

LazReport, when formatting numbers check that value is really numeric, issue #28114
........
LazReport, fix loading of old binary reports (older than version 28), modified patch from Tsvetoslav, issue #27179
........

git-svn-id: branches/fixes_1_4@49183 -
This commit is contained in:
maxim 2015-05-26 22:06:38 +00:00
parent 1b4b1ad15a
commit 85167083fc
2 changed files with 39 additions and 6 deletions

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
// object flags
@ -2708,12 +2708,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)
@ -2787,7 +2788,7 @@ begin
end;
{$IFDEF DebugLR}
DebugLn('%s.TfrView.LoadFromStream end',[name]);
DebugLn('%s.TfrView.LoadFromStream end Position=%d',[name, Stream.Position]);
{$ENDIF}
end;
@ -9690,6 +9691,8 @@ var
f1, f2: Integer;
c: Char;
s: String;
Dummy: Extended;
IsNumeric: Boolean;
begin
if (TVarData(v).VType = varEmpty) {VarIsEmpty(v)} or VarIsNull(v) then
begin
@ -9715,7 +9718,8 @@ begin
end;
fmtNumber:
begin
if not VarIsNumeric(v) then
IsNumeric := VarIsNumeric(v) or TryStrToFloat(v, Dummy);
if not IsNumeric then
result := v
else begin
DefaultFormatSettings.DecimalSeparator := Chr(AFormat and $FF);

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;
// utf8 tools
function UTF8Desc(S:string; var Desc: string): Integer; deprecated;
@ -919,6 +920,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