Introduction aux RTTI sous Delphi

Testé sous Delphi 2005 update3.
Version 1.0

I-A. Les sources▲

L'objectif premier des informations de types à l'exécution (alias RTTI) est de permettre à l'IDE de reconnaître et de manipuler des classes, plus précisément des composants, qui ont été définis bien après la commercialisation de Delphi.
Le mode conception de fiche ne serait pas possible sans le mécanisme de RTTI qui est également lié à la sérialisation, c'est-à-dire la persistance sur disque des fiches (forms) conçues et contenant des composants (fichiers .DFM). Je n'aborderai pas ici la sérialisation, le sujet nécessitant à lui seul un tutoriel.

RTTI est donc la clef de voûte entre les composants Delphi et leur incorporation et manipulation dans L'EDI. Il permet de retrouver des informations sur le type d'une instance de classe lors de l'exécution d'un programme, ce type pouvant être inconnu lors de la compilation.

Le premier niveau d'information que l'on peut récupérer passe par les méthodes de la classe ancêtre primaire : TObject.
On peut retrouver par exemple le nom de la classe via la méthode ClassName ou encore le type de la classe via la méthode ClassType. Cette dernière renvoyant une référence de classe, et pas un pointeur, de l'instance de classe interrogée ce qui permettrait par exemple de créer une seconde instance de même classe sans pour autant connaître le nom de la classe lors de la compilation.
Il existe également la méthode TObject.InheritsFrom qui permet de déterminer, au travers des opérateurs IS et AS, si une instance est d'une classe particulière ou non. Je vous renvoie à l'aide en ligne pour l'usage de ces deux opérateurs.

En revanche le second niveau d'informations plus détaillées est accessible uniquement via des traitements de bas niveau qui ne sont pas implémentés dans la classe TObject.
Pour accéder à ces informations générées par le compilateur, l'appel de la méthode TObject.ClassInfo renvoie un pointeur sur un enregistrement de type TTypeInfo.

class function TObject.ClassInfo: Pointer;
begin
  Result := PPointer(Integer(Self) + vmtTypeInfo)^;
end;

On s'aperçoit que ces autres informations sont liées à la VMT ou Virtual Methods Table (Table des Méthodes Virtuelles).
Aux offsets positifs, une VMT se compose d'une liste de pointeurs de méthodes, un par méthode virtuelle définie par l'utilisateur, dans l'ordre de déclaration au sein de la classe.
Aux offsets négatifs, une VMT contient un certain nombre de champs utilisés en interne. Par exemple, la valeur de la constante vmtTypeInfo est -60.

L'inconvénient majeur est que ces informations RTTI sont peu documentées par Borland, les types et procédures permettant de les manipuler se trouvent dans l'unité TypInfo.pas.
Avant d'aller plus loin, il faut savoir que l'usage de RTTI au sein d'un programme apporte un temps de traitement supplémentaire lors de son exécution.

Projet : ..\RTTI\RTTI1

Déclarons une classe simple :

type
  TMonObjet=Class(TObject)
   ChampUn : Integer;  
   ChampDeux : String; 
   Function SiExiste:Boolean;
   Procedure Traite(S:String);
  end;

On peut d'ores et déjà appeler les méthodes renvoyant des informations de type de premier niveau sur l'instance créée :

Var UnObjet  : TMonObjet;

begin
  UnObjet:=TMonObjet.Create;
  UnObjet.ChampUn:=3;

   // Nom de la classe
  Writeln('UnObjet est de la classe : ',UnObjet.ClassName);

   // Teste si l'instance hérite d'une classe particulière
  If UnObjet.InheritsFrom(TComponent) then
   Writeln('UnObjet hérite de TComponent.');

    // La classe parente, l'ancêtre
  Writeln('Le parent de UnObjet est de la classe : ',UnObjet.ClassParent.ClassName);
    //Taille de l'instance 
  Writeln('Taille de UnObjet : ',UnObjet.InstanceSize);

  Readln;
  UnObjet.Free;
end.

En revanche pour retrouver des informations de type de second niveau sur l'instance créée, on doit utiliser un peu plus de code.
Ajoutons une variable pour récupérer les informations de type :

Var UnObjet  : TMonObjet;
    InfoRTTI : Pointer;

Puis en fin de programme l'appel de la méthode ClassInfo :

  InfoRTTI:=UnObjet.ClassInfo;
  If Not Assigned(InfoRTTI)
   then Writeln('UnObjet n''a pas d''information de type.')
   else AfficheInfoRTTI(InfoRTTI);
  Readln;
  UnObjet.Free;
end.

Nous verrons plus avant le détail de la méthode AfficheInfoRTTI.

Le code précédent nous affichera que la variable UnObjet n'a pas d'information de type. Ceci est dû au fait que le code compilé n'en contient tout simplement pas ! La directive de compilation {$M}, de portée locale, doit être activée par {$M+} pour que la génération de ces informations soit effective.

Je vous laisse consulter l'aide en ligne de Delphi concernant cette directive au lieu de la recopier ici dans son intégralité. Sachez qu'une classe descendant d'une classe compilée avec cette directive bénéficie des informations RTTI, dans ce cas la directive {$M} devient inutile (voir par exemple la classe TPersistent).

Ajoutons cette directive en début de programme et recompilons.
Malheureusement nous obtenons l'erreur suivante :

E2217: Le champ publié 'ChampUn' n'est pas un type classe ou interface.

L'aide en ligne nous indique qu'une tentative a été effectuée pour publier un champ dans une classe qui n'est pas une classe ni un type interface.
Sans précision dans la déclaration de la classe, les membres sont public par défaut. Ajoutons la directive private pour compiler correctement ce programme :

TMonObjet=Class(TObject)
  private 
   ChampUn : Integer;

Recompilons et exécutons de nouveau ce programme.
Cette fois-ci le résultat est différent :

Nom du type d'information : TMonObjet
Type de donnée : tkClass
Définie dans le fichier : RTTI11.pas
Nombre de propriétés : 0

On retrouve le nom de la classe de notre instance, son type, le fichier dans laquelle elle est déclarée et le nombre de propriétés qu'elle possède.

Revenons au code de la procédure d'affichage :

procedure AfficheInfoRTTI(Informations : PTypeInfo);

Voici la déclaration de l'enregistrement PTypeInfo :

  PPTypeInfo = ^PTypeInfo;
  PTypeInfo = ^TTypeInfo;
  TTypeInfo = record
    Kind: TTypeKind;
    Name: ShortString;
  end;

On voit que l'on pourra être amené à manipuler des pointeurs de pointeur de TTypeInfo et que le champ Kind renvoie vers l'énumération suivante0160 :

TTypeKind = (tkUnknown, tkInteger, tkChar, tkEnumeration, tkFloat,
    tkString, tkSet, tkClass, tkMethod, tkWChar, tkLString, tkWString,
    tkVariant, tkArray, tkRecord, tkInterface, tkInt64, tkDynArray);

L'énumération TTypeKind contient les types de données accessibles via les informations RTTI.

Continuons avec le code de la procédure d'affichage :

procedure AfficheInfoRTTI(Informations : PTypeInfo);
var DonneeDeType : PTypeData; //Information supplémentaire
    NomEnumeration : String;

begin
 Writeln('Nom du type d''information : ',Informations.Name);
 // il n'existe pas de méthode pour afficher le champ Kind
 //Writeln('Type d''information :',Informations.Kind);

 DonneeDeType := GetTypeData(Informations);
 NomEnumeration := GetEnumName(TypeInfo(TTypeKind), Integer(Informations.Kind));

 Writeln('Type de donnee : ', NomEnumeration);
 // Appel +- Identique
 //NomEnumeration := GetSetElementName(TypeInfo(TTypeKind), Integer(Informations.Kind));
 //Writeln('Type de donnée 2 : ', NomEnumeration);

 Writeln('Definie dans le fichier : ', DonneeDeType.UnitName,'.pas');
 Writeln('Nombre de proprietes : ',DonneeDeType.PropCount);
end;

La fonction GetTypeData renvoie un pointeur vers un enregistrement de type PTypeData qui est un record avec une partie variable (voir ce tutoriel sur le langage Pascal) :

  PTypeData = ^TTypeData;
  TTypeData = packed record
    case TTypeKind of
      tkUnknown, tkLString, tkWString, tkVariant: ();
      tkInteger, tkChar, tkEnumeration, tkSet, tkWChar: (
        OrdType: TOrdType;
        case TTypeKind of
          tkInteger, tkChar, tkEnumeration, tkWChar: (
            MinValue: Longint;
            MaxValue: Longint;
            case TTypeKind of
              tkInteger, tkChar, tkWChar: ();
              tkEnumeration: (
                BaseType: PPTypeInfo;
                NameList: ShortStringBase;
                EnumUnitName: ShortStringBase));
          tkSet: (
            CompType: PPTypeInfo));
      tkFloat: (
        FloatType: TFloatType);
      tkString: (
        MaxLength: Byte);
      tkClass: (
        ClassType: TClass;
        ParentInfo: PPTypeInfo;
        PropCount: SmallInt;
        UnitName: ShortStringBase;
       {PropData: TPropData});
      tkMethod: (
        MethodKind: TMethodKind;
        ParamCount: Byte;
        ParamList: array[0..1023] of Char
       {ParamList: array[1..ParamCount] of
          record
            Flags: TParamFlags;
            ParamName: ShortString;
            TypeName: ShortString;
          end;
        ResultType: ShortString});
      tkInterface: (
        IntfParent : PPTypeInfo; { ancestor }
        IntfFlags : TIntfFlagsBase;
        Guid : TGUID;
        IntfUnit : ShortStringBase;
       {PropData: TPropData});
      tkInt64: (
        MinInt64Value, MaxInt64Value: Int64);
      tkDynArray: (
        elSize: Longint;
        elType: PPTypeInfo;       // nil if type does not require cleanup
        varType: Integer;         // Ole Automation varType equivalent
        elType2: PPTypeInfo;      // independent of cleanup
        DynUnitName: ShortStringBase);
  end;

Cet enregistrement utilise de nombreuses énumérations qui permettent de détailler le type de donnée interrogé :

  TOrdType = (otSByte, otUByte, otSWord, otUWord, otSLong, otULong);

  TFloatType = (ftSingle, ftDouble, ftExtended, ftComp, ftCurr);

  TMethodKind = (mkProcedure, mkFunction, mkConstructor, mkDestructor,
    mkClassProcedure, mkClassFunction, mkClassConstructor, mkOperatorOverload,
    { Obsolete }
    mkSafeProcedure, mkSafeFunction);

Vous trouverez le projet modifié dans
Projet : ..\RTTI\RTTI11

La fonction GetEnumName renvoie une chaine de caractères contenant le nom du type porté par le champ Kind. On doit transtyper l'énumération TTypeKind en TypeInfo pour pouvoir l'interroger. Pour la classe de notre exemple, nous récupérons la valeur tkClass.

Les autres procédures de l'unité TypInfo.pas sont dédiées à la manipulation des interfaces, des méthodes et surtout des propriétés.

Essayons maintenant de récupérer des informations sur la méthode Traite de notre classe :

Var UnObjet  : TMonObjet;
    InfoRTTI : Pointer;
    M : TMethod;
begin
  ...
  M:=GetMethodProp(UnObjet,'Traite');
  readln;
  UnObjet.Free;  
end.

Ce code déclenche une exception EPropertyError : 'La propriété traite n'existe pas'.

On pourrait croire que le simple fait que notre classe hérite de TPersistent permette d'accéder aux RTTI, mais il n'en est rien.
La méthode TObject.ClassInfo renvoie des informations sur le type des propriétés publiées ce qui fait que notre classe telle qu'elle est construite ne permet pas de récupérer ce type d'informations.
On doit donc modifier la déclaration de la classe afin de publier des propriétés.

Texte issu de l'aide en ligne :
Les membres publiés ont la même visibilité que les membres publics. La différence est que des informations de type à l'exécution (RTTI) sont générées pour les membres publiés. Ces informations permettent à une application d'interroger dynamiquement les champs et les propriétés d'un objet et de localiser ses méthodes. Les RTTI sont utilisées pour accéder aux valeurs des propriétés lors de la lecture ou de l'enregistrement des fichiers fiche, pour afficher les propriétés dans l'inspecteur de propriétés et pour associer des méthodes spécifiques (appelées gestionnaires d'événements) à des propriétés spécifiques (appelées événements).

La directive Published n'est pas liée au concept d'héritage, mais permet la redéfinition de propriété en passant sa visibilité de protégée à publiée.

La génération RTTI s'applique seulement pour :

1. Les classes qui descendent de Tpersistent ;
2. Les classes compilées avec la directive {$M+} ;
3. Les interfaces qui descendent d'IInvokeable.

Note
Consultez les nombreuses informations disponibles dans l'aide en ligne traitant des membres publiés et des propriétés.

Sachez qu'il existe la méthode TPersistent.DefineProperties qui permet de sauvegarder les propriétés non publiées d'une classe lors d'une opération de sérialisation, mais dans ce cas c'est au développeur de gérer cette opération.

Vous ne pouvez pas transmettre des informations de type à l'exécution (RTTI) Delphi entre DLL ou d'une DLL à un exécutable. Si vous transmettez un objet d'une DLL vers une autre ou vers un exécutable, vous ne pouvez pas utiliser les opérateurs is ou as avec l'objet transmis. En effet, les opérateurs is et as doivent comparer les informations RTTI. Si vous devez transmettre des objets à partir d'une bibliothèque, utilisez plutôt des packages, car ceux-ci peuvent partager les informations RTTI. De même, vous devez utiliser des packages au lieu de DLL dans les services web, car ils reposent sur des informations RTTI Delphi.

Projet : ..\RTTI\RTTI12

La publication ne peut se faire que sur des membres, déclarées avec le mot clé property et placées dans la section published d'une déclaration de classe.
La publication de méthodes d'une classe nécessite de définir un type pointeur de méthode se terminant par le mot clé Of Object.

type
  TTraitement = Procedure (S:String) of Object;

Appliquons ensuite les conventions de nommage Borland qui sont pour

• les champs, de préfixer le nom du champ par F pour field ;
• les événements, de préfixer le nom de la propriété par On.

  TMonObjet=Class(TObject)
   private
    FChampUn : Integer;
    FChampDeux : String;
    FOnTraite :TTraitement;
   public
    Function SiExiste:Boolean;
    Property Champ1:Integer read FChampUn Write FChampUn;
   published
    Property Champ2:String read FChampDeux Write FChampDeux;
    Property OnTraitement:TTraitement read FOnTraite Write FOnTraite;
  end;

Ajoutons le code pour visualiser le nom des propriétés de notre classe :

procedure AffichePropriete;
var
  Nombre, I: Integer;
  ListeProprietes: TPropList;
begin
  Writeln;
  Nombre := GetPropList(TMonObjet.ClassInfo, tkAny, @ListeProprietes);
  for I := 0 to Nombre-1 do
    Writeln('Propriete ',I+1,' = ',ListeProprietes[I]^.Name);
end;

On utilise ici une liste d'enregistrements de type TPropInfo qui permet de retrouver certaines informations sur une propriété :

  PPropInfo = ^TPropInfo;
  TPropInfo = packed record
    PropType: PPTypeInfo; // Information sur le type de la propriété
    GetProc: Pointer; // Getter
    SetProc: Pointer; //Setter  
    StoredProc: Pointer; // Pointeur de procédure pour le mot clé stored
    Index: Integer; // Index pour un tableau de propriétés
    Default: Longint; // Valeur par défaut
    NameIndex: SmallInt; // Index pour les propriétés indexées.
    Name: ShortString; // Nom de la propriété
  end;

Une des fonctions GetPropList surchargées renvoie le nombre de propriétés trouvées :

• le premier paramètre attendu est l'enregistrement contenant les informations de type de la classe ;
• le second paramètre est le type de donnée recherché ;
• le troisième paramètre est la liste de record hébergeant le résultat de la recherche ;
• enfin le quatrième paramètre permet de retrouver les propriétés triées ou non.

function GetPropList(TypeInfo: PTypeInfo; TypeKinds: TTypeKinds;
  PropList: PPropList; SortList: Boolean): Integer;

Il est possible d'utiliser la procédure GetPropInfos, mais dans ce cas il faut récupérer le nombre de propriétés par l'appel de :

GetTypeData(TMonObjet.ClassInfo).PropCount

L'exécution du programme ainsi modifié nous permet bien de récupérer des informations supplémentaires :

UnObjet est de la classe : TMonObjet
Le parent de UnObjet est de la classe : TObject
Taille de UnObjet : 24
Nom du type d'information : TMonObjet
Type de donnee : tkClass
Definie dans le fichier : RTTI12.pas
Nombre de proprietes : 2

Propriete 1 = Champ2
Propriete 2 = OnTraitement

Le nombre de propriétés indiquées est 2 et non pas 3, car nous n'avons publié que deux propriétés. Celles déclarées hors de la section published ne sont donc pas accessibles. On peut savoir savoir si une propriété est publiée par l'appel suivant :

If Not IsPublishedProp(UnObjet,'Champ1')
   then Writeln('La propriété Champ1 n''est pas publiée');

Remarquez aussi que l'appel de la méthode GetMethodProp(UnObjet,'OnTraitement'), adaptée aux nouvelles déclarations, ne provoque plus d'exception. Le contenu de la variable M est égal à Nil étant donné que la propriété OnTraitement n'est pas renseignée.

Projet : ..\RTTI\RTTI13

Une fois obtenue la liste d'enregistrements de type TPropInfo, il est possible d'afficher le détail d'une propriété publiée.
Créons une méthode dédiée à l'affichage à laquelle nous passerons un élément du tableau ListeProprietes, affichons dans un premier temps les champs d'enregistrements du type TPropInfo. Nous aborderons plus tard le traitement du champ TPropInfo.PropType, traitement qui sera bien évidemment différent selon le type de donnée de la propriété.

procedure AfficheDetails(Informations : TPropInfo);
var
 TypePropriete : String;
 DonneePropriete: PTypeData;
begin
  // Détermine le type de la propriété
  With Informations do
  begin
   Writeln('Propriete de Type ',PropType^.Name);
   if not Assigned(GetProc)
    then Writeln('Nil')
    else Writeln(Format('Getter : %p', [GetProc]));

   if not Assigned(SetProc)
    then Writeln('Nil')
    else Writeln(Format('Setter : %p', [SetProc]));

   if not Assigned(StoredProc)
    then Writeln('Nil')
    else Writeln(Format('StoredProc : %p', [StoredProc]));

   Writeln(Format('Index : %x', [Index]));
   Writeln(Format('Default : %x', [Default]));
   Writeln('NameIndex :',NameIndex);

   case PropType^.Kind of
    tkInteger : writeln('Pas de donnees supplementaires');
    tkLString : writeln('Pas de donnees supplementaires');
    tkMethod  : writeln('Type methode');
   end;
  end;
end;

L'appel de cette méthode se faisant dans la boucle utilisée précédemment :

for I := 0 to Nombre-1 do
  begin
   Writeln('Propriete ',I+1,' = ',ListeProprietes[I]^.Name);
   AfficheDetails(ListeProprietes[I]^);
   Writeln;
  end;

Voici l'affichage des informations détaillées :

Propriété 1 = Champ2
Propriété de Type string
Getter : FF000008
Setter : FF000008
StoredProc : 00000001
Index : 80000000
Default : 80000000
NameIndex :0
Pas de données supplémentaires

Propriété 2 = OnTraitement
Propriété de Type TTraitement
Getter : FF000010
Setter : FF000010
StoredProc : 00000001
Index : 80000000
Default : 80000000
NameIndex :1
Type méthode

Pour les champs Getter et Setter on pouvait s'attendre à ce qu'ils contiennent nil, mais la valeur affichée contient deux informations, propres à la déclaration de notre classe, qui sont :

• le mode d'accès pour Read et Write, ici il s'agit d'un accès direct sur le champ, mais cela pourrait être un accès in direct via une méthode ;
• et l'index du champ adressé FonTraite.

Une traduction automatique de cet article russe associée à cet exemple trouvé sur CodeCentral m'a permis de faire ces déductions :

• si le premier octet est égal à $FF il s'agit d'un accès direct au champ (les derniers octets indiquent l'offset du champ) ;
• si le premier octet est égal à $FE il s'agit d'un accès par une méthode virtuelle, ici les derniers octets indiquent l'index dans la VMT et non son adresse réelle) ;
• si le premier octet est inférieur à $FE il s'agit de l'adresse d'une méthode statique. Dans ce cas la valeur peut être différente selon les compilations ;
• si la valeur est égale à $80000000 la méthode est indéterminée, il s'agit d'une propriété en Read Only par exemple ;
• toute autre valeur indique une méthode statique. Bien qu'il reste une autre possibilité que je n'ai pas encore éclaircie :

if (Integer(Value) and $FFFFFF00) = 0 then
   Result := ptConstant

Pour le champ StoredProc la valeur 1 indique que le champ est stocké et la valeur 0 qu'il ne l'est pas.
Rappel : Si la propriété n'a pas de directive stored, elle est traitée comme si stored True était spécifié.

Pour les champs Index et Default, la valeur $80000000 semble indiquer que c'est la valeur par défaut ou que l'information de ces directives n'est pas précisée.

Voici une autre version (Delphi in a Nutshell) de la méthode d'affichage :

// Code issu de http://codecentral.borland.com/Item.aspx?id=18460
function GetProcType(Value: Pointer): TStoredType;
begin
  if (Integer(Value) and $FFFFFF00) = 0 then
    Result := ptConstant
  else if (Integer(Value) and $FF000000) = $FE000000 then
    Result := ptVirtualMethod
  else if (Integer(Value) and $FF000000) = $FF000000 then
    Result := ptField
  else
    Result := ptStaticMethod
end;

function GetProcValue(Value: Pointer): Integer;
begin
  case GetProcType(Value) of
  ptVirtualMethod, ptField:
    Result := Integer(Value) and $00FFFFFF;
  else
    Result := Integer(Value);
  end;
end;

procedure WritePropertyProc(const Str: string; Proc: Pointer);
const
  BooleanStrings: array[0..1] of string = ('False', 'True');
begin
  case GetProcType(Proc) of
   ptConstant      : Write(Format(' %s %s', [Str, BooleanStrings[GetProcValue(Proc)]]));
   ptField         : Write(Format(' %s (Champ %d)', [Str, GetProcValue(Proc)]));
   ptVirtualMethod : Write(Format(' %s (méthode virtuelle %d)', [Str, GetProcValue(Proc)]));
   ptStaticMethod  : Write(Format(' %s (methode statique %p)', [Str, Proc]));
  end;
end;

procedure AfficheDetails2(Informations : TPropInfo);
begin
 With Informations do
 begin
  //Write(Format('Propriété %s: %s', [GetName, PropType^.Name]));
  Write(Format('Propriete %s : %s', [Name,PropType^.Name]));
  //Informations.PropType^
  if Index <> Low(Integer)
   then Write(Format(' index %d', [Index]));

  if GetProc <> nil
   then WritePropertyProc('read', GetProc);

  if SetProc <> nil
   then WritePropertyProc('write', SetProc);

  if Default = Low(Integer)
   then Write(' nodefault')
   else Write(Format(' default %d', [Default]));

  if StoredProc = nil then
    Write(' stored False')
  else
    WritePropertyProc('stored', StoredProc);
  Writeln(Format('; / / index %d', [NameIndex]));
 end;
end;

VI-A. Propriété de type méthode▲

   case PropType^.Kind of
    tkInteger : writeln('Pas de données supplémentaires');
    tkLString : writeln('Pas de données supplémentaires');
    tkMethod  : Begin
                  writeln('Type methode');
                  DonneePropriete:= GetTypeData(PTypeInfo(PropType^));
                   // Détermine le type de la méthode
                  Case DonneePropriete.MethodKind of
                   mkProcedure: TypePropriete := 'procedure';
                   mkFunction: TypePropriete := 'function';
                   mkConstructor: TypePropriete := 'constructor';
                   mkDestructor: TypePropriete := 'destructor';
                   mkClassProcedure: TypePropriete := 'class procedure';
                   mkClassFunction: TypePropriete := 'class function';
                  end;

TTypeData = packed record
    case TTypeKind of
       ...
      tkMethod: (
        MethodKind: TMethodKind;
        ParamCount: Byte;
        ParamList: array[0..1023] of Char
       {ParamList: array[1..ParamCount] of
          record
            Flags: TParamFlags;
            ParamName: ShortString;
            TypeName: ShortString;
          end;
        ResultType: ShortString});
      tkInterface: ...

DonneePropriete:= GetTypeData(PTypeInfo(PropType^));

                  Writeln('Nombre de paramètres ',DonneePropriete^.ParamCount);
                  Writeln('Liste des paramètres ',DonneePropriete^.ParamList);

  PShortString=^ShortString;

  PParametre= ^Parametre;
  Parametre=Record
    Flags: TParamFlags;
    ParamName: ShortString;
    TypeName: ShortString;
   end;

   ParametresDeMethode=Record
     // 20 pour le test, on peut utiliser un tableau dynamique
    Tableau : Array[1..20] of Parametre;
     // Pour une fonction
    ResultType: ShortString;
   end;

  TParamFlag = (pfVar, pfConst, pfArray, pfAddress, pfReference, pfOut);

Writeln(TypePropriete+' '+BuildMethodDefinition(ListeParametres,DonneePropriete^.ParamCount));

procedure (var S:String) of Object;

   //Exécute le code associé à la propriété
  Method := GetMethodProp(UnObjet, Informations.Name);
  if Method.Code <> NIL then //UnObjet.OnTraitement:=Nil
   begin
    Resultat:='';
    TTraitement(Method)(Resultat);
    Writeln(Resultat);
   end;

UnObjet.OnTraitement:=UnObjet.Traite1;

La lecture de la valeur d'une propriété via RTTI se fait via les méthodes GetXXXProp, où XXX représente le type de donnée de la propriété.
Nous venons de voir, au travers de la méthode GetMethodProp comment lire la valeur d'une propriété.

function GetMethodProp(Instance: TObject; const PropName: string): TMethod; overload;
function GetMethodProp(Instance: TObject; PropInfo: PPropInfo): TMethod; overload;

La première permet la lecture d'une propriété en indiquant son nom et appelle en interne la seconde procédure surchargée en lui passant un pointeur sur un enregistrement de type TpropInfo :

  Result := GetMethodProp(Instance, FindPropInfo(Instance, PropName));

L'assignation d'une valeur à une propriété via RTTI se fait via les méthodes SetXXXProp.

Certaines de ces méthodes regroupent la manipulation de plusieurs types, par exemple SetOrdProp autorise la manipulation des types ordinaux suivants : tkInteger, tkChar, tkEnumeration et tkSet. Elle renvoie la valeur de la propriété dans un LongInt.

À noter que dans le code source de l'unité Typinfo.pas, Borland a couplé les déclarations Getxxx et Setxxx.

...
function GetDynArrayProp(Instance: TObject; PropInfo: PPropInfo): Pointer; overload;
procedure SetDynArrayProp(Instance: TObject; PropInfo: PPropInfo;
  const Value: Pointer); overload;
...

D'autres informations sur ces méthodes (issues de la documentation du compilateur FreePascal).

VII-A. Propriété de type objet▲

var Fonte: TFont;
begin
 ...
 Fonte := TFont(GetObjectProp(MonControl, 'font', TFont));
 Fonte.Name := 'Symbol';
 ...
end;

VII-B. Accéder aux méthodes des Getter et Setter▲

  TMonObjet=Class(TObject)
   private
    FChampUn : Integer;
    FChampDeux : String;
    FChampTrois : String;
    FChampQuatre: String;
    FOnTraite :TTraitement;
    Procedure Traite1(Var S:String);
    function GetChampTrois: String;
    procedure SetChampTrois(const Value: String);
    function GetChampQuatre: String;Virtual;
    procedure SetChampQuatre(const Value: String);Virtual;
   public
    Function SiExiste:Boolean;
    Property Champ1:Integer read FChampUn Write FChampUn;
   published
     //Accés directe au champ
    Property Champ2:String read FChampDeux Write FChampDeux;
      //Accés directe via une méthode statique
    Property Champ3:String read GetChampTrois Write SetChampTrois;
     //Accés directe via une méthode virtuelle
    Property Champ4:String read GetChampQuatre Write SetChampQuatre;
      //Accés directe via un gestionnaire d'événement
    Property OnTraitement:TTraitement read FOnTraite Write FOnTraite;
  end;

type 
  TTypeMethode = (tmStaticMethod, tmVirtualMethod, tmField, tmConstant);
   //Type de la méthode liée à un getter ou setter
  TTypeMethodeDePropriete = tmStaticMethod..tmField;

...
function GetMethodeType(Value: Pointer): TTypeMethode;
//Renvoie le type d'accès de l'accesseur d'une propriété
begin
  if (Integer(Value) and $FFFFFF00) = 0 then
    Result := tmConstant
  else if (Integer(Value) and $FF000000) = $FE000000 then
    Result := tmVirtualMethod
  else if (Integer(Value) and $FF000000) = $FF000000 then
    Result := tmField
  else
    Result := tmStaticMethod
end;

TTypeAccesseur=(taGetter,taSetter);

   //Informations liées à une méthode getter ou setter
  PTMethodeDePropriete=^TMethodeDePropriete;
  TMethodeDePropriete =Record
   Methode : TMethod; // L'adresse réelle du getter ou setter
   TypeDePropriete : TTypeKind; // type de la propriété : string, tableau, méthode...
   TypeDeMethod : TTypeMethodeDePropriete;//Détermine le mode d'appel de la méthode
   AccesseurRTTI : Pointer;  // Adresse RTTI du getter
   TypeAccesseur : TTypeAccesseur; //taGetter(Read) ou taSetter(Write)
  end;

  TAccesseurs=Record
   Getter : TMethodeDePropriete;
   Setter : TMethodeDePropriete;
  end;

Procedure ConstruitLaMethodeDuGettterSetter(Instance: TObject; Var AAccesseur : TMethodeDePropriete);
begin
 With AAccesseur do
 begin
  Methode.Data := Instance; //Pointe sur l'objet concerné
  case TypeDeMethod of
   tmField         : begin
                       Writeln('Appel sur un champ');
                        //La méthode est déjà renseignée
                       if TypeDePropriete<>tkMethod then
                        //Le getter est un offset dans les champs de l'instance
                        //Result.Code est un pointeur sur le champ de l'instance
                        Methode.Code := Pointer(Integer(Instance) + (Longint(AccesseurRTTI) and $00FFFFFF));
                    end;
   tmVirtualMethod : begin
                      Writeln('Appel sur une méthode virtuelle');
                       // Le getter est un offset, 2 octets signés, dans la VMT de l'instance
                       // Il s'agit bien d'une méthode d'objet
                      Methode.Code := Pointer(PInteger(PInteger(Instance)^ + SmallInt(AccesseurRTTI))^)
                     end;
   tmStaticMethod  : begin
                      Writeln('Appel sur une méthode statique');
                       // Le getter est une adresse de procédure ou fonction de l'instance
                       //Il s'agit bien d'une méthode d'objet
                      Methode.Code := Pointer(AccesseurRTTI);
                     end;
  end; //Case
 end; //With
end;

type
   //Prototype du gestionnaire d'événement  OnTraitement
  TTraitement = Procedure (Var S:String) of Object;

   //Prototype des méthodes utilisées pour les
   //propriétés Champ3 et Champ4 de la classe TMonObjet
  TGetter=Function:String of Object;
  TSetter=Procedure (Var S:String) of Object;

   //La propriété Champ2 est un accès direct au champ
  PStr=^String;
...
Procedure CallGettter(AAccesseur : TMethodeDePropriete);
Const S='Valeur renvoyée par l''accesseur : ';
var Resultat:String;
begin
 Write('Resultat renvoye par l''accesseur=');
 With AAccesseur do
 begin
  case TypeDeMethod of
   tmField         : begin
                       if TypeDePropriete=tkMethod then
                        if Methode.Code <> NIL then //UnObjet.OnTraitement:=Nil
                         begin
                          Resultat:='';
                          TTraitement(Methode)(Resultat);
                          Writeln(Resultat);
                         end
                        else
                         // C'est un pointeur de string pas de méthode
                       else Writeln(Pstr(Methode.Code)^);
                     end;
   tmVirtualMethod : Writeln(S,TGetter(Methode)());
   tmStaticMethod  : Writeln(S,TGetter(Methode)());
  end;
 end;
end;
...

{ The following hack assumes that TJvListBox.Items reads directly from the private FItems field
    of TCustomListBox and that TJvListBox.Items is actually published.

    What we do here is remove the original string list used and place our own version in it's place.
    This would give us the benefit of keeping the list of strings (and objects) even if a provider
    is active and the list box windows has no strings at all. }
  PI := GetPropInfo(TJvListBox, 'Items');
  PStringsAddr := Pointer(Integer(PI.GetProc) and $00FFFFFF + Integer(Self));
  Items.Free;                                 // remove original item list (TListBoxStrings instance)
  PStringsAddr^ := GetItemsClass.Create;      // create our own implementation and put it in place.

Comment modifier une propriété par son nom ?

VIII-A. Modifier une propriété commune à des contrôles▲

procedure DisableThem(Comps: array of TControl);
var Loop: Integer;
begin
 for Loop := Low(Comps) to High(Comps) do
   Comps[Loop].Enabled := False;
end;
 ...
 DisableThem([Button1, Edit1, Checkbox1]);

DisableThem([Button1, Edit1, Checkbox1, Menu1]);

procedure DisableThem(Comps: array of TComponent);
var Loop: Integer;
begin
 for Loop := Low(Comps) to High(Comps) do
  if Comps[Loop] is TMenuItem 
   then TMenuItem(Comps[Loop]).Enabled := False
   else TControl(Comps[Loop]).Enabled := False;
End;
...
DisableThem([Button1, Edit1, Checkbox1, Menu1]);
End;

procedure DisableThem(Comps: array of TComponent);
var Loop: Integer;
    PropInfo: PPropInfo;
begin
 for Loop := Low(Comps) to High(Comps) do 
  begin
    //Récupére si elle existe la propriété nommé Enabled
   PropInfo := GetPropInfo(Comps[Loop].ClassInfo, 'Enabled');
   if Assigned(PropInfo) 
     //La propriété existe, on lui affecte la valeur souhaitée
    then SetOrdProp(Comps[Loop], PropInfo, Longint(False));
end;

// Issue du site www.Delphi.about.com
procedure ApplyDataSource(dbCtrls: array of TControl; DS: TDataSource) ;
var
   cnt: Integer;
   PropInfo: PPropInfo;
begin
   for cnt := Low(dbCtrls) to High(dbCtrls) do
   begin
     PropInfo := GetPropInfo(dbCtrls[cnt].ClassInfo, 'DataSource') ;
     if Assigned(PropInfo) then
       SetOrdProp(dbCtrls[cnt], PropInfo, LongInt(DS)) ;
   end;
end;
...

ApplyDataSource([DBNavigator1, DBText1, DBButton1], DataSource1) ;

VIII-B. Supprimer un objet et ses propriétés de type objet▲

VIII-C. Cloner les propriétés d'objet de même classe▲

// Exemple issu de Torry's Delphi Pages
uses
  TypInfo;

function CloneProperty(SourceComp, TargetComp: TObject;
  Properties: array of string): Boolean;
var
  i: Integer;
begin
  Result := True;
  try
    for i := Low(Properties) to High(Properties) do
    begin
      if not IsPublishedProp(SourceComp, Properties[I]) then Continue;
      if not IsPublishedProp(TargetComp, Properties[I]) then Continue;
      if PropType(SourceComp, Properties[I]) <> PropType(TargetComp, Properties[I]) then
        Continue;
      case PropType(SourceComp, Properties[i]) of
        tkClass:
          SetObjectProp(TargetComp, Properties[i],
            GetObjectProp(SourceComp, Properties[i]));
        tkMethod:
          SetMethodProp(TargetComp, Properties[I], GetMethodProp(SourceComp,
            Properties[I]));
        else
          SetPropValue(TargetComp, Properties[i], GetPropValue(SourceComp, Properties[i]));
      end;
    end;
  except
    Result := False;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  if CloneProperty(Button1, Button2, ['Left', 'Font', 'PopupMenu', 'OnClick']) then
    ShowMessage('OK');
end;

VIII-D. Dupliquer un objet▲

VIII-E. Opérations sur le type ensemble et énumération▲

program Enum_Ensemble;
{$APPTYPE CONSOLE}

uses
  SysUtils,TypInfo;

type
  Valeurs=(un,deux,trois,quatre,cinq);
  EnsembleDeValeurs=set of Valeurs;


Const
 cstNombreDeValeurs=5-1;

var
  MonEnsemble : EnsembleDeValeurs;
  InformationDeType : PTypeInfo;
  UneValeur : Valeurs;

  Nom :String;
  Contenu : Integer;

procedure TestValeurEnsemble;
Var J : Integer;
begin
 Writeln('Affiche les noms des elements de l''ensemble MonEnsemble');
 Writeln;
 For J:=0 to cstNombreDeValeurs do
 begin
  if Valeurs(J) in MonEnsemble
   then Writeln('La valeur [',GetSetElementName(InformationDeType, J),'] est dans la variable MonEnsemble.');
 end;
 readln;
end;

begin
 MonEnsemble:=[Un,trois,cinq];
 InformationDeType:=TypeInfo(Valeurs);

 TestValeurEnsemble;

 Writeln('Affiche le nom et les valeurs de l''enumeration Valeurs');
 Writeln;
 For UneValeur:=Low(Valeurs) to High(Valeurs) do
 begin
  Nom:=GetSetElementName(InformationDeType, Ord(UneValeur));
  Contenu:=GetSetElementValue(InformationDeType, Nom);
  Writeln('La valeur enumere nommee ''',Nom,''' =  ',Contenu);
 end;
 readln;

 Writeln('Modifie les valeurs de l''enumeration Valeurs en manipulant des chaines de caracteres');
 Writeln;

Writeln('Retire l''élément cinq');
 Exclude (MonEnsemble, Valeurs(GetEnumValue(InformationDeType,'CINQ')));
 Writeln('Ajoute l''élément deux');
  //N'est pas sensible à la casse
 Include(MonEnsemble, Valeurs(GetEnumValue(InformationDeType,'deux')));

 TestValeurEnsemble;
 readln;
end.

VIII-F. Interfaces invocables▲

La JCL propose de nombreuses routines d'accès aux RTTI, voir l'exemple : …\jcl\examples\vcl\rtti\RTTIExample.bdsproj
Ou encore l'unité JclSysUtils qui contient de nombreuses méthodes d'accès à la VMT :

//--------------------------------------------------------------------------------------------------
// Virtual Methods
//--------------------------------------------------------------------------------------------------
function GetVirtualMethodCount(AClass: TClass): Integer;
function GetVirtualMethod(AClass: TClass; const Index: Integer): Pointer;
procedure SetVirtualMethod(AClass: TClass; const Index: Integer; const Method: Pointer);

//--------------------------------------------------------------------------------------------------
// Dynamic Methods
//--------------------------------------------------------------------------------------------------

function GetDynamicMethodCount(AClass: TClass): Integer;
function GetDynamicIndexList(AClass: TClass): PDynamicIndexList;
function GetDynamicAddressList(AClass: TClass): PDynamicAddressList;
function HasDynamicMethod(AClass: TClass; Index: Integer): Boolean;
function GetDynamicMethod(AClass: TClass; Index: Integer): Pointer;
...

Reflection in Delphi for the Microsoft .NET Framework. Sachez que le code Win32 utilisant RTTI est portable sous Delphi .NET.

QuickRTTI est un projet facilitant l'accès aux données RTTI sous XML.

Réflexion : information de classe dynamique. Quelques remarques sur RTTI (java).