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 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135
|
//------------------------------------------------------------------------------
(* SoLuTions is an Versatile Library for Delphi -
* -
* Copyright ou © ou Copr. "SLT Solutions", (2006) -
* contributeur : ShaiLeTroll (2009) - Refonte architecturale (Séparation de l'ORM : l'EPC "Engine of Persistence Component" gère uniquement une ORM très rigide, la nouvelle persistance sépare la partie RTTI de la gestion DB)
* contributeur : ShaiLeTroll (2012) - Renommage Fichier et Correction XE2 -
* contributeur : ShaiLeTroll (2012) - Documentation Insight -
* contributeur : ShaiLeTroll (2013) - Fusion de la SLT<2006> sous Delphi 7, SLT<2009> sous C++Builder 2007, SLT<2012> sous C++Builder XE2/XE3 vers la SLT<2013> sous Delphi XE2
* -
* -
* Ce logiciel est un programme informatique servant à aider les développeurs -
* Delphi avec une bibliothèque polyvalente, adaptable et fragmentable. -
* -
* Ce logiciel est régi par la licence CeCILL-C soumise au droit français et -
* respectant les principes de diffusion des logiciels libres. Vous pouvez -
* utiliser, modifier et/ou redistribuer ce programme sous les conditions -
* de la licence CeCILL-C telle que diffusée par le CEA, le CNRS et l'INRIA -
* sur le site "http://www.cecill.info". -
* -
* En contrepartie de l'accessibilité au code source et des droits de copie, -
* de modification et de redistribution accordés par cette licence, il n'est -
* offert aux utilisateurs qu'une garantie limitée. Pour les mêmes raisons, -
* seule une responsabilité restreinte pèse sur l'auteur du programme, le -
* titulaire des droits patrimoniaux et les concédants successifs. -
* -
* A cet égard l'attention de l'utilisateur est attirée sur les risques -
* associés au chargement, à l'utilisation, à la modification et/ou au -
* développement et à la reproduction du logiciel par l'utilisateur étant -
* donné sa spécificité de logiciel libre, qui peut le rendre complexe à -
* manipuler et qui le réserve donc à des développeurs et des professionnels -
* avertis possédant des connaissances informatiques approfondies. Les -
* utilisateurs sont donc invités à charger et tester l'adéquation du -
* logiciel à leurs besoins dans des conditions permettant d'assurer la -
* sécurité de leurs systèmes et ou de leurs données et, plus généralement, -
* à l'utiliser et l'exploiter dans les mêmes conditions de sécurité. -
* -
* Le fait que vous puissiez accéder à cet en-tête signifie que vous avez -
* pris connaissance de la licence CeCILL-C, et que vous en avez accepté les -
* termes. -
* -
*----------------------------------------------------------------------------*)
unit SLT.Persistence.Impl;
interface
uses System.Classes, System.SysUtils, System.TypInfo,
System.Generics.Collections,
SLT.Common.SystemEx, SLT.Common.ThreadUtils, SLT.Common.RTTI,
SLT.Persistence.Interfaces;
{$SCOPEDENUMS ON}
type
{ Forward class declarations }
TSLTPersistent = class;
TSLTPersistentSet = class;
TSLTPersistentEvent = class;
TSLTPersistentRTTIAccess = class;
TSLTPersistentFactories = class;
TSLTPersistentSetFactories = class;
TSLTPersistentFactoryRegistry = class;
ISLTPersistentFactoriesWithRegistry = interface;
TSLTPersistentPropertyMetaData = class;
TSLTPersistentPropertiesMetaData = class;
TSLTPersistentPropertyData = class;
TSLTPersistentPropertyValue = class;
TSLTPersistentAbstractPropertiesData = class;
TSLTPersistentPropertiesData = class;
TSLTPersistentSetPropertiesData = class;
TSLTPersistentPropertyByIndexAccessors = class;
TSLTPersistentNullablePropertyValue = class;
TSLTPersistentNullableInteger = class;
TSLTPersistentNullableString = class;
TSLTPersistentNullableDouble = class;
TSLTPersistentNullablePropertyKindRegistry = class;
TSLTPersistentSpecialIntegerValue = class;
TSLTPersistentSetActiveNumberValue = class;
TSLTPersistentMarshalling = class;
TSLTPersistentMarshaller = class;
TSLTPersistentSetMarshaller = class;
/// <summary>Erreur de base liée à l'utilisation d'un objet supportant une persistance</summary>
ESLTPersistentError = class(Exception);
/// <summary>Erreur de base liée à l'utilisation des meta-données d'un objet supportant une persistance</summary>
ESLTPersistentMetaDataError = class(Exception);
/// <summary>Erreur liée à la conversion de type variant lors de la modification des données objet supportant une persistance</summary>
ESLTPersistentPropertyValueCastError = class(ESLTPersistentError)
private
FPublishedPropertiesDescriptor: TClass;
FPropertyName: string;
public
/// <summary>Crée l'exception avec un message prédéfini</summary>
constructor Create(const APublishedPropertiesDescriptor: TClass; const APropertyName: string; const ASourceType, ADestType: TVarType; const ADestKind: TTypeKind);
property PublishedPropertiesDescriptor: TClass read FPublishedPropertiesDescriptor;
property PropertyName: string read FPropertyName;
end;
{ Default implementation class declarations }
/// <summary>Objet de base pour les objets supportant une persistance</summary>
/// <remarks>La classe TSLTPersistent doit être utilisée de préférence via l'interface ISLTPersistent.</remarks>
/// <remarks>La classe TSLTPersistent peut-être héritée et ses méthodes d'implémentation redéfinies.</remarks>
/// <remarks>La classe TSLTPersistent peut-être utilisée via une simple composition et dans ce cas : il est nécessaire d'affecter, à la propriété
/// PublishedPropertiesDescriptor, la classe d'objet contenant des propriétés publiées accessibles en RTTI.
/// L'approche par composition avec une encapsulation totale permet un couplage faible entre votre code métier et l'utilisation de cette implémentation de persistance,
/// vous pourrez ainsi par la suite fournir vos implémentations personnalisées ou remplacer totalement cette bibliothèque par une autre bibliothèque répondant au mieux à vos besoins.</remarks>
/// <remarks>En modifiant les accesseurs ou fabriques des classes gérant les Délégation,
/// vous pouvez fournir votre implémentation personnalisée de ISLTPersistentFactories,
/// ainsi que d'autres implémentations personnalisées des interfaces que vous jugerez nécessaire à votre objet.</remarks>
/// <remarks>La classe TSLTPersistent n'est pas obligatoire, vous pouvez créer votre propre ancêtre persistant tant qu'il implémente correctement ISLTPersistentPropertiesMetaData et ISLTPersistentPropertiesData,
/// votre propre ancêtre persistant peut fournir sa propre implémentation de ISLTPersistentFactories vous permettant de substituer l'ensemble des implémentations par défaut par des implémentations personnalisées</remarks>
TSLTPersistent = class(TSLTInterfacedObject, ISLTPersistent, ISLTPersistentRTTIAccess, ISLTPersistentFactories, ISLTPersistentPropertiesMetaData, ISLTPersistentPropertiesData,
ISLTPersistentNullablePropertyKindRegistry, ISLTPersistentPropertyByIndexAccessors, ISLTPersistentNullablePropertyByIndexAccessors, ISLTPersistentVariantPropertyByIndexAccessors, ISLTPersistentSpecialPropertyByIndexAccessors,
ISLTPersistentMarshalling, ISLTPersistentMarshallable, ISLTPersistentSetCountable, ISLTPersistentLoadStateInspector)
strict private
// Membres privés de Classe
class var
FDefaultFactoriesClass: TClass;
public
// Types publiques
type
TDelegate = (dFactories, dPropertiesMetaData, dPropertiesData, dPbIAccess, dNPbIAccess, dVPbIAccess, dSPbIAccess, dNPKindRegistry);
TDelegates = set of TDelegate;
IDelegatedInterface = IInterface;
PDelegatedInterface = ^IDelegatedInterface;
TDelegatedInterfaces = array[TDelegate] of IDelegatedInterface;
PDelegatedInterfaces = ^TDelegatedInterfaces;
TStaticDelegatedInterfaces = class(System.Generics.Collections.TDictionary<TClass, PDelegatedInterfaces>)
private
function GetDelegate(const Key: TClass): PDelegatedInterfaces;
protected |
Partager