Browse Source

* Add TReader.ReadStr for Delphi compatibility

Michaël Van Canneyt 1 year ago
parent
commit
689fae7dd9
2 changed files with 45 additions and 16 deletions
  1. 6 1
      rtl/objpas/classes/classesh.inc
  2. 39 15
      rtl/objpas/classes/reader.inc

+ 6 - 1
rtl/objpas/classes/classesh.inc

@@ -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;

+ 39 - 15
rtl/objpas/classes/reader.inc

@@ -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;