Pointeur de Méthode et RTTI

**ShaiLeTroll** · 15/01/2007, 20h50

Voilà, je dois ajouter la Gestion de la Valeur Nulle à la Couche de Persistance V2 (principe qui gère des Objets contenant pour chaque champ d'une table une propriété publiée) que l'on développe dans ma société

La Valeur Nulle, se gère à la lecture , met aussi au Set, car il faut pouvoir faire la différence entre un Zéro d'un Integer issu de l'initialisation du create et un Zéro d'un Integer issu d'une modification par le Client, et pouvoir le sauver en BD, en gros, on a un tableau de boolean, qui dit si c'est nul et si ça été modifié

l'application est développée avec la V1 de la Couche donc il est chiant de devoir tout refaire pour au final comme je l'aurais fait et utiliser des objets métiers bcp plus simple et encapsulant un TDataSet et non pas tout un mécanisme RTTI, donc on ne peut pas dégagé cette couche, quoi que ...

J'ai donc des classes, certaines avec plus de 200 champs publiées (données médicales) ...

plusieurs solutiions ont été entrevues :

- Toutes les propriétés sont en Variant (cela gère nativement la valeur nulle donc pas besoin de tableau) (c'est issu d'un TDataSet donc c'est dans la logique) sauf que le TField et ses descendants gèrent la valeur nulle pour éviter le message "Impossible de Convertir un Variant (Null) en Variant(Integer) ... solution éliminé, trop de code donc à écrire car il faudrait mettre systématiqement if VarIsNull(...) then Get... lourd ... (), et vu que la couche est censé réduire le code ...

- Toutes les propriétés ont des Accesseurs, il faut bcp de code, mais c'est fait qu'une fois, et là pas de soucis ... mais la rigueur de l'équipe pour cela va poser problème ... en gros ça va vite gaver tout le monde, sachant que la couche et l'objet ça gave déjà tout le monde

- Automatiser le mécanisme donc pouvoir détecter la modif d'un champ, on peut biensur comparé la Old et New Value, mais du coup, le Zéro c'est niqué, et la Chaine Vide c'est différent d'un Null ... plein truc à la con comme ça !

j'ai donc pondu un truc pour tester le détournement de procédure (plus exactement la subsitution du Code, je l'ai déjà fait cela fonctionne), mais il y a une violation d'acces :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
{* -----------------------------------------------------------------------------
La Fonction OverloadGetAccessor remplace les Accesseur Get par un autre Accesseur qui se chargera d'appelé le bon accesseur si cela est possible ou renverra une valeur nulle
@param Instance Contient l'Instance héritée de TPersistent à analyser
@param List TStrings instanciée qui contient déjà la liste des propriétés de AClass (la Propriété Objects contient la liste des OverProc et recevra la Liste des GetProc d'origine)
@return Indique si la Fonction a remplacer les Accesseurs
------------------------------------------------------------------------------ }
class function TEpcRTTIWrapper.OverloadGetAccessor(AClass: TClass; List: TStrings): Boolean;
type
  PMethod = ^TMethod;
var
  I: Integer;
  PropInfo: PPropInfo;
  CmpList: TStrings;
  OverProc: Pointer;
begin
  Result := Assigned(List) and AClass.InheritsFrom(TPersistent);
  if Result then
  begin
    // Vérification de la Liste
    CmpList := TStringList.Create();
    try
      GetPersistentProperties(AClass, CmpList);
      Result := CmpList.Count = List.Count;
      if Result then
      begin
        for I := 0 to List.Count - 1 do
        begin
          Result := CmpList.IndexOf(List.Strings[I]) >= 0;
          if not Result then
            Exit;
        end;
      end;
    finally
      CmpList.Free();
    end;
    // Remplacement des Procédures
    for I := 0 to List.Count - 1 do
    begin
      PropInfo := GetPropInfo(AClass, List.Strings[I]);
      if Assigned(PropInfo) then
      begin
        OverProc := List.Objects[I];
        if Assigned(OverProc) then
        begin
          List.Objects[I] := PropInfo^.GetProc;
          if LongWord(PropInfo^.GetProc) >= $FF000000 then
          begin
            PropInfo^.GetProc := OverProc; // Violation d'Accès
          end else
            PMethod(PropInfo^.GetProc)^.Code := PMethod(OverProc)^.Code;
        end;
      end else
        raise EPropertyError.Create('Truc Gravissime');
    end;
  end;
end;

utiliser comme ceci

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
 
procedure TFrmMainPersistanceAppTest.BtnOverloadGetAccessorClick(
  Sender: TObject);
begin
  ProcList := TStringList.Create();
 
  OverProcs := TOverProcObject.Create;
 
  TEpcRTTIWrapper.GetPersistentProperties(TepcObjectMetier, ProcList);
 
  //ShowMessage(IntToStr(Integer(OverProcs.MethodAddress('GetAccessorIntegerProc'))));
  ProcList.Objects[ProcList.IndexOf('DummyInteger')] := OverProcs.MethodAddress('GetAccessorIntegerProc');
  ProcList.Objects[ProcList.IndexOf('DummyString')] := OverProcs.MethodAddress('GetAccessorStringProc');
  ProcList.Objects[ProcList.IndexOf('DummyBoolean')] := OverProcs.MethodAddress('GetAccessorBooleanProc');
  ProcList.Objects[ProcList.IndexOf('DummyFloat')] := OverProcs.MethodAddress('GetAccessorExtendedProc');
  ProcList.Objects[ProcList.IndexOf('DummyDateTime')] := OverProcs.MethodAddress('GetAccessorDateTimeProc');
  ProcList.Objects[ProcList.IndexOf('DummyCurrency')] := OverProcs.MethodAddress('GetAccessorExtendedProc');
 
  TEpcRTTIWrapper.OverloadGetAccessor(TepcObjectMetier, ProcList);
end;

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
 
type
  TOverProcObject = class(TPersistent)
  published
    function GetAccessorStringProc(): string;
    function GetAccessorIntegerProc(): Integer;
    function GetAccessorExtendedProc(): Extended;
    function GetAccessorDateTimeProc(): TDateTime;
    function GetAccessorBooleanProc(): Boolean;
    function GetAccessorCharProc(): Char;
  end;

Bon, j'ai vu qu'il me sera surement impossible de le faire, car vu que le GetProc contient soit en
- si c'est de la plage $FF000000, c'est un offset de pointeur sur la valeur (il n'y a pas de methode mais un read FValue)
- si c'est de la plage $FE000000, c'est une méthode virtuelle
- sinon c'est une méthode static (avec Index voir exemple ci dessous ... ou non)

je sais que cela ne marchera jamais car si pas d'accesseur pas de détournement (je suis preneur à d'autre mécanisme) du Code (sauf si l'on m'indique un moyen de savoir dans quelle propriété ont execute le code en cours ... et donc pour que cela fonctionne faut faire les accesseurs, donc on en revient plus simplement à la solution N°2

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
 
type
 TepcSpecifMetierDataType = (smdtChamp1, smdtChamp2, smdtChamp3);
 TepcSpecifMetierData = record
    case Boolean of
       True: (
          Champ1 : string[255];
          Champ2 : string[255];
          Champ3 : string[255];
       );
       False: (
          Data: array[TepcSpecifMetierDataType] of string[255];
       );
 end;
 
 TepcSpecifMetier = class(TepcObjectMetier)
   private
      FBonjour: string;
      FData: TepcSpecifMetierData;
      FStrings: TStrings;
      FForm: TForm;
   protected
      function GetData(Index : TepcSpecifMetierDataType): string;
      procedure SetData(Index : TepcSpecifMetierDataType; Value: string);
      function GetStrings(): TStrings;
   public
      constructor Create(AOwner: TComponent); override;
      property Data[Index : TepcSpecifMetierDataType]: string read GetData write SetData; // ça n'est pas publiable
      property Strings: TStrings read GetStrings write FStrings;
      property Form: TForm read FForm write FForm;
   published
      property Bonjour: string read FBonjour write FBonjour;
      property Champ1: string index smdtChamp1 read GetData write SetData; // ça c'est avec index ....
      property Champ2: string index smdtChamp2 read GetData write SetData;
      property Champ3: string index smdtChamp3 read GetData write SetData;
   end;

**sjrd** · 15/01/2007, 21h38

Bon c'est très bien tout ça mais... Elle est où la question ?

**ShaiLeTroll** · 16/01/2007, 10h27

Il n'y a pas une Question sjrd en particulier, mais je vais en extirper une pour le moment

- "PropInfo^.GetProc := OverProc" provoque une exception (Violation d'Accès), comment "ouvrir" la mémoire en écriture

juste pour info, j'ai ajouté cela avant, et j'ai pas le droit de lire ...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

if not IsBadReadPtr(PropInfo^.GetProc, 8) and not IsBadWritePtr(PropInfo^.GetProc, 8) then

**LadyWasky** · 16/01/2007, 12h53

si je puis me permettre...

GetProc ne serait-il pas un pointeur sur une procedure et OverProc un pointeur sur un pointeur de procedure ?

Essaies comme ceci dans ce cas là (avec le p'tit chapeau tout à la fin) :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

PropInfo^.GetProc := OverProc^;

Je ne suis pas sur de ce que j'avance, mais bon...

**ShaiLeTroll** · 16/01/2007, 14h03

GetProc est un pointer, et OverProc est aussi un pointer, ils sont compatibles en terme de type ... il n'y a pas de notion de pointeur de pointeur, puisqu'OverProc est récupéré via MethodAdress.

Merci de ta proposition waskol, mais cela ne compile pas, ... et le problème est vraiement, que je n'ai pas le droit d'écrire à cet endroit, pourtant Delphi le fait bien lui puisqu'il remplit ces données ... où alors c'est des informations générés par le compilateur, et ce n'est en fait qu'une grosse constante compilée ... ça expliquerai que IsBadWritePtr renvoie true ...

**sjrd** · 16/01/2007, 14h29

Envoyé par ShaiLeTroll

où alors c'est des informations générés par le compilateur, et ce n'est en fait qu'une grosse constante compilée ... ça expliquerai que IsBadWritePtr renvoie true ...

Oui c'est exactement ça. Les RTTI sont des blocs générés à la compilation comme constantes, pour tous les types qui sont à un endroit ou à une autre passés en paramètre de TypeInfo.

C'est comme les VMT. J'ai essayé une fois aussi d'en modifier une en assembleur en ligne... C'était pour simuler une variable de classe (avec une valeur différente pour chaque classe). J'avais le même genre de violations

Je crains donc que ton problème soit insoluble

**ShaiLeTroll** · 16/01/2007, 16h04

Merci sjrd, de la confirmation des constantes RTTI, c'est en lisant l'aide que cela mis la puce à l'oreille, euh à l'oeil

...

J'ai déjà mis en place une nouvelle méthode pour répondre à mon besoin, je suis en train de la coder, je passe par une seule paire d'Accesseur Get/Set Variant pour toutes les propriétés publiées de l'Objets, et ces dernières sont indicés, donc je peux récupérer les infos RTTI, ainsi que des Infos issus du XML de structure de la Couche ... et je résoud mon problème, de plus, je laisse la possibilité de faire d'autres accesseurs, puisque les données sont acessibles via une propriété Data (tableau de pointeur de structure de pointer ^_^) et gère le null comme une valeur par défaut, mais ne l'enregistre pas ... bon j'ai du code en vue ... et je ne crois pas que mon discours soit suffisament clair pour intéresser tout le mondre ...

Pointeur de Méthode et RTTI

Delphi

Discussions similaires

Partager

Partager