Watch, Follow, &
Connect with Us

For forums, blogs and more please visit our
Developer Tools Community.


Welcome, Guest
Guest Settings
Help

Thread: TCustomAttribute not detected at the record level


This question is not answered. Helpful answers available: 2. Correct answers available: 1.


Permlink Replies: 0
Hafedh TRIMECHE

Posts: 107
Registered: 12/29/06
TCustomAttribute not detected at the record level  
Click to report abuse...   Click to reply to this thread Reply
  Posted: Jan 2, 2017 6:50 AM
considering the record definitions, the RttiAttr(daIndex) attribute assigned to CheckSignerSubject is not detected as a custom attribute.
Please how properly use the TCustomAttribute to annotate any record field at any level ?
  TDBRecordHeader=
  packed record
    Index     : Int64;
    Indicator : Int64;
  end;
 
  TThreeDConfig=
  packed record
    DSSubject       : Int64;
    DSURL           : UnicodeString;
    DSP12           : TBytes;
 
    AHSSubject      : Int64;
    AHSURL          : UnicodeString;
    AHSP12          : TBytes;
 
    ACSSignSubject  : Int64;
    ACSSignP12      : TBytes;
  end;
  TProcessingObjects=
  packed record
    Head                : TDBRecordHeader;
    BannedIP            : UnicodeString;
    BannedBINs          : UnicodeString;
    [RttiAttr(daIndex)]
    CheckSignerSubject  : Int64;
    CheckSignerURL      : UnicodeString;
    CheckSignerP12      : TBytes;
    CheckBIN            : Cardinal;
    ThreeDConfig        : array[1..4] of TThreeDConfig;
  end;


  TDataAttribute    = (daBinary,daEncrypted,daIndex,daVoid);
  RttiAttr = class(TCustomAttribute)
  private
    FAttr : TDataAttribute;
  public
    Constructor Create(AnAttr:TDataAttribute);
    property Attr:TDataAttribute read FAttr;
  end;
 
constructor RttiAttr.Create(AnAttr:TDataAttribute);
begin
  FAttr := AnAttr;
end;


The Rtti parser is illustrated:
procedure RttiSchema(const DataInfo:PTypeInfo;var Schema:TRttiSchema;IsRoot:Boolean;FieldName:ShortString;ArrayIndex:Integer);
var
  RttiContext : TRttiContext;
  Fields      : TArray<TRttiField>;
  nbFields    : Integer;
  Attr        : TCustomAttribute;
  FieldType   : TRttiType;
  Attrs       : TArray<TCustomAttribute>;
  ArrayData   : TArrayTypeData;
  Named       : Boolean;
  iArray      : Integer;
  iField      : Integer;
  Item        : TDataMapItem;
  s           : string;
function GetDataSize(const TypeInfo:PTypeInfo):Integer;
begin
  Result := 0;
  if TypeInfo=nil then Exit;
  case TypeInfo^.Kind of
    tkInteger, tkEnumeration, tkChar, tkWChar:
      case GetTypeData(TypeInfo)^.OrdType of
        otSByte ,
        otUByte : Exit(SizeOf(Byte));
        otSWord ,
        otUWord : Exit(SizeOf(SmallInt));
        otSLong ,
        otULong : Exit(SizeOf(Integer));
      end;
    tkSet: Exit(SizeOf(TDataAttributes));
    tkFloat:
      case GetTypeData(TypeInfo)^.FloatType of
        TypInfo.ftSingle   : Exit(SizeOf(Single));
        TypInfo.ftDouble   : Exit(SizeOf(Double));
        TypInfo.ftExtended : Exit(SizeOf(Extended));
        (*
        TypInfo.ftComp     : Exit(8);
        TypInfo.ftCurr     : Exit(8);
        *)
      end;
    tkInt64    : Exit(SizeOf(Int64));
    tkDynArray ,
    tkUString  ,
    tkLString  ,
    tkWString  : Exit(SizeOf(Pointer));
    tkString   : Exit(SizeOf(ShortString));
    tkRecord   : Exit(GetTypeData(TypeInfo)^.RecSize);
    tkArray    : Exit(GetTypeData(TypeInfo)^.ArrayData.Size);
  end;
end;
procedure SetLevel(var Item:TDataMapItem);
var
  i : Integer;
begin
  for i:=1 to Schema[0].IdxOrCnt-1 do
  begin
    if Schema[0].Name=Item.Parent then
    begin
      Schema[Schema[0].IdxOrCnt].Level := Schema[0].Level;
      Exit;
    end;
    if (Schema[i].Parent=Item.Parent) then
    begin
      Schema[Schema[0].IdxOrCnt].Level := Schema[i].Level;
      Exit;
    end;
  end;
  Schema[Schema[0].IdxOrCnt].Level := Schema[Schema[0].IdxOrCnt-1].Level+1;
end;
begin
  if IsRoot then
  begin
    SetLength(Schema,MaxDataMapItems);
    FillChar(Schema[0],SizeOf(Schema[0]),0);
    Schema[0].Parent := DataInfo.Name;
    Schema[0].Name   := DataInfo.Name;
    Schema[0].Level  := 1;
  end;
  RttiContext := TRttiContext.Create;
  FieldType   := RttiContext.GetType(DataInfo);
  Fields      := FieldType.GetFields;
  nbFields    := Length(Fields);
  Named       := nbFields>0;
  if nbFields=0 then Inc(nbFields);
  for iField:=0 to nbFields-1 do
  begin
    Item.Level    := 0;
    Item.IdxOrCnt := ArrayIndex;
    Item.Field    := rtUnknown;
    Item.Size     := GetDataSize(DataInfo);
    Item.IsIndex  := False;
    if Named then
    begin
      FieldName := ShortString(Fields[iField].Name);
      FieldType := Fields[iField].FieldType;
    end;
 
    if Assigned(FieldType) then
    begin
      Attrs := FieldType.GetAttributes;
      for Attr in Attrs do
      begin
        if (Attr is RttiAttr) then
        begin
          if (Attr as RttiAttr).Attr=daBinary    then Item.Field := rtBinary;
          if (Attr as RttiAttr).Attr=daEncrypted then Item.Field := rtEncrypted;
          if (Attr as RttiAttr).Attr=daVoid      then Item.Field := rtVoid;
          if (Attr as RttiAttr).Attr=daIndex     then
          begin
            Item.IsIndex := True;
          end;
        end;
      end;
    end;
    case DataInfo.Kind of
      {Integer}
      tkInteger:
      begin
        case Item.Size of
          SizeOf(Byte)    : Item.Field := rtByte;
          SizeOf(Word)    : Item.Field := rtSmallint;
          SizeOf(Integer) : Item.Field := rtInteger;
        end;
      end;
      {AnsiChar}
      tkChar        : Item.Field := rtAnsiChar;
      {Byte,Boolean}
      tkEnumeration : Item.Field := rtByte;
      {Single,Float,Extended,DateTime,Date,Time}
      tkFloat:
      begin
        case Item.Size of
          SizeOf(Single)   : Item.Field := rtSingle;
          SizeOf(Double)   : Item.Field := rtFloat;
          SizeOf(Extended) : Item.Field := rtExtended;
        end;
        if DataInfo=TypeInfo(TDateTime) then Item.Field := rtDateTime else
        if DataInfo=TypeInfo(TDate)     then Item.Field := rtDate     else
        if DataInfo=TypeInfo(TTime)     then Item.Field := rtTime     else
        ;
      end;
      {ShortString}
      tkString : Item.Field := rtShortString;
      tkSet    : Item.Field := rtByte;
      {WideChar}
      tkWChar : Item.Field := rtWideChar;
      {AnsiString}
      tkLString : Item.Field := rtRawString;
      tkRecord:
      begin
        Schema[0].Parent := DataInfo.Name;
        FieldType        := Fields[iField].FieldType;
        if FieldType<>nil then
        begin
          if Item.Field=rtBinary then
          begin
            Item.Size  := FieldType.TypeSize;
            Item.Field := rtBinary;
          end
          else RttiSchema(FieldType.Handle,Schema,False,FieldName,Item.IdxOrCnt);
        end
        else
        begin
          Item.Field := rtEnumeration;
          Item.Size  := SizeOf(TDataAttribute);
        end;
      end;
      tkInt64    : Item.Field := rtLargeint;
      tkDynArray : Item.Field := rtBlob;
      {UnicodeString}
      tkUString : Item.Field := rtUnicode;
      tkArray:
      begin
        ArrayData := DataInfo.TypeData.ArrayData;
        for iArray:=1 to ArrayData.ElCount do RttiSchema(ArrayData.ElType^,Schema,False,FieldName,iArray);
      end;
      else raise ENotSupportedData.Create(string(DataInfo.Name));
    end;
    if Item.Field<>rtUnknown then
    begin
      Inc(Schema[0].IdxOrCnt);
      Inc(Schema[0].Size,Item.Size);
      Item.Name                  := FieldName;
      Item.IsDynamic             := not(Item.Field in rtFixedSizeTypes);
      Item.IsBlob                := Item.Field in [rtBlob];
      Item.IsUnicode             := Item.Field in [rtUnicode];
      Item.Parent                := Schema[0].Parent;
      Schema[Schema[0].IdxOrCnt] := Item;
      SetLevel(Item);
    end;
  end;
  RttiContext.Free;
end;


Edited by: Hafedh TRIMECHE on Jan 2, 2017 6:50 AM
Legend
Helpful Answer (5 pts)
Correct Answer (10 pts)

Server Response from: ETNAJIVE02