freepascallazarusfpc

FPC : RTTI on records


This is my first time on this site. Usually, I have no problem to found replies in the old posts but I don't success with my actual problem.

I would like to know how use RTTI functions to know at running time the properties/members of a record under Lazarus/FPC? I know how to do it for a class (Tpersistent descendant and published properties) but not for FPC. Some links indicates how to do it under Delphi (From D2010), but I don't know how to transpose it under Lazarus.

Thanks in advance for help and assistance. Salim Larhrib.

To kevin : As I told before, this is my first demand. But I understand. You are right. This is my code

procedure TMainForm.btRecordTHashListClick(Sender: TObject);
var
  pTData    : PTypeData;
  pTInfo    : PTypeInfo;
  TablePtr  : PatableRecord;
  Loop      : Integer;
begin
  // Set of Record pointers + HashList

  // Create Container
  if  not Assigned(FTableRecList) then FTableRecList := TFPHashList.Create;

  // Insert data
  new(TablePtr);
  TablePtr^.description := 'Dictionnaire des tables.';
  FTableRecList.add('atable', TablePtr );

  new(TablePtr);
  TablePtr^.description := 'Dictionnaire des fonctions.';
  FTableRecList.add('afunction', TablePtr );

  new(TablePtr);
  TablePtr^.description := 'Dictionnaire des listes d''option.';
  FTableRecList.add('alist', TablePtr );

  // Read records
  for Loop:=0 to FTableRecList.Count-1 do
  begin
    TablePtr := FTableRecList[Loop];
    ShowMessage('Parcours Index : ' + TablePtr^.description);
  end;

  // Find records
  try
    TablePtr := FTableRecList.Find('ddafunction');
    ShowMessage('Record finded : ' + TablePtr^.description);
  except
    ShowMessage('Not such record .');
  end;
  try
    TablePtr := FTableRecList.Find('afunction');
    ShowMessage('Record finded : ' + TablePtr^.description);
  except
    ShowMessage('No such record.');
  end;

  // Free memory : To put later in TFPHashList wrapper
  for Loop:=0 to FTableRecList.Count-1 do Dispose(PatableRecord(FTableRecList[Loop]));

// RTTI
  pTInfo := TypeInfo(TatableRecord);

  pTData := GetTypeData(pTInfo);
  ShowMessage('Member count = '+IntToStr(pTData^.PropCount));
end;

Solution

  • WARNING: It works with FPC 2.7.1 or later.

    You can deal with record fields using pointers. Here is example:

    program rttitest;
    
    uses
        TypInfo;
    
    type
        TMyRec = record
            p1: Integer;
            p2: string;
        end;
    
    var
        td: PTypeData;
        ti: PTypeInfo;
        mf: PManagedField;
        p: Pointer;
        f: Pointer;
    
        r: TMyRec;
    
    begin
        r.p1 := 312;
        r.p2 := 'foo-bar';
    
        ti := TypeInfo(r);
        td := GetTypeData(ti);
    
        Writeln(td^.ManagedFldCount); // Get count of record fields
    
        // After ManagedFldCount TTypeData contains list of the TManagedField records
        // So ...
        p := @(td^.ManagedFldCount); // Point to the ManagedFldCount ...
        // Inc(p, SizeOf(Integer)); // Skip it (Wrong for 64-bit targets)
        // Next line works for both
        Inc(p, SizeOf(td^.ManagedFldCount)); // Skip it
    
        mf := p; // And now in the mf we have data about first record's field
        Writeln(mf^.TypeRef^.Name);
    
        Write(r.p1); // Current value
        f := @r;
        Inc(f, mf^.FldOffset); // Point to the first field
        Integer(f^) := 645; // Set field value
        Writeln(r.p1); // New value
    
        // Repeat for the second field
        Inc(p, SizeOf(TManagedField));
        mf := p;
        Writeln(mf^.TypeRef^.Name);
    
        Write(r.p2);
        f := @r;
        Inc(f, mf^.FldOffset);
        string(f^) := 'abrakadabra';
        Writeln(r.p2);
    
    
        Readln;
    end.