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

* Add TReader.ReadStr for Delphi compatibility

Browse Source
This commit is contained in:
Michaël Van Canneyt 2024-02-16 12:07:45 +01:00
parent d51a0c6b3c
commit 689fae7dd9
2 changed files with 45 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
rtl/objpas/classes/classesh.inc
View File

@ -1682,6 +1682,7 @@ type
Procedure FlushBuffer; virtual;
function NextValue: TValueType; virtual; abstract;
function ReadValue: TValueType; virtual; abstract;
function CurrentValue : TValueType; virtual; abstract;
procedure BeginRootComponent; virtual; abstract;
procedure BeginComponent(var Flags: TFilerFlags; var AChildPos: Integer;
var CompClassName, CompName: String); virtual; abstract; overload;
@ -1735,7 +1736,8 @@ type
FBufPos: Integer;
FBufEnd: Integer;
FVersion: TBOVersion;
FCurrentValue : TValueType;
Function CurrentValue : TValueType; override;
function ReadWord : word; {$ifdef CLASSESINLINE}inline;{$endif CLASSESINLINE}
function ReadDWord : longword; {$ifdef CLASSESINLINE}inline;{$endif CLASSESINLINE}
function ReadQWord : qword; {$ifdef CLASSESINLINE}inline;{$endif CLASSESINLINE}
@ -1847,6 +1849,7 @@ type
procedure ReadPropValue(Instance: TPersistent; PropInfo: Pointer);
procedure PropertyError;
procedure ReadData(Instance: TComponent);
function DoReadString(aType : TValueType): rawbytestring;
procedure SetName(aComponent: TComponent; aName : string); virtual;
property PropName: rawbytestring read FPropName;
property CanHandleExceptions: Boolean read FCanHandleExcepts;
@ -1897,6 +1900,8 @@ type
function ReadComponentDeltaRes(Instance: TComponent; const DeltaCandidates: array of Ansistring; const Proc: TGetStreamProc): TComponent;
function ReadVariant: Variant;
procedure ReadSignature;
// Readstr assumes that valuetype has aleady been read and will raise an error if it was not a string type
function ReadStr : RawByteString;
function ReadString: RawBytestring;
function ReadWideString: WideString;
function ReadUnicodeString: UnicodeString;

54
rtl/objpas/classes/reader.inc
View File

@ -142,12 +142,24 @@ var
b: byte;
begin
Read(b, 1);
Result := TValueType(b);
FCurrentValue:=TValueType(b);
Result := FCurrentValue;
end;
function TBinaryObjectReader.CurrentValue: TValueType;
begin
Result:=FCurrentValue;
end;
function TBinaryObjectReader.NextValue: TValueType;
var
b: byte;
begin
Result := ReadValue;
Read(b,1);
Result:=TValueType(b);
{ We only 'peek' at the next value, so seek back to unget the read value: }
Dec(FBufPos);
end;
@ -377,6 +389,7 @@ begin
Read(Pointer(@Result[1])^, i);
end;
function TBinaryObjectReader.ReadString(StringType: TValueType): RawByteString;
var
b: Byte;
@ -1688,24 +1701,35 @@ begin
end;
function TReader.ReadString: rawbytestring;
function TReader.ReadStr : rawbytestring;
var
StringType: TValueType;
begin
StringType := FDriver.ReadValue;
if StringType in [vaString, vaLString,vaUTF8String] then
begin
Result := FDriver.ReadString(StringType);
if (StringType=vaUTF8String) then
Result:=DoReadString(Driver.CurrentValue)
end;
function TReader.DoReadString(aType : TValueType): rawbytestring;
begin
Case aType of
vaString, vaLString,vaUTF8String:
begin
Result := FDriver.ReadString(aType);
if (aType=vaUTF8String) then
Result:=rawbytestring(utf8Decode(Result));
end
else if StringType in [vaWString] then
Result:= rawbytestring(FDriver.ReadWidestring)
else if StringType in [vaUString] then
Result:= rawbytestring(FDriver.ReadUnicodeString)
end;
vaWString:
Result:= rawbytestring(FDriver.ReadWidestring);
vaUString:
Result:= rawbytestring(FDriver.ReadUnicodeString);
else
raise EReadError.Create(SInvalidPropertyValue);
end;
end;
function TReader.ReadString: rawbytestring;
begin
DoReadString(FDriver.ReadValue);
end;