Mapping automatique d’objet vers une source de donnée

Cette technique s’adapte bien à des données de type code/libellé. L’objectif est d’écrire ce genre de chose :

Var

ObjetSource :TobjectSource ;
….
Showmessage(ObjetSource.T253) ; // affiche la valeur associé à T253
….
Showmessage(ObjetSource.T255) ; // affiche la valeur associé à T255

Bien sûr, si j’ajoute une valeur T569 à ma source, je veux avoir automatiquement la propriété T569 sur mon objet, sans changer son source.

Cela veut dire que l'on a plus besoin de modifier l'objet de type TobjectSource . Cela veut dire aussi qu'une instance de cette classe n'a pas de propriété est qu'elle est capable de les créer à la volée au moment de l'exécution. Si cette classe n'a pas de propriété, on a donc pas besoin de les déclarer. (Monsieur de Lapalisse, 1/4 avant sa mort était encore en vie.)

Je m'explique : Sur un objet classique Delphi lorsque l'on souhaite rajouter une propriété on déclare dans le source de la classe un champ de type property : read...write...; et ensuite on compile. Le compilateur de delphi écrit en dur dans la structure du programme les listes des propriétés des classes (voir TypInfo.pas). On pourrait, à l'exécution, rajouter une propriété toto sur une classe quelconque (en tout cas celles qui ont été compilées grace aux directives $M+, $M-) en bidouillant (copie + ajout d'un enregistrement dans le RTTI) en assembleur la zone des données qui définissent une classe...(une aspirine??).

Ici le but du jeux est de faire ceci facilement (sans assembleur). Ceci est possible à l'aide de l'interface IDispatch.

Cela revient à écrire ce genre de chose:

 z:= ObjetSource.T253;

au moment ou l'on cherche à évaluer ObjetSource.T253, il y a un bout de code de l'objet qui récupère la chaine 'T253’ et qui cherche la valeur correspondante dans la base et ensuite au moment de l'affectation renvoie la valeur qu'il a trouvé. Il va de soi que la propriété T253 n'a jamais été déclaré dans le source.( je radote, je sais)

Je vous laisse découvrir le code pour voir comment tout cela fonctionne. Il s'agit juste d'une ébauche pour valider le principe. La partie accès base de donnée n'est pas implémentée.

unit Unit3;

interface

uses ComObj, sysutils, classes;

type

 TobjectSource  = class(TInterfacedPersistent, IDispatch)

 private

   FValueName: string;

 protected

   function GetTypeInfoCount(out Count: Integer): HResult; stdcall;

   function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult; stdcall;

   function GetIDsOfNames(const IID: TGUID; Names: Pointer; NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall;

   function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall;

   function GetValueString(ValueName: string): string;

   procedure SetValueString(ValueName, Value: string);

 end;

  implementation uses dialogs, ActiveX, variants;

   function TobjectSource .GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult;
  begin 
   Result := 0;
  end; 

  function TobjectSource .GetTypeInfoCount(out Count: Integer): HResult; begin 
 Result := 0;
   end; 

  function TobjectSource .Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult;
 var 

 zPutValue: OleVariant;

 zResult: OleVariant;
   begin 

 // on veut lire le paramètre

 if (Flags and DISPATCH_PROPERTYGET) = DISPATCH_PROPERTYGET then

 begin

   zResult := POleVariant(VarResult)^;

   // on peut faire un varType pour savoir si on a un string ou un integer à récupéré (ou autre chose)

   POleVariant(VarResult)^ := GetValueString(FValueName);

 end;

 // on veut écrire le paramètre

 if (Flags and DISPATCH_PROPERTYPUT) = DISPATCH_PROPERTYPUT then

 begin

   zPutValue := POleVariant(Params)^;

   // on peut faire un varType pour savoir si on a un string ou un integer à écrire (ou autre chose)

   SetValueString(FValueName, zPutValue);

 end;

 result := S_OK;

end; 

function TobjectSource .GetIDsOfNames(const IID: TGUID; Names: Pointer; NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; var 

 P: POleStrList;

begin 

 P := POleStrList(Names);

 FValueName := P^[0];

 result := S_OK;

end; 

function TobjectSource .GetValueString(ValueName: string): string; begin 

 // retourne la valeur correspondant au nom passé en paramètre

 Result:='On va dire que ceci est la chaine que lon a récupéré en base';

end; 

procedure TobjectSource .SetValueString(ValueName, Value: string);
begin 

 // affecte la valeur....

 showmessage('On va écrire en base:'+ValueName + '=' + Value);

end;