Commits

Anonymous committed dcf2963

Added ASCollectionProvider + updated tests and other improvements.

  • Participants
  • Parent commits 67caaf4

Comments (0)

Files changed (4)

File Demo/TestMain.dfm

   Left = 0
   Top = 0
   Caption = 'AS Provider Demo App'
-  ClientHeight = 337
-  ClientWidth = 635
+  ClientHeight = 511
+  ClientWidth = 698
   Color = clBtnFace
   Font.Charset = DEFAULT_CHARSET
   Font.Color = clWindowText
   OldCreateOrder = False
   OnCreate = FormCreate
   OnDestroy = FormDestroy
+  DesignSize = (
+    698
+    511)
   PixelsPerInch = 96
   TextHeight = 13
+  object DBText1: TDBText
+    Left = 417
+    Top = 211
+    Width = 65
+    Height = 17
+    DataField = 'Name'
+    DataSource = DataSource1
+  end
   object Button1: TButton
-    Left = 535
-    Top = 41
+    Left = 254
+    Top = 174
     Width = 75
     Height = 25
-    Caption = 'Open'
+    Action = Action2
     TabOrder = 0
-    OnClick = Button1Click
   end
   object DBGrid1: TDBGrid
-    Left = 40
-    Top = 32
-    Width = 489
-    Height = 120
+    Left = 0
+    Top = 0
+    Width = 698
+    Height = 137
+    Align = alTop
     DataSource = DataSource1
     TabOrder = 1
     TitleFont.Charset = DEFAULT_CHARSET
     TitleFont.Name = 'Tahoma'
     TitleFont.Style = []
   end
-  object cxDBNavigator1: TcxDBNavigator
-    Left = 40
-    Top = 168
-    Width = 255
+  object Button2: TButton
+    Left = 335
+    Top = 143
+    Width = 75
+    Height = 25
+    Action = Action3
+    TabOrder = 2
+  end
+  object DBNavigator1: TDBNavigator
+    Left = 8
+    Top = 143
+    Width = 240
     Height = 25
     DataSource = DataSource1
-    TabOrder = 2
+    TabOrder = 3
   end
-  object Button2: TButton
-    Left = 535
-    Top = 72
+  object DBGrid2: TDBGrid
+    Left = 0
+    Top = 421
+    Width = 698
+    Height = 90
+    Align = alBottom
+    DataSource = DataSource2
+    TabOrder = 4
+    TitleFont.Charset = DEFAULT_CHARSET
+    TitleFont.Color = clWindowText
+    TitleFont.Height = -11
+    TitleFont.Name = 'Tahoma'
+    TitleFont.Style = []
+  end
+  object DBNavigator2: TDBNavigator
+    Left = 8
+    Top = 390
+    Width = 240
+    Height = 25
+    DataSource = DataSource2
+    Anchors = [akLeft, akBottom]
+    TabOrder = 5
+  end
+  object DBEdit1: TDBEdit
+    Left = 488
+    Top = 208
+    Width = 121
+    Height = 21
+    DataField = 'Caption'
+    DataSource = DataSource1
+    TabOrder = 6
+    OnChange = DBEdit1Change
+  end
+  object Button3: TButton
+    Left = 335
+    Top = 174
     Width = 75
     Height = 25
-    Caption = 'Apply'
-    TabOrder = 3
-    OnClick = Button2Click
+    Action = Action4
+    TabOrder = 7
   end
-  object ClientDataSet1: TClientDataSet
-    Aggregates = <>
-    Params = <>
-    ProviderName = 'ASComponentProvider1'
-    Left = 480
-    Top = 168
-  end
-  object DataSource1: TDataSource
-    DataSet = ClientDataSet1
-    Left = 408
-    Top = 168
-  end
-  object ASProvider1: TASProvider
-    Left = 560
-    Top = 168
+  object Button4: TButton
+    Left = 254
+    Top = 143
+    Width = 75
+    Height = 25
+    Action = Action1
+    TabOrder = 8
   end
   object ASComponentProvider1: TASComponentProvider
-    Active = False
-    ProvidedComponent = ASProvider1
+    Active = True
     FieldDefs = <
       item
-        Name = 'Data'
-        Attributes = [faReadonly]
-        DataType = ftVariant
-      end
-      item
-        Name = 'ComponentCount'
-        Attributes = [faReadonly]
-        DataType = ftInteger
-      end
-      item
-        Name = 'ComponentIndex'
-        DataType = ftInteger
-      end
-      item
-        Name = 'DesignInfo'
-        DataType = ftInteger
-      end
-      item
         Name = 'Name'
         DataType = ftWideString
         Size = 20
       end
       item
-        Name = 'Tag'
+        Name = 'Caption'
+        DataType = ftWideString
+        Size = 20
+      end
+      item
+        Name = 'Left'
+        DataType = ftInteger
+      end
+      item
+        Name = 'Top'
+        DataType = ftInteger
+      end
+      item
+        Name = 'Width'
+        DataType = ftInteger
+      end
+      item
+        Name = 'Height'
         DataType = ftInteger
       end>
-    Left = 488
-    Top = 248
+    ProvidedComponent = Button1
+    Left = 56
+    Top = 176
+  end
+  object ClientDataSet1: TClientDataSet
+    Active = True
+    Aggregates = <>
+    Params = <>
+    ProviderName = 'ASComponentProvider1'
+    Left = 56
+    Top = 224
+    object ClientDataSet1Name: TWideStringField
+      FieldName = 'Name'
+    end
+    object ClientDataSet1Caption: TWideStringField
+      FieldName = 'Caption'
+    end
+    object ClientDataSet1Left: TIntegerField
+      FieldName = 'Left'
+    end
+    object ClientDataSet1Top: TIntegerField
+      FieldName = 'Top'
+    end
+  end
+  object DataSource1: TDataSource
+    DataSet = ClientDataSet1
+    Left = 160
+    Top = 176
+  end
+  object DataSource2: TDataSource
+    DataSet = ClientDataSet1
+    OnDataChange = DataSource2DataChange
+    OnUpdateData = DataSource2UpdateData
+    Left = 160
+    Top = 224
+  end
+  object ActionList1: TActionList
+    Left = 56
+    Top = 280
+    object Action1: TAction
+      Caption = 'Open'
+      OnExecute = Action1Execute
+      OnUpdate = Action1Update
+    end
+    object Action2: TAction
+      Caption = 'Close'
+      OnExecute = Action2Execute
+      OnUpdate = Action2Update
+    end
+    object Action3: TAction
+      Caption = 'Apply'
+      OnExecute = Action3Execute
+      OnUpdate = Action3Update
+    end
+    object Action4: TAction
+      Caption = 'Cancel'
+      OnExecute = Action4Execute
+      OnUpdate = Action4Update
+    end
   end
 end

File Demo/TestMain.pas

 
 uses
   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
-  Dialogs, DB, DBClient, ASObjectProvider, StdCtrls, Provider, Grids, DBGrids, xmldom, Xmlxform, ASProvider,
-  cxGraphics, cxControls, cxLookAndFeels, cxLookAndFeelPainters, cxNavigator, cxDBNavigator;
+  Dialogs, DB, DBClient, StdCtrls, Provider, Grids, DBGrids, xmldom, Xmlxform,
+  ExtCtrls, DBCtrls, ASProvider, Mask, ActnList;
 
 type
   TMainForm = class(TForm)
-    ClientDataSet1: TClientDataSet;
     Button1: TButton;
     DBGrid1: TDBGrid;
+    Button2: TButton;
+    DBNavigator1: TDBNavigator;
+    ASComponentProvider1: TASComponentProvider;
+    ClientDataSet1: TClientDataSet;
     DataSource1: TDataSource;
-    ASProvider1: TASProvider;
-    cxDBNavigator1: TcxDBNavigator;
-    Button2: TButton;
-    ASComponentProvider1: TASComponentProvider;
+    ClientDataSet1Name: TWideStringField;
+    ClientDataSet1Caption: TWideStringField;
+    ClientDataSet1Left: TIntegerField;
+    ClientDataSet1Top: TIntegerField;
+    DataSource2: TDataSource;
+    DBGrid2: TDBGrid;
+    DBNavigator2: TDBNavigator;
+    DBText1: TDBText;
+    DBEdit1: TDBEdit;
+    Button3: TButton;
+    ActionList1: TActionList;
+    Action1: TAction;
+    Action2: TAction;
+    Button4: TButton;
+    Action3: TAction;
+    Action4: TAction;
     procedure Button1Click(Sender: TObject);
     procedure FormCreate(Sender: TObject);
     procedure FormDestroy(Sender: TObject);
     procedure Button2Click(Sender: TObject);
+    procedure DataSource2DataChange(Sender: TObject; Field: TField);
+    procedure DataSource2UpdateData(Sender: TObject);
+    procedure DBEdit1Change(Sender: TObject);
+    procedure Button3Click(Sender: TObject);
+    procedure Action1Update(Sender: TObject);
+    procedure Action1Execute(Sender: TObject);
+    procedure Action2Update(Sender: TObject);
+    procedure Action2Execute(Sender: TObject);
+    procedure Action3Update(Sender: TObject);
+    procedure Action3Execute(Sender: TObject);
+    procedure Action4Update(Sender: TObject);
+    procedure Action4Execute(Sender: TObject);
   private
     { Private declarations }
   public
 
 implementation
 
-uses
-  CodeSiteLogging;
+{$R *.dfm}
 
-{$R *.dfm}
+procedure TMainForm.Action1Execute(Sender: TObject);
+begin
+  ClientDataSet1.Open;
+end;
+
+procedure TMainForm.Action1Update(Sender: TObject);
+begin
+  (Sender as TAction).Enabled := ClientDataSet1.Active = False;
+end;
+
+procedure TMainForm.Action2Execute(Sender: TObject);
+begin
+  ClientDataSet1.Close;
+end;
+
+procedure TMainForm.Action2Update(Sender: TObject);
+begin
+  (Sender as TAction).Enabled := ClientDataSet1.Active = True;
+end;
+
+procedure TMainForm.Action3Execute(Sender: TObject);
+begin
+  ClientDataSet1.ApplyUpdates(0);
+end;
+
+procedure TMainForm.Action3Update(Sender: TObject);
+begin
+  (Sender as TAction).Enabled := ClientDataSet1.ChangeCount > 0;
+end;
+
+procedure TMainForm.Action4Execute(Sender: TObject);
+begin
+  ClientDataSet1.CancelUpdates;
+end;
+
+procedure TMainForm.Action4Update(Sender: TObject);
+begin
+  (Sender as TAction).Enabled := ClientDataSet1.ChangeCount > 0;
+end;
 
 procedure TMainForm.Button1Click(Sender: TObject);
 begin
-  ASComponentProvider1.Open;
   ClientDataSet1.Open;
 end;
 
   ClientDataSet1.ApplyUpdates(0);
 end;
 
+procedure TMainForm.Button3Click(Sender: TObject);
+begin
+  ClientDataSet1.CancelUpdates;
+end;
+
+procedure TMainForm.DataSource2DataChange(Sender: TObject; Field: TField);
+begin
+  OutputDebugString('## DATA CHANGE');
+end;
+
+procedure TMainForm.DataSource2UpdateData(Sender: TObject);
+begin
+  OutputDebugString('## UPDATE DATA');
+end;
+
+procedure TMainForm.DBEdit1Change(Sender: TObject);
+begin
+  with (Sender as TDBEdit) do
+    if Text = 'foo' then begin
+      EditText := 'foo bar';
+    end;
+end;
+
 procedure TMainForm.FormCreate(Sender: TObject);
 begin
 end;

File Src/ASProvider.pas

   private
     FActive: Boolean;
     FStreamedActive: Boolean;
-    FClass: TClass;
-    FObject: TObject;
-    FDataSet: TCustomClientDataSet;
+    FDataSet: TPacketDataSet;
     FDSWriter: TDataPacketWriter;
     FFieldDefs: TFieldDefs;
 
   private
-    function GetDataSet: TCustomClientDataSet;
+    function GetDataSet: TPacketDataSet;
     function GetDSWriter: TDataPacketWriter;
     function GetFieldDefs: TFieldDefs;
     procedure SetFieldDefs(const Value: TFieldDefs);
     procedure SetActive(const Value: Boolean);
 
   protected
-    procedure SetProvidedClass(const Value: TClass); virtual;
-    function GetProvidedClass: TClass; virtual;
-    procedure SetProvidedObject(const Value: TObject); virtual;
-    function GetProvidedObject: TObject; virtual;
-
     function CreateResolver: TCustomResolver; override;
     procedure CreateDataPacket(PacketOpts: TGetRecordOptions;
       ProvOpts: TProviderOptions; var RecsOut: Integer; var Data: OleVariant); override;
 
+    function InternalApplyUpdates(const Delta: OleVariant; MaxErrors: Integer; out ErrorCount: Integer): OleVariant; override;
+
   protected
     procedure Loaded; override;
-    procedure ExtractMetaData;
-    procedure ExtractData;
+    procedure ExtractMetaData; virtual; abstract;
+    procedure ExtractData; virtual; abstract;
 
-    function CreateDataSet: TCustomClientDataSet; virtual;
-    property DataSet: TCustomClientDataSet read GetDataSet;
+    procedure ApplyUpdate(Index: Integer; const FieldName: string; const Value: Variant); virtual; abstract;
+    procedure ApplyInsert(var Index: Integer); virtual; abstract;
+    procedure ApplyDelete(Index: Integer); virtual; abstract;
+
+    function CreateDataSet: TPacketDataSet; virtual;
+    property DataSet: TPacketDataSet read GetDataSet;
     property DSWriter: TDataPacketWriter read GetDSWriter;
 
   public
     constructor Create; overload;
-    constructor Create(AOwner: TComponent); overload; override;
+    constructor Create(AOwner: TComponent = nil); overload; override;
     destructor Destroy; override;
 
     procedure Open;
     procedure Close;
 
     property Active: Boolean read FActive write SetActive;
+    property FieldDefs: TFieldDefs read GetFieldDefs write SetFieldDefs;
+    property Options default [poDisableInserts, poDisableDeletes, poUseQuoteChar];
+  end;
+
+  TASObjectProvider = class(TASCustomProvider)
+  private
+    FClass: TClass;
+    FObject: TObject;
+
+  protected
+    procedure CheckAncestor(const Value, Ancestor: TClass); virtual;
+    procedure CheckProvidedObject(const Value: TObject); virtual;
+
+    procedure ApplyUpdateToObject(Target: TObject; const FieldName: string; const Value: Variant); virtual;
+
+    procedure SetProvidedClass(const Value: TClass); virtual;
+    function GetProvidedClass: TClass; virtual;
+    procedure SetProvidedObject(const Value: TObject); virtual;
+    function GetProvidedObject: TObject; virtual;
+
+    procedure ExtractMetaData; override;
+    procedure ExtractData; override;
+
+    procedure ApplyUpdate(Index: Integer; const FieldName: string; const Value: Variant); override;
+    procedure ApplyInsert(var Index: Integer); override;
+    procedure ApplyDelete(Index: Integer); override;
+
+  public
     property ProvidedClass: TClass read GetProvidedClass write SetProvidedClass;
     property ProvidedObject: TObject read GetProvidedObject write SetProvidedObject;
-    property FieldDefs: TFieldDefs read GetFieldDefs write SetFieldDefs;
   end;
 
-  TASProvider = class(TASCustomProvider)
+  TASProvider = class(TASObjectProvider)
+  published
+    property Active;
+    property FieldDefs;
+    property ProvidedObject;
+    property Options;
   end;
 
-  TASGenericProvider<T: class> = class(TASCustomProvider)
+  TASGenericProvider<T: class> = class(TASObjectProvider)
   private
     FTypedObject: T;
 
   protected
+    procedure CheckProvidedClass(const Value: TClass); virtual;
     procedure SetProvidedClass(const Value: TClass); override;
 
-    function GetProvidedTypedObject: T;
-    procedure SetProvidedTypedObject(const Value: T);
+    function GetProvidedTypedObject: T; virtual;
+    procedure SetProvidedTypedObject(const Value: T); virtual;
 
     property ProvidedObject;
 
 
   published
     property Active;
+    property FieldDefs;
     property ProvidedComponent: TComponent read GetProvidedComponent write SetProvidedComponent;
-    property FieldDefs;
+    property Options;
+  end;
+
+  TASCollectionProvider = class(TASGenericProvider<TCollection>)
+  private
+  protected
+    procedure CheckProvidedClass(const Value: TClass); override;
+    procedure CheckProvidedObject(const Value: TObject); override;
+    function GetProvidedTypedObject: TCollection; override;
+    procedure SetProvidedTypedObject(const Value: TCollection); override;
+
+    procedure ApplyUpdate(Index: Integer; const FieldName: string; const Value: Variant); override;
+    procedure ApplyInsert(var Index: Integer); override;
+    procedure ApplyDelete(Index: Integer); override;
+
+    property ProvidedTypedObject;
+
+  public
+    constructor Create(AOwner: TComponent); override;
+
+  published
+    property Options default [poUseQuoteChar];
+    property ProvidedCollection: TCollection read GetProvidedTypedObject write SetProvidedTypedObject;
   end;
 
   TASResolver = class(TCustomResolver)
 implementation
 
 uses
-  Forms, Rtti, TypInfo, Variants, CodeSiteLogging, ASDebug;
+  Rtti, TypInfo, Variants, Forms;
 
 procedure Register;
 begin
 
 constructor TASCustomProvider.Create(AOwner: TComponent);
 begin
-  inherited;
+  inherited Create(AOwner);
   FFieldDefs := DefaultFieldDefsClass.Create(DataSet);
+  Options := [poDisableInserts, poDisableDeletes, poUseQuoteChar];
 end;
 
 constructor TASCustomProvider.Create;
 begin
-  Create(Application);
+  Create(nil);
 end;
 
 procedure TASCustomProvider.CreateDataPacket(PacketOpts: TGetRecordOptions; ProvOpts: TProviderOptions;
   var RecsOut: Integer; var Data: OleVariant);
 begin
+  if not Active then
+    Open;
+
+  if grReset in PacketOpts then
+    DataSet.FindFirst;
+
   with DSWriter do begin
     PacketOptions := PacketOpts;
     Options := ProvOpts;
   end;
 end;
 
-function TASCustomProvider.CreateDataSet: TCustomClientDataSet;
+function TASCustomProvider.CreateDataSet: TPacketDataSet;
 begin
-  Result := TClientDataSet.Create(Self);
+  Result := TPacketDataSet.Create(Self);
 end;
 
 function TASCustomProvider.CreateResolver: TCustomResolver;
   inherited;
 end;
 
-procedure TASCustomProvider.ExtractData;
+function TASCustomProvider.GetDataSet: TPacketDataSet;
+begin
+  if not Assigned(FDataSet) then
+    FDataSet := CreateDataSet;
+
+  Result := FDataSet;
+end;
+
+function TASCustomProvider.GetDSWriter: TDataPacketWriter;
+begin
+  if not Assigned(FDSWriter) then
+    FDSWriter := TDataPacketWriter.Create;
+
+  Result := FDSWriter;
+end;
+
+function TASCustomProvider.GetFieldDefs: TFieldDefs;
+begin
+  Result := FFieldDefs;
+end;
+
+function TASCustomProvider.InternalApplyUpdates(const Delta: OleVariant; MaxErrors: Integer;
+  out ErrorCount: Integer): OleVariant;
+begin
+  Result := inherited;
+  ExtractData;
+end;
+
+procedure TASCustomProvider.Loaded;
+begin
+  inherited;
+  try
+    Active := FStreamedActive;
+{$IFDEF DEBUG}
+  except
+    on E: Exception do ApplicationShowException(E);
+{$ELSE}
+  finally
+{$ENDIF}
+  end;
+end;
+
+procedure TASCustomProvider.Open;
+begin
+  Active := True;
+end;
+
+procedure TASCustomProvider.SetActive(const Value: Boolean);
+begin
+  if csReading in ComponentState then
+    FStreamedActive := Value
+  else if Active <> Value then begin
+    if Value then begin
+      if FieldDefs.Count = 0 then
+        ExtractMetaData;
+      ExtractData;
+    end;
+
+    FActive := Value;
+  end;
+end;
+
+procedure TASCustomProvider.SetFieldDefs(const Value: TFieldDefs);
+begin
+  FFieldDefs.Assign(Value);
+end;
+
+{ TASResolver }
+
+procedure TASResolver.DoDelete(Tree: TUpdateTree);
+begin
+  (Provider as TASCustomProvider).ApplyDelete(Tree.Delta.RecNo - 1);
+end;
+
+procedure TASResolver.DoInsert(Tree: TUpdateTree);
+var
+  F: TField;
+  Index: Integer;
+begin
+  Index := Tree.Delta.RecNo - 1;
+  (Provider as TASCustomProvider).ApplyInsert(Index);
+
+  for F in Tree.Delta.Fields do begin
+    if F.ReadOnly then
+      Continue;
+
+    if VarIsClear(F.NewValue) then
+      Continue;
+
+    (Provider as TASCustomProvider).ApplyUpdate(Index, F.FieldName, F.NewValue);
+  end;
+end;
+
+procedure TASResolver.DoUpdate(Tree: TUpdateTree);
+var
+  F: TField;
+  Index: Integer;
+begin
+  Index := Tree.Delta.RecNo - 1;
+  for F in Tree.Delta.Fields do begin
+    if F.ReadOnly then
+      Continue;
+
+    if F.NewValue = F.OldValue then
+      Continue;
+
+    (Provider as TASCustomProvider).ApplyUpdate(Index, F.FieldName, F.NewValue);
+  end;
+end;
+
+procedure TASResolver.InitializeConflictBuffer(Tree: TUpdateTree);
+begin
+
+end;
+
+procedure TASResolver.InitTreeData(Tree: TUpdateTree);
+begin
+  Tree.Source := (Provider as TASCustomProvider).DataSet;
+end;
+
+{ TASGenericProvider<T> }
+
+function TASGenericProvider<T>.GetProvidedTypedObject: T;
+begin
+  Result := FTypedObject;
+end;
+
+procedure TASGenericProvider<T>.SetProvidedClass(const Value: TClass);
+begin
+  CheckProvidedClass(Value);
+
+  inherited;
+end;
+
+procedure TASGenericProvider<T>.SetProvidedTypedObject(const Value: T);
+begin
+  FTypedObject := Value;
+  SetProvidedObject(Value);
+end;
+
+procedure TASGenericProvider<T>.CheckProvidedClass(const Value: TClass);
+begin
+  CheckAncestor(Value, T);
+end;
+
+{ TASComponentProvider }
+
+function TASComponentProvider.GetProvidedComponent: TComponent;
+begin
+  Result := GetProvidedTypedObject;
+end;
+
+procedure TASComponentProvider.SetProvidedComponent(const Value: TComponent);
+begin
+  SetProvidedTypedObject(Value);
+end;
+
+{ TASObjectProvider }
+
+procedure TASObjectProvider.ApplyDelete(Index: Integer);
+begin
+
+end;
+
+procedure TASObjectProvider.ApplyInsert(var Index: Integer);
+begin
+
+end;
+
+procedure TASObjectProvider.ApplyUpdate(Index: Integer; const FieldName: string; const Value: Variant);
+begin
+  ApplyUpdateToObject(ProvidedObject, FieldName, Value);
+end;
+
+procedure TASObjectProvider.ApplyUpdateToObject(Target: TObject; const FieldName: string; const Value: Variant);
+var
+  Ctx: TRttiContext;
+  T: TRttiType;
+  P: TRttiProperty;
+begin
+  if not Assigned(Target) then
+    Exit;
+
+  Ctx := TRttiContext.Create;
+  try
+    T := Ctx.GetType(Target.ClassType);
+    P := T.GetProperty(FieldName);
+    if Assigned(P) and (P.GetValue(Target).AsVariant <> Value) then begin
+      P.SetValue(Target, TValue.FromVariant(Value));
+    end;
+  finally
+    Ctx.Free;
+  end;
+end;
+
+procedure TASObjectProvider.CheckAncestor(const Value, Ancestor: TClass);
+begin
+  if Assigned(Value) and not Value.InheritsFrom(Ancestor) then
+    raise EArgumentException.CreateFmt(
+      '%s: %s does not inherit from %s.',
+      [
+        ClassName, Value.ClassName, Ancestor.ClassName
+      ]
+    );
+end;
+
+procedure TASObjectProvider.CheckProvidedObject(const Value: TObject);
+begin
+  CheckAncestor(Value.ClassType, ProvidedClass);
+end;
+
+procedure TASObjectProvider.ExtractData;
 var
   Ctx: TRttiContext;
   T: TRttiType;
   end;
 end;
 
-procedure TASCustomProvider.ExtractMetaData;
+procedure TASObjectProvider.ExtractMetaData;
 var
   Ctx: TRttiContext;
   T: TRttiType;
     Result := type_map[T.TypeKind];
   end;
 
-  function fullName(T: TRttiObject): string;
-  begin
-    Result := '';
-
-    if T is TRttiNamedObject then
-      Result := (T as TRttiNamedObject).Name;
-
-    if Assigned(T.Parent) then
-      Result := fullName(T.Parent) + '.' + Result;
-  end;
-
 begin
   FieldDefs.Clear;
 
         if FieldDefs.IndexOf(P.Name) >= 0 then
           Continue;
 
-//        CodeSite.Send('Add field ''%s'' (%s) [%s] as %s', [P.Name, P.PropertyType.Name, fullName(P), GetEnumName(TypeInfo(TFieldType), Integer(F))]);
         with FieldDefs.AddFieldDef do try
           Name := P.Name;
           DataType := F;
-          if F in [ftString, ftWideString] then
+          if F = ftWideString then
             Size := 20;
 
           if not P.IsWritable then
   end;
 end;
 
-function TASCustomProvider.GetDataSet: TCustomClientDataSet;
-begin
-  if not Assigned(FDataSet) then
-    FDataSet := CreateDataSet;
-
-  Result := FDataSet;
-end;
-
-function TASCustomProvider.GetDSWriter: TDataPacketWriter;
-begin
-  if not Assigned(FDSWriter) then
-    FDSWriter := TDataPacketWriter.Create;
-
-  Result := FDSWriter;
-end;
-
-function TASCustomProvider.GetFieldDefs: TFieldDefs;
-begin
-  Result := FFieldDefs;
-end;
-
-function TASCustomProvider.GetProvidedClass: TClass;
+function TASObjectProvider.GetProvidedClass: TClass;
 begin
   Result := FClass;
 end;
 
-function TASCustomProvider.GetProvidedObject: TObject;
+function TASObjectProvider.GetProvidedObject: TObject;
 begin
   Result := FObject;
 end;
 
-procedure TASCustomProvider.Loaded;
-begin
-  inherited;
-  try
-    Active := FStreamedActive;
-{$IFDEF DEBUG}
-  except
-    on E: Exception do ApplicationShowException(E);
-{$ELSE}
-  finally
-{$ENDIF}
-  end;
-end;
-
-procedure TASCustomProvider.Open;
-begin
-  Active := True;
-end;
-
-procedure TASCustomProvider.SetActive(const Value: Boolean);
-begin
-  if csReading in ComponentState then
-    FStreamedActive := Value
-  else if Active <> Value then begin
-    if Value then begin
-      ExtractMetaData;
-      ExtractData;
-    end;
-
-    FActive := Value;
-  end;
-end;
-
-procedure TASCustomProvider.SetFieldDefs(const Value: TFieldDefs);
-begin
-  FFieldDefs.Assign(Value);
-end;
-
-procedure TASCustomProvider.SetProvidedClass(const Value: TClass);
+procedure TASObjectProvider.SetProvidedClass(const Value: TClass);
 begin
   FClass := Value;
 
-  if Active then
+  if not (FieldDefs.Count > 0) or (csReading in ComponentState) then
     ExtractMetaData;
 end;
 
-procedure TASCustomProvider.SetProvidedObject(const Value: TObject);
+procedure TASObjectProvider.SetProvidedObject(const Value: TObject);
 begin
   if not Assigned(FClass) and Assigned(Value) then
     ProvidedClass := Value.ClassType;
 
-  if Assigned(Value) and not Value.InheritsFrom(ProvidedClass) then
-    raise EArgumentException.CreateFmt(
-      '%s can not provide %s. It does not inherit from %s.',
-      [
-        ClassName, Value.ClassName, ProvidedClass.ClassName
-      ]
-    );
-
+  CheckProvidedObject(Value);
   FObject := Value;
 
   if Active then
     ExtractData;
 end;
 
-{ TASResolver }
+{ TASCollectionProvider }
 
-procedure TASResolver.DoDelete(Tree: TUpdateTree);
+procedure TASCollectionProvider.ApplyDelete(Index: Integer);
 begin
-
+  ProvidedCollection.Delete(Index);
 end;
 
-procedure TASResolver.DoInsert(Tree: TUpdateTree);
+procedure TASCollectionProvider.ApplyInsert(var Index: Integer);
 begin
-
+  Index := ProvidedCollection.Add.Index;
 end;
 
-procedure TASResolver.DoUpdate(Tree: TUpdateTree);
+procedure TASCollectionProvider.ApplyUpdate(Index: Integer; const FieldName: string; const Value: Variant);
 begin
-
+  ApplyUpdateToObject(ProvidedCollection.Items[Index], FieldName, Value);
 end;
 
-procedure TASResolver.InitializeConflictBuffer(Tree: TUpdateTree);
+procedure TASCollectionProvider.CheckProvidedClass(const Value: TClass);
 begin
-
+  CheckAncestor(Value, TCollectionItem);
 end;
 
-procedure TASResolver.InitTreeData(Tree: TUpdateTree);
+procedure TASCollectionProvider.CheckProvidedObject(const Value: TObject);
 begin
-  Tree.Source := (Provider as TASCustomProvider).DataSet;
+  CheckAncestor(Value.ClassType, TCollection);
 end;
 
-{ TASGenericProvider<T> }
-
-function TASGenericProvider<T>.GetProvidedTypedObject: T;
+constructor TASCollectionProvider.Create(AOwner: TComponent);
 begin
-  Result := FTypedObject;
-  CodeSite.Send('GetProvidedObject', Result);
-  TASDebug.OutputDebugStringFmt('GetProvidedObject: %s', [TValue.From<T>(Result).ToString]);
+  inherited;
+  Options := [poUseQuoteChar];
 end;
 
-procedure TASGenericProvider<T>.SetProvidedClass(const Value: TClass);
+function TASCollectionProvider.GetProvidedTypedObject: TCollection;
 begin
-  TASDebug.OutputDebugStringFmt('SetProvidedClass: %s', [TValue.From<TClass>(Value).ToString]);
-  if Assigned(Value) and not Value.InheritsFrom(T) then
-    raise EArgumentException.CreateFmt(
-      '%s can not provide a %s. It does not inherit from %s.',
-      [
-        ClassName, Value.ClassName, T.ClassName
-      ]
-    );
-
-  inherited;
+  Result := inherited;
 end;
 
-procedure TASGenericProvider<T>.SetProvidedTypedObject(const Value: T);
+procedure TASCollectionProvider.SetProvidedTypedObject(const Value: TCollection);
 begin
-  CodeSite.Send('SetProvidedObject', Value);
-  TASDebug.OutputDebugStringFmt('SetProvidedObject: %s', [TValue.From<T>(Value).ToString]);
-  FTypedObject := Value;
-  SetProvidedObject(Value);
-end;
-
-{ TASComponentProvider }
-
-function TASComponentProvider.GetProvidedComponent: TComponent;
-begin
-  Result := GetProvidedTypedObject;
-end;
-
-procedure TASComponentProvider.SetProvidedComponent(const Value: TComponent);
-begin
-  SetProvidedTypedObject(Value);
+  ProvidedClass := Value.ItemClass;
+  inherited;
 end;
 
 end.

File Test/TestASProvider.pas

     property Aint: Integer read Fint write Fint;
   end;
 
+  TTestGenericProvider = class(TASGenericProvider<TTestData>)
+  published
+    property Active;
+    property FieldDefs;
+    property ProvidedTypedObject;
+  end;
+
+  TTestItem = class(TCollectionItem)
+  private
+    Fstring: string;
+    Fint: Integer;
+  public
+    property Astring: string read Fstring write Fstring;
+    property Aint: Integer read Fint write Fint;
+  end;
+
   TExpectFieldDef = record
     Idx: Integer;
     Name: string;
     Attr: TFieldAttributes;
   end;
 
-  // Test methods for class TASCustomProvider
+  TExpectItem = record
+    Idx: Integer;
+    Astring: string;
+    Aint: Integer;
+  end;
 
-  TestTASProviders<T: TASCustomProvider, constructor> = class(TTestCase)
+  // Test methods for class TASObjectProvider
+
+  TestTASProviders<T: TASObjectProvider, constructor> = class(TTestCase)
   strict private
     FASCustomProvider: T;
   protected
-    procedure CheckFieldDef(Expect: TExpectFieldDef);
+    procedure CheckFieldDef(Expect: TExpectFieldDef; const Msg: string = '');
+    procedure CheckMetaData(ExpectFields: array of TExpectFieldDef; const Msg: string = '');
   public
     procedure SetUp; override;
     procedure TearDown; override;
     procedure TestProvidedClass;
     procedure TestMetaData;
     procedure TestData;
-
+    procedure TestModifiedFieldDefs;
+    procedure TestStreamingDFM;
+    procedure TestApply;
   end;
 
+  TestCollectionProvider = class(TTestCase)
+  strict private
+    FProvider: TASCollectionProvider;
+  protected
+    procedure CheckItem(Expect: TExpectItem; const Msg: string = '');
+    procedure CheckCollection(ExpectItems: array of TExpectItem; const Msg: string = '');
+  public
+    procedure SetUp; override;
+    procedure TearDown; override;
+  published
+    procedure TestProvidedClass;
+    procedure TestInsertData;
+    procedure TestDeleteData;
+    procedure TestInsertUpdateDeleteData;
+  end;
 
   // Test methods for class TASResolver
 
   TestTASResolver = class(TTestCase)
   strict private
     FASResolver: TASResolver;
-    FASCustomProvider: TASCustomProvider;
+    FASCustomProvider: TASObjectProvider;
   public
     procedure SetUp; override;
     procedure TearDown; override;
   end;
 
 const
-  expect_fields: array[1..3] of TExpectFieldDef = (
+  TestMetaData_fields: array[0..2] of TExpectFieldDef = (
     (Idx: 0; Name: 'Astring';   Size: 20; DataType: ftWideString; Attr: []),
     (Idx: 1; Name: 'AroString'; Size: 20; DataType: ftWideString; Attr: [faReadonly]),
     (Idx: 2; Name: 'Aint';      Size: 0;  DataType: ftInteger;    Attr: [])
   );
 
+  TestModified_fields: array[0..1] of TExpectFieldDef = (
+    (Idx: 0; Name: 'Astring';         Size: 35; DataType: ftString;   Attr: []),
+    (Idx: 1; Name: 'MyModifiedInt';   Size: 0;  DataType: ftInteger;  Attr: [])
+  );
+
+  TestCollectionItems: array[0..2] of TExpectItem = (
+    (Idx: 0; Astring: 'my updated string'; Aint: 123),
+    (Idx: 1; Astring: 'my org string'; Aint: 456),
+    (Idx: 3; Astring: 'my new string'; Aint: 789)
+  );
+
 implementation
 
 uses
-  Forms, Rtti;
+  Forms, Rtti, StrUtils;
 
-procedure TestTASProviders<T>.CheckFieldDef(Expect: TExpectFieldDef);
+procedure TestTASProviders<T>.CheckFieldDef(Expect: TExpectFieldDef; const Msg: string);
 var
   S: string;
 begin
-  S := Format('Field #%d ', [Expect.Idx]);
+  S := Format('%sField #%d ''%s'' ', [IfThen(Length(Msg) > 0, Msg + ', ', ''), Expect.Idx, Expect.Name]);
   with FASCustomProvider.FieldDefs[Expect.Idx] do begin
     CheckEqualsString(Expect.Name, Name, S + 'name');
     CheckEquals(Expect.Size, Size, S + 'size');
   end;
 end;
 
+procedure TestTASProviders<T>.CheckMetaData(ExpectFields: array of TExpectFieldDef; const Msg: string);
+var
+  I: Integer;
+  S: string;
+begin
+  if Length(Msg) > 0 then
+    S := Msg + ', '
+  else
+    S := '';
+
+  CheckEquals(ExpectFields[High(ExpectFields)].Idx + 1, FASCustomProvider.FieldDefs.Count, S + 'Unexpected number of field defs');
+
+  for I := Low(ExpectFields) to High(ExpectFields) do
+    CheckFieldDef(ExpectFields[I], Msg);
+end;
+
 procedure TestTASProviders<T>.SetUp;
 begin
   FASCustomProvider := T.Create;
+  Application.InsertComponent(FASCustomProvider);
 end;
 
 procedure TestTASProviders<T>.TearDown;
 begin
-  FASCustomProvider.Free;
-  FASCustomProvider := nil;
+  FreeAndNil(FASCustomProvider);
+end;
+
+procedure TestTASProviders<T>.TestApply;
+var
+  Obj: TTestData;
+  DS: TClientDataSet;
+begin
+  Obj := TTestData.Create;
+  DS := TClientDataSet.Create(Application);
+  try
+    with Obj do begin
+      FroString := 'a ro string';
+      Astring := 'a string';
+      Aint := 5;
+    end;
+
+    FASCustomProvider.ProvidedObject := Obj;
+    FASCustomProvider.Name := 'TestProvider';
+
+    DS.ProviderName := 'TestProvider';
+    DS.Active := True;
+
+    DS.Edit;
+    DS.FieldByName('Astring').AsString := 'A modified string';
+    DS.FieldByName('Aint').AsInteger := 11;
+    DS.Post;
+    CheckEquals(0, DS.ApplyUpdates(-1), 'Apply updates');
+
+    CheckEqualsString('a ro string', Obj.AroString);
+    CheckEqualsString('A modified string', Obj.Astring);
+    CheckEquals(5, 11, Obj.Aint);
+  finally
+    Obj.Free;
+    DS.Free;
+  end;
 end;
 
 procedure TestTASProviders<T>.TestData;
 end;
 
 procedure TestTASProviders<T>.TestMetaData;
-var
-  I: Integer;
-
 begin
   FASCustomProvider.ProvidedClass := TTestData;
   CheckEquals(TTestData, FASCustomProvider.ProvidedClass, 'Provided class');
-  CheckEquals(High(expect_fields), FASCustomProvider.FieldDefs.Count, 'Unexpected number of field defs');
+  CheckMetaData(TestMetaData_fields);
+end;
 
-  for I := Low(expect_fields) to High(expect_fields) do
-    CheckFieldDef(expect_fields[I]);
+procedure TestTASProviders<T>.TestModifiedFieldDefs;
+begin
+  FASCustomProvider.ProvidedClass := TTestData;
+  CheckMetaData(TestMetaData_fields, 'Original');
+
+  with FASCustomProvider.FieldDefs do begin
+    Find('AroString').Free;
+    Find('Aint').Name := 'MyModifiedInt';
+    with Find('Astring') do begin
+      DataType := ftString; {notice: changing datatype also updates the size field: e.g. order is important}
+      Size := 35;
+    end;
+  end;
+
+  CheckMetaData(TestModified_fields, 'Modified');
+
+  { Should not extract meta data from class if there already exists field data }
+  FASCustomProvider.ProvidedClass := TTestData;
+  CheckMetaData(TestModified_fields, 'Reloaded');
+
+  FASCustomProvider.FieldDefs.Clear;
+  FASCustomProvider.ProvidedClass := TTestData;
+  CheckMetaData(TestMetaData_fields, 'Cleared and reloaded');
 end;
 
 procedure TestTASProviders<T>.TestProvidedClass;
 begin
-  if not T.ClassNameIs('TASCustomProvider') then
+  if not T.ClassNameIs('TASProvider') then
     ExpectedException := EArgumentException;
+
   FASCustomProvider.ProvidedClass := Self.ClassType;
+  Check(FASCustomProvider.ProvidedClass = Self.ClassType);
+end;
+
+procedure TestTASProviders<T>.TestStreamingDFM;
+var
+  Stream: TMemoryStream;
+begin
+  FASCustomProvider.ProvidedClass := TTestData;
+  with FASCustomProvider.FieldDefs do begin
+    Find('AroString').Free;
+    Find('Aint').Name := 'MyModifiedInt';
+    with Find('Astring') do begin
+      DataType := ftString; {notice: changing datatype also updates the size field: e.g. order is important}
+      Size := 35;
+    end;
+  end;
+
+  CheckMetaData(TestModified_fields, 'Write');
+
+  Stream := TMemoryStream.Create;
+  try
+    Stream.WriteComponent(FASCustomProvider);
+    FreeAndNil(FASCustomProvider);
+    Stream.Position := 0;
+    FASCustomProvider := T(Stream.ReadComponent(T.Create));
+  finally
+    Stream.Free;
+  end;
+
+  CheckMetaData(TestModified_fields, 'Read');
 end;
 
 procedure TestTASResolver.SetUp;
 begin
-  FASCustomProvider := TASCustomProvider.Create(nil);
+  FASCustomProvider := TASObjectProvider.Create(nil);
   FASResolver := TASResolver.Create(FASCustomProvider);
 end;
 
   end;
 end;
 
+{ TestCollectionProvider }
+
+procedure TestCollectionProvider.CheckCollection(ExpectItems: array of TExpectItem; const Msg: string);
+var
+  I: Integer;
+  S: string;
+begin
+  if Length(Msg) > 0 then
+    S := Msg + ', '
+  else
+    S := '';
+
+  CheckEquals(ExpectItems[High(ExpectItems)].Idx + 1, FProvider.ProvidedCollection.Count, S + 'Unexpected number of items');
+
+  for I := Low(ExpectItems) to High(ExpectItems) do
+    CheckItem(ExpectItems[I], Msg);
+end;
+
+procedure TestCollectionProvider.CheckItem(Expect: TExpectItem; const Msg: string);
+var
+  S: string;
+begin
+  S := Format('%sItem #%d ', [IfThen(Length(Msg) > 0, Msg + ', ', ''), Expect.Idx]);
+  with FProvider.ProvidedCollection.Items[Expect.Idx] as TTestItem do begin
+    CheckEqualsString(Expect.Astring, Astring, S + 'Astring');
+    CheckEquals(Expect.Aint, Aint, S + 'Aint');
+  end;
+end;
+
+procedure TestCollectionProvider.SetUp;
+begin
+  FProvider := TASCollectionProvider.Create(Application);
+end;
+
+procedure TestCollectionProvider.TearDown;
+begin
+  FreeAndNil(FProvider);
+end;
+
+procedure TestCollectionProvider.TestDeleteData;
+var
+  C: TCollection;
+  DS: TClientDataSet;
+begin
+  C := TCollection.Create(TTestItem);
+  DS := TClientDataSet.Create(Application);
+  try
+    C.Add;
+    FProvider.ProvidedCollection := C;
+    FProvider.Name := 'TestProvider';
+    DS.ProviderName := 'TestProvider';
+    DS.Active := True;
+    DS.Delete;
+    CheckEquals(0, DS.ApplyUpdates(-1), 'Apply updates');
+
+    CheckEquals(0, C.Count, 'Collection count');
+  finally
+    DS.Free;
+    C.Free;
+  end;
+end;
+
+procedure TestCollectionProvider.TestInsertData;
+var
+  C: TCollection;
+  DS: TClientDataSet;
+begin
+  C := TCollection.Create(TTestItem);
+  DS := TClientDataSet.Create(Application);
+  try
+    FProvider.ProvidedCollection := C;
+    FProvider.Name := 'TestProvider';
+    DS.ProviderName := 'TestProvider';
+    DS.Active := True;
+    DS.Insert;
+    DS.FindField('Astring').AsString := 'my string';
+    DS.FindField('Aint').AsInteger := 55;
+    CheckEquals(0, DS.ApplyUpdates(-1), 'Apply updates');
+    CheckEquals(1, C.Count, 'Collection count');
+    CheckEqualsString('my string', TTestItem(C.Items[0]).Astring, 'Astring');
+    CheckEquals(55, TTestItem(C.Items[0]).Aint, 'Aint');
+  finally
+    DS.Free;
+    C.Free;
+  end;
+end;
+
+procedure TestCollectionProvider.TestInsertUpdateDeleteData;
+var
+  C: TCollection;
+  DS: TClientDataSet;
+begin
+  C := TCollection.Create(TTestItem);
+  DS := TClientDataSet.Create(Application);
+  try
+    FProvider.ProvidedCollection := C;
+    FProvider.Name := 'TestProvider';
+    DS.ProviderName := 'TestProvider';
+    DS.Active := True;
+    DS.Insert;
+    DS.FindField('Astring').AsString := 'my string';
+    DS.FindField('Aint').AsInteger := 55;
+    CheckEquals(0, DS.ApplyUpdates(-1), 'Apply updates');
+    CheckEquals(1, C.Count, 'Collection count');
+    CheckEqualsString('my string', TTestItem(C.Items[0]).Astring, 'Astring');
+    CheckEquals(55, TTestItem(C.Items[0]).Aint, 'Aint');
+  finally
+    DS.Free;
+    C.Free;
+  end;
+end;
+
+procedure TestCollectionProvider.TestProvidedClass;
+var
+  C: TCollection;
+begin
+  C := TCollection.Create(TTestItem);
+  try
+    FProvider.ProvidedCollection := C;
+    Check(FProvider.ProvidedClass = TTestItem, 'Provided class');
+  finally
+    C.Free;
+  end;
+end;
+
 initialization
   // Register any test cases with the test runner
-  RegisterTest(TestTASProviders<TASCustomProvider>.Suite);
-  RegisterTest(TestTASProviders<TASGenericProvider<TTestData>>.Suite);
-  RegisterTest(TestTASResolver.Suite);
+  RegisterTest('Provider', TestTASProviders<TASProvider>.Suite);
+  RegisterTest('Provider', TestTASProviders<TTestGenericProvider>.Suite);
+  RegisterTest('Provider', TestCollectionProvider.Suite);
+  RegisterTest('Resolver', TestTASResolver.Suite);
 end.