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

* Fix from Inoussa OUEDRAOGO to fix reading binary data (bug ID 35274)

Browse Source 
git-svn-id: trunk@41794 -
This commit is contained in:
michael 2019-03-26 06:39:49 +00:00
parent b344934fcb
commit fe16b5d3d5
1 changed files with 38 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

42
packages/fcl-report/src/fpreportstreamer.pp
View File

@ -133,6 +133,7 @@ type
function StreamToHex(S: TStream): String;
function StreamsEqual(S1, S2: TStream): Boolean;
function HexToStringStream(S: String): TStringStream;
function HexToMemoryStream(S: String): TMemoryStream;
property JSON: TJSONObject read Fjson write SetJSON;
Property OwnsJSON : Boolean Read FOwnsJSON Write SetOwnsJSON;
property CurrentElement: TJSONObject read FCurrentElement write SetCurrentElement;
@ -447,17 +448,17 @@ end;
function TFPReportJSONStreamer.ReadStream(AName: String; AValue: TStream): Boolean;
var
S: string;
SS: TStringStream;
MS : TMemoryStream;
begin
S := ReadString(AName, '');
Result := (S <> '');
if Result then
begin
SS := HexToStringStream(S);
MS := HexToMemoryStream(S);
try
AValue.CopyFrom(SS, 0);
AValue.CopyFrom(MS, 0);
finally
SS.Free;
MS.Free();
end;
end;
end;
@ -698,4 +699,37 @@ begin
end;
end;
function TFPReportJSONStreamer.HexToMemoryStream(S: String): TMemoryStream;
var
T: array of Byte;
I, J: integer;
B: byte;
P: PByte;
H: string[3];
begin
Result := nil;
SetLength(H, 3);
H[1] := '$';
if (S <> '') then
begin
SetLength(T, Length(S) div 2);
P := @T[0];
I := 1;
while I < Length(S) do
begin
H[2] := S[i];
Inc(I);
H[3] := S[i];
Inc(I);
Val(H, B, J);
if (J = 0) then
P^ := B
else
P^ := 0;
Inc(P);
end;
Result := TBytesStream.Create(T);
end;
end;
end.