[fpc-pascal] Request to make TJSONStreamer.StreamProperty virtual

Hairy Pixels genericptr at gmail.com
Mon Oct 17 15:49:35 CEST 2022



> On Oct 17, 2022, at 2:48 PM, Michael Van Canneyt via fpc-pascal <fpc-pascal at lists.freepascal.org> wrote:
> 
> Small follow-up:
> 
> If you want to extend it, you can find the necessary code in the restbase
> unit. It already implements the necessary code to (de)stream arrays, plus
> some other enhancements as well. It's on my TODO list to merge the
> implementations taking TJSONStreamer as a base, but if you are busy with this maybe you can provide a patch...

I probably don’t know enough about the library to do this well or quickly enough. This is what I hacked together but it only works on the 2 array types I need and I may not have done this correctly even.

function TLSPStreamer.StreamProperty(Const AObject: TObject; PropertyInfo: PPropInfo): TJSONData;
type
  TVariantArray = array of Variant;
  TObjectArray = array of TObject;
var
  PropArray: TJSONArray;
  ElementType: PTypeInfo;
  VariantArray: TVariantArray;
  ObjectArray: TObjectArray;
  i: integer;
begin
  Result := nil;

  if PropertyInfo^.PropType^.Kind = tkDynArray then
    begin
      // Class kinds are in ElType2 (not sure why)
      ElementType := GetTypeData(PropertyInfo^.PropType)^.ElType;
      if ElementType = nil then
        ElementType := GetTypeData(PropertyInfo^.PropType)^.ElType2;

      PropArray := TJSONArray.Create;

      case ElementType^.Kind of
        tkVariant:
          begin
            VariantArray := TVariantArray(GetDynArrayProp(AObject, PropertyInfo));
            for i := 0 to High(VariantArray) do
              PropArray.Add(StreamVariant(VariantArray[i]));
            Result := PropArray;
          end;
        tkClass:
          begin
            ObjectArray := TObjectArray(GetDynArrayProp(AObject, PropertyInfo));
            for i := 0 to High(ObjectArray) do
              PropArray.Add(StreamClassProperty(ObjectArray[i]));
            result := PropArray;
          end;
        otherwise
          raise EUnknownErrorCode.Create('Dynamic array element type "'+Integer(ElementType^.Kind).ToString+'" is not supported for responses.');
      end;
    end
  else
    Result := inherited StreamProperty(AObject, PropertyInfo);
end;

Regards,
	Ryan Joseph



More information about the fpc-pascal mailing list