while True do
      begin
        J := I;
        while (I <= L) and (PropPath[I] <> '.') do Inc(I);
        FPropName := Copy(PropPath, J, I - J);
        if I > L then Break;
        PropInfo := GetPropInfo(Instance.ClassInfo, FPropName);
        if PropInfo = nil then
        begin
          // Call DefineProperties with the entire PropPath
          // to allow defining properties such as "Prop.SubProp"
          FPropName := PropPath;
          { Cannot reliably recover from an error in a defined property }
          FCanHandleExcepts := False;
          Instance.DefineProperties(Self);
          FCanHandleExcepts := True;
          if FPropName <> '' then
            PropertyError(FPropName);
          Exit;
        end;

procedure TMyReader.MyReadDataInner(Instance: TComponent);
var
  OldParent, OldOwner: TComponent;
begin
  while not EndOfList do ReadPropertyXE(Instance);
  ReadListEnd;
  OldParent := Parent;
  OldOwner := Owner;
  Parent := THackComp(Instance).GetChildParent;
  try
    Owner := THackComp(Instance).GetChildOwner;
    if not Assigned(Owner) then Owner := Root;
    while not EndOfList do ReadComponent(nil);
    ReadListEnd;
  finally
    Parent := OldParent;
    Owner := OldOwner;
  end;
end;

// скопировал с XE2
procedure TMyReader.ReadPropertyXE(AInstance: TPersistent);
var
  I, J, L: Integer;
  Instance: TPersistent;
  PropInfo: PPropInfo;
  PropValue: TObject;
  PropPath: string;

  procedure HandleException(E: Exception);
  var
    Name: string;
  begin
    Name := '';
    if AInstance is TComponent then
      Name := TComponent(AInstance).Name;
    if Name = '' then Name := AInstance.ClassName;
    raise EReadError.CreateResFmt(@SPropertyException, [Name, DotSep, PropPath, E.Message]);
  end;

  procedure PropPathError;
  begin
    SkipValue;
    raise EReadError.CreateRes(@SInvalidPropertyPath);
  end;

var P: Pointer;
begin
  try
    PropPath := ReadStr;
    try
      I := 1;
      L := Length(PropPath);
      Instance := AInstance;

      PBoolean(@(CanHandleExceptions))^ := true; // пишем в ReadOnly свойство
      while True do
      begin
        J := I;
        while (I <= L) and (PropPath[I] <> '.') do Inc(I);
        PString(@(PropName))^ := Copy(PropPath, J, I - J);
        if I > L then Break;
        PropInfo := GetPropInfo(Instance.ClassInfo, PropName);
        if PropInfo = nil then
        begin
          // Call DefineProperties with the entire PropPath
          // to allow defining properties such as "Prop.SubProp"
          PString(@(PropName))^ := PropPath;
          { Cannot reliably recover from an error in a defined property }
          PBoolean(@(CanHandleExceptions))^ := False;
          THackComp(Instance).DefineProperties(Self);
          PBoolean(@(CanHandleExceptions))^ := True;
          if PropName <> '' then
            PropertyError(PropName);
          Exit;
        end;
        PropValue := nil;
        if PropInfo^.PropType^.Kind = tkClass then
          PropValue := TObject(GetOrdProp(Instance, PropInfo));
        if not (PropValue is TPersistent) then PropPathError;
        Instance := TPersistent(PropValue);
        Inc(I);
      end;
      PropInfo := GetPropInfo(Instance.ClassInfo, PropName);
      if PropInfo <> nil then
        ReadPropValue(Instance, PropInfo)
      else
      begin
        { Cannot reliably recover from an error in a defined property }
        PBoolean(@(CanHandleExceptions))^ := False;
        THackComp(Instance).DefineProperties(Self);
        PBoolean(@(CanHandleExceptions))^ := True;
        if PropName <> '' then
          PropertyError(PropName);
      end;
    except
      on E: Exception do HandleException(E);
    end;
  except
    on E: Exception do
      if not CanHandleExceptions or not Error(E.Message) then raise;
  end;
end;