* Added CopyFromDataset, Clear

git-svn-id: trunk@33150 -

packages/fcl-db/src/base/bufdataset.pas

@@ -592,9 +592,10 @@ type
     procedure LoadFromFile(AFileName: string = ''; Format: TDataPacketFormat = dfAny);
     procedure SaveToFile(AFileName: string = ''; Format: TDataPacketFormat = dfBinary);
     procedure CreateDataset;
+    Procedure Clear; // Will close and remove all field definitions.
     function BookmarkValid(ABookmark: TBookmark): Boolean; override;
     function CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Longint; override;
-
+    Procedure CopyFromDataset(DataSet : TDataSet;CopyData : Boolean=True);
     property ChangeCount : Integer read GetChangeCount;
     property MaxIndexesCount : Integer read FMaxIndexesCount write SetMaxIndexesCount default 2;
     property ReadOnly : Boolean read FReadOnly write SetReadOnly default false;
@@ -1355,6 +1356,111 @@ begin
     SetToLastRecord;
 end;
 
+procedure TCustomBufDataset.CopyFromDataset(DataSet: TDataSet; CopyData: Boolean);
+
+Const
+  UseStreams = ftBlobTypes;
+
+Var
+  I  : Integer;
+  F,F1,F2 : TField;
+  L1,L2  : TList;
+  N : String;
+  OriginalPosition: TBookMark;
+  S : TMemoryStream;
+  
+begin
+  Close;
+  Fields.Clear;
+  FieldDefs.Clear;
+  For I:=0 to Dataset.FieldCount-1 do
+    begin
+    F:=Dataset.Fields[I];
+    TFieldDef.Create(FieldDefs,F.FieldName,F.DataType,F.Size,F.Required,F.FieldNo);
+    end;
+  CreateDataset;
+  L1:=Nil;
+  L2:=Nil;
+  S:=Nil;
+  If CopyData then
+    try
+      L1:=TList.Create;
+      L2:=TList.Create;
+      Open;
+      For I:=0 to FieldDefs.Count-1 do
+        begin
+        N:=FieldDefs[I].Name;
+        F1:=FieldByName(N);
+        F2:=DataSet.FieldByName(N);
+        L1.Add(F1);
+        L2.Add(F2);
+        If (FieldDefs[I].DataType in UseStreams) and (S=Nil) then
+          S:=TMemoryStream.Create;
+        end;
+      DisableControls;
+      Dataset.DisableControls;
+      OriginalPosition:=Dataset.GetBookmark;
+      Try
+        Dataset.Open;
+        Dataset.First;
+        While not Dataset.EOF do
+          begin
+          Append;
+          For I:=0 to L1.Count-1 do
+            begin
+            F1:=TField(L1[i]);
+            F2:=TField(L2[I]);
+            If Not F2.IsNull then
+              Case F1.DataType of
+                 ftFixedChar,
+                 ftString   : F1.AsString:=F2.AsString;
+                 ftFixedWideChar,
+                 ftWideString : F1.AsWideString:=F2.AsWideString;
+                 ftBoolean  : F1.AsBoolean:=F2.AsBoolean;
+                 ftFloat    : F1.AsFloat:=F2.AsFloat;
+                 ftAutoInc,
+                 ftLargeInt : F1.AsInteger:=F2.AsInteger;
+                 ftSmallInt : F1.AsInteger:=F2.AsInteger;
+                 ftInteger  : F1.AsInteger:=F2.AsInteger;
+                 ftDate     : F1.AsDateTime:=F2.AsDateTime;
+                 ftTime     : F1.AsDateTime:=F2.AsDateTime;
+                 ftTimestamp,
+                 ftDateTime : F1.AsDateTime:=F2.AsDateTime;
+                 ftCurrency : F1.AsCurrency:=F2.AsCurrency;
+                 ftBCD,
+                 ftFmtBCD   : F1.AsBCD:=F2.AsBCD;
+            else
+              if (F1.DataType in UseStreams) then
+                begin
+                S.Clear;
+                TBlobField(F2).SaveToStream(S);
+                S.Position:=0;
+                TBlobField(F1).LoadFromStream(S);
+                end
+              else  
+                F1.AsString:=F2.AsString;
+            end;
+          end;
+          Try
+            Post;
+          except
+            Cancel;
+            Raise;
+          end;
+          Dataset.Next;
+          end;
+      Finally
+        DataSet.GotoBookmark(OriginalPosition); //Return to original record
+        Dataset.EnableControls;
+        EnableControls;
+      end;
+    finally
+      L2.Free;
+      l1.Free;
+      S.Free;
+    end;
+end;
+
 { TBufIndex }
 
 constructor TBufIndex.Create(const ADataset: TCustomBufDataset);
@@ -3078,6 +3184,13 @@ begin
   end;
 end;
 
+procedure TCustomBufDataset.Clear;
+begin
+  Close;
+  FieldDefs.Clear;
+  Fields.Clear;
+end;
+
 function TCustomBufDataset.BookmarkValid(ABookmark: TBookmark): Boolean;
 begin
   Result:=assigned(FCurrentIndex) and  FCurrentIndex.BookmarkValid(pointer(ABookmark));

packages/fcl-db/tests/testspecifictbufdataset.pas

@@ -23,7 +23,7 @@ type
 
   { TTestSpecificTBufDataset }
 
-  TTestSpecificTBufDataset = class(TTestCase)
+  TTestSpecificTBufDataset = class(TDBBasicsTestCase)
   private
     procedure TestDataset(ABufDataset: TBufDataset; AutoInc: boolean = false);
     function GetAutoIncDataset: TBufDataset;
@@ -40,6 +40,9 @@ type
     procedure TestAutoIncFieldStreaming;
     procedure TestAutoIncFieldStreamingXML;
     Procedure TestRecordCount;
+    Procedure TestClear;
+    procedure TestCopyFromDataset; //is copied dataset identical to original?
+    procedure TestCopyFromDatasetMoved; //move record then copy. Is copy identical? Has record position changed?
   end;
 
 implementation
@@ -251,7 +254,7 @@ end;
 procedure TTestSpecificTBufDataset.TestRecordCount;
 var
   BDS:TBufDataSet;
-  
+
 begin
   BDS:=TBufDataSet.Create(nil);
   BDS.FieldDefs.Add('ID',ftLargeint);
@@ -263,7 +266,73 @@ begin
   AssertEquals('IsEmpty: ',True,BDS.IsEmpty);
   AssertEquals('RecordCount: ',0,BDS.RecordCount);
 end;
-  
+
+procedure TTestSpecificTBufDataset.TestClear;
+
+const
+  testValuesCount=3;
+var
+  i: integer;
+begin
+  with DBConnector.GetNDataset(10) as TBufDataset do
+    begin
+    Open;
+    Clear;
+    AssertTrue('Dataset Closed',Not Active);
+    AssertEquals('No fields',0,Fields.Count);
+    AssertEquals('No fielddefs',0,FieldDefs.Count);
+    // test after FieldDefs are Cleared, if internal structures are updated properly
+    // create other FieldDefs
+    FieldDefs.Add('Fs', ftString, 20);
+    FieldDefs.Add('Fi', ftInteger);
+    FieldDefs.Add('Fi2', ftInteger);
+    // use only Open without CreateTable
+    CreateDataset;
+    AssertTrue('Empty dataset',IsEmpty);
+    // add some data
+    for i:=1 to testValuesCount do
+      AppendRecord([TestStringValues[i], TestIntValues[i], TestIntValues[i]]);
+    // check data
+    AssertEquals('Record count',testValuesCount, RecordCount);
+    First;
+    for i:=1 to testValuesCount do
+    begin
+      AssertEquals('Field FS, Record '+InttoStr(i),TestStringValues[i], FieldByName('Fs').AsString);
+      AssertEquals('Field Fi2, Record '+InttoStr(i),TestIntValues[i], FieldByName('Fi2').AsInteger);
+      Next;
+    end;
+    CheckTrue(Eof);
+  end;
+end;
+
+procedure TTestSpecificTBufDataset.TestCopyFromDataset;
+var bufds1, bufds2: TBufDataset;
+begin
+  bufds1:=DBConnector.GetFieldDataset as TBufDataset;
+  bufds2:=DBConnector.GetNDataset(0) as TBufDataset;
+
+  bufds1.Open;
+  bufds2.CopyFromDataset(bufds1);
+  CheckFieldDatasetValues(bufds2);
+end;
+
+procedure TTestSpecificTBufDataset.TestCopyFromDatasetMoved;
+var
+  bufds1, bufds2: TBufDataset;
+  CurrentID,NewID: integer;
+begin
+  bufds1:=DBConnector.GetFieldDataset as TBufDataset;
+  bufds2:=DBConnector.GetNDataset(0) as TBufDataset;
+
+  bufds1.Open;
+  bufds1.Next; //this should not influence the copydataset step.
+  CurrentID:=bufds1.FieldByName('ID').AsInteger;
+  bufds2.CopyFromDataset(bufds1);
+  CheckFieldDatasetValues(bufds2);
+  NewID:=bufds1.FieldByName('ID').AsInteger;
+  AssertEquals('Mismatch between ID field contents - the record has moved.',CurrentID,NewID);
+end;
+
 initialization
 {$ifdef fpc}