* Implemented autoincremental fields for TBufDataset

git-svn-id: trunk@21757 -

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

@@ -353,7 +353,7 @@ type
     constructor create(AStream : TStream); virtual;
     // Load a dataset from stream:
     // Load the field-definitions from a stream.
-    procedure LoadFieldDefs(AFieldDefs : TFieldDefs); virtual; abstract;
+    procedure LoadFieldDefs(AFieldDefs : TFieldDefs; var AnAutoIncValue : integer); virtual; abstract;
     // Is called before the records are loaded
     procedure InitLoadRecords; virtual; abstract;
     // Return the RowState of the current record, and the order of the update
@@ -367,7 +367,7 @@ type
 
     // Store a dataset to stream:
     // Save the field-definitions to a stream.
-    procedure StoreFieldDefs(AFieldDefs : TFieldDefs); virtual; abstract;
+    procedure StoreFieldDefs(AFieldDefs : TFieldDefs; AnAutoIncValue : integer); virtual; abstract;
     // Save a record from the current record-buffer to the stream
     procedure StoreRecord(ADataset : TCustomBufDataset; ARowState : TRowState; AUpdOrder : integer = 0); virtual; abstract;
     // Is called after all records are stored
@@ -381,8 +381,8 @@ type
 
   TFpcBinaryDatapacketReader = class(TDataPacketReader)
   public
-    procedure LoadFieldDefs(AFieldDefs : TFieldDefs); override;
-    procedure StoreFieldDefs(AFieldDefs : TFieldDefs); override;
+    procedure LoadFieldDefs(AFieldDefs : TFieldDefs; var AnAutoIncValue : integer); override;
+    procedure StoreFieldDefs(AFieldDefs : TFieldDefs; AnAutoIncValue : integer); override;
     function GetRecordRowState(out AUpdOrder : Integer) : TRowState; override;
     procedure FinalizeStoreRecords; override;
     function GetCurrentRecord : boolean; override;
@@ -416,6 +416,8 @@ type
     FOpen           : Boolean;
     FUpdateBuffer   : TRecordsUpdateBuffer;
     FCurrentUpdateBuffer : integer;
+    FAutoIncValue   : longint;
+    FAutoIncField   : TAutoIncField;
 
     FIndexDefs      : TIndexDefs;
 
@@ -765,6 +767,7 @@ begin
   FIndexesCount:=0;
 
   FIndexDefs := TIndexDefs.Create(Self);
+  FAutoIncValue:=-1;
 
   SetLength(FUpdateBuffer,0);
   SetLength(FBlobBuffers,0);
@@ -1120,6 +1123,7 @@ var IndexNr : integer;
     i : integer;
 
 begin
+  FAutoIncField:=nil;
   if not Assigned(FDatasetReader) and (FileName<>'') then
     begin
     FFileStream := TFileStream.Create(FileName,fmOpenRead);
@@ -1132,20 +1136,22 @@ begin
   // reading from a stream in some other way implemented by a descendent)
   // If there are less fields then FieldDefs we know for sure that the dataset
   // is not (correctly) created.
-  
+
   // commented for now. If there are constant expressions in the select
   // statement they are ftunknown, and not created.
   // See mantis #22030
-  
+
   //  if Fields.Count<FieldDefs.Count then
   //    DatabaseError(SErrNoDataset);
-  
+
   // If there is a field with FieldNo=0 then the fields are not found to the
   // FieldDefs which is a sign that there is no dataset created. (Calculated and
   // lookupfields have FieldNo=-1)
   for i := 0 to Fields.Count-1 do
     if fields[i].FieldNo=0 then
-      DatabaseError(SErrNoDataset);
+      DatabaseError(SErrNoDataset)
+    else if (FAutoIncValue>-1) and (fields[i] is TAutoIncField) and not assigned(FAutoIncField) then
+      FAutoIncField := TAutoIncField(fields[i]);
 
   InitDefaultIndexes;
   CalcRecordSize;
@@ -1218,6 +1224,8 @@ begin
 
   SetLength(FFieldBufPositions,0);
 
+  FAutoIncValue:=-1;
+
   if assigned(FParser) then FreeAndNil(FParser);
   FReadFromFile:=false;
 end;
@@ -2195,6 +2203,8 @@ Var ABuff        : TRecordBuffer;
     i            : integer;
     blobbuf      : tbufblobfield;
     NullMask     : pbyte;
+    li           : longint;
+    StoreReadOnly: boolean;
     ABookmark    : PBufBookmark;
 
 begin
@@ -2215,6 +2225,21 @@ begin
 
   if State = dsInsert then
     begin
+    if assigned(FAutoIncField) then
+      begin
+      li := FAutoIncValue;
+      // In principle all TAutoIncfields are read-only, but in theory it is
+      // possible to set readonly to false.
+      StoreReadOnly:=FAutoIncField.ReadOnly;
+      FAutoIncField.ReadOnly:=false;
+      try
+        FAutoIncField.SetData(@li);
+      finally
+        FAutoIncField.ReadOnly:=FAutoIncField.ReadOnly;
+      end;
+      inc(FAutoIncValue);
+      end;
+
     // The active buffer is the newly created TDataset record,
     // from which the bookmark is set to the record where the new record should be
     // inserted
@@ -2656,7 +2681,7 @@ begin
   try
     //CheckActive;
     ABookMark:=@ATBookmark;
-    FDatasetReader.StoreFieldDefs(FieldDefs);
+    FDatasetReader.StoreFieldDefs(FieldDefs,FAutoIncValue);
 
     StoreDSState:=SetTempState(dsFilter);
     ScrollResult:=FCurrentIndex.ScrollFirst;
@@ -2748,6 +2773,7 @@ begin
       end
     else
       raise Exception.Create(SErrNoFieldsDefined);
+    FAutoIncValue:=1;
     end;
   // When a filename is set, do not read from this file
   AStoreFilename:=FFileName;
@@ -2777,7 +2803,7 @@ procedure TCustomBufDataset.IntLoadFielddefsFromFile;
 
 begin
   FieldDefs.Clear;
-  FDatasetReader.LoadFielddefs(FieldDefs);
+  FDatasetReader.LoadFielddefs(FieldDefs, FAutoIncValue);
   if DefaultFields then
     CreateFields
   else
@@ -3418,7 +3444,7 @@ end;
 
 const FpcBinaryIdent = 'BinBufDataset';
 
-procedure TFpcBinaryDatapacketReader.LoadFieldDefs(AFieldDefs: TFieldDefs);
+procedure TFpcBinaryDatapacketReader.LoadFieldDefs(AFieldDefs: TFieldDefs; var AnAutoIncValue: integer);
 
 var FldCount : word;
     i        : integer;
@@ -3439,9 +3465,11 @@ begin
     if Stream.ReadByte = 1 then
       Attributes := Attributes + [faReadonly];
     end;
+  Stream.ReadBuffer(i,sizeof(i));
+  AnAutoIncValue := i;
 end;
 
-procedure TFpcBinaryDatapacketReader.StoreFieldDefs(AFieldDefs: TFieldDefs);
+procedure TFpcBinaryDatapacketReader.StoreFieldDefs(AFieldDefs: TFieldDefs; AnAutoIncValue: integer);
 var i : integer;
 begin
   Stream.Write(FpcBinaryIdent[1],length(FpcBinaryIdent));
@@ -3459,6 +3487,8 @@ begin
     else
       Stream.WriteByte(0);
     end;
+  i := AnAutoIncValue;
+  Stream.WriteBuffer(i,sizeof(i));
 end;
 
 function TFpcBinaryDatapacketReader.GetRecordRowState(out AUpdOrder : Integer) : TRowState;

packages/fcl-db/src/base/xmldatapacketreader.pp

@@ -48,10 +48,10 @@ type
     FLastChange    : integer;
   public
     destructor destroy; override;
-    procedure StoreFieldDefs(AFieldDefs : TFieldDefs); override;
+    procedure StoreFieldDefs(AFieldDefs : TFieldDefs; AnAutoIncValue : integer); override;
     procedure StoreRecord(ADataset : TCustomBufDataset; ARowState : TRowState; AUpdOrder : integer = 0); override;
     procedure FinalizeStoreRecords; override;
-    procedure LoadFieldDefs(AFieldDefs : TFieldDefs); override;
+    procedure LoadFieldDefs(AFieldDefs : TFieldDefs; var AnAutoIncValue : integer); override;
     procedure InitLoadRecords; override;
     function GetCurrentRecord : boolean; override;
     function GetRecordRowState(out AUpdOrder : Integer) : TRowState; override;
@@ -123,7 +123,7 @@ begin
   inherited destroy;
 end;
 
-procedure TXMLDatapacketReader.LoadFieldDefs(AFieldDefs : TFieldDefs);
+procedure TXMLDatapacketReader.LoadFieldDefs(AFieldDefs: TFieldDefs; var AnAutoIncValue: integer);
 
   function GetNodeAttribute(const aNode : TDOMNode; AttName : String) : string;
   var AnAttr : TDomNode;
@@ -139,6 +139,7 @@ var i           : integer;
     FTString    : string;
     SubFTString : string;
     AFieldNode  : TDOMNode;
+    AnAutoIncNode: TDomNode;
 
 begin
   ReadXMLFile(XMLDocument,Stream);
@@ -175,15 +176,20 @@ begin
       end;
     end;
 
-  FChangeLogNode := MetaDataNode.FindNode('PARAMS');
-  if assigned(FChangeLogNode) then
-    FChangeLogNode := FChangeLogNode.Attributes.GetNamedItem('CHANGE_LOG');
+  FParamsNode := MetaDataNode.FindNode('PARAMS');
+  if assigned(FParamsNode) then
+    begin
+    FChangeLogNode := FParamsNode.Attributes.GetNamedItem('CHANGE_LOG');
+    AnAutoIncNode := FParamsNode.Attributes.GetNamedItem('AUTOINCVALUE');
+    if assigned(AnAutoIncNode) then
+      AnAutoIncValue := StrToIntDef(AnAutoIncNode.NodeValue,-1);
+    end;
 
   FRowDataNode := DataPacketNode.FindNode('ROWDATA');
   FRecordNode := nil;
 end;
 
-procedure TXMLDatapacketReader.StoreFieldDefs(AFieldDefs: TFieldDefs);
+procedure TXMLDatapacketReader.StoreFieldDefs(AFieldDefs: TFieldDefs; AnAutoIncValue: integer);
 
 var i,p         : integer;
     AFieldNode  : TDOMElement;
@@ -219,6 +225,9 @@ begin
 
   MetaDataNode.AppendChild(FieldsNode);
   FParamsNode := XMLDocument.CreateElement('PARAMS');
+  if AnAutoIncValue>-1 then
+    (FParamsNode as TDomElement).SetAttribute('AUTOINCVALUE',IntToStr(AnAutoIncValue));
+
   MetaDataNode.AppendChild(FParamsNode);
   DataPacketNode.AppendChild(MetaDataNode);
   FRowDataNode := XMLDocument.CreateElement('ROWDATA');

packages/fcl-db/tests/testspecifictbufdataset.pas

@@ -25,7 +25,9 @@ type
 
   TTestSpecificTBufDataset = class(TTestCase)
   private
-    procedure TestDataset(ABufDataset: TBufDataset);
+    procedure TestDataset(ABufDataset: TBufDataset; AutoInc: boolean = false);
+    function GetAutoIncDataset: TBufDataset;
+    procedure IntTestAutoIncFieldStreaming(XML: boolean);
   protected
     procedure SetUp; override;
     procedure TearDown; override;
@@ -34,6 +36,9 @@ type
     procedure CreateDatasetFromFields;
     procedure TestOpeningNonExistingDataset;
     procedure TestCreationDatasetWithCalcFields;
+    procedure TestAutoIncField;
+    procedure TestAutoIncFieldStreaming;
+    procedure TestAutoIncFieldStreamingXML;
   end;
 
 implementation
@@ -48,14 +53,16 @@ uses
 
 { TTestSpecificTBufDataset }
 
-procedure TTestSpecificTBufDataset.TestDataset(ABufDataset: TBufDataset);
+procedure TTestSpecificTBufDataset.TestDataset(ABufDataset: TBufDataset;
+  AutoInc: boolean);
 var
   i  : integer;
 begin
   for i := 1 to 10 do
     begin
     ABufDataset.Append;
-    ABufDataset.FieldByName('ID').AsInteger := i;
+    if not AutoInc then
+      ABufDataset.FieldByName('ID').AsInteger := i;
     ABufDataset.FieldByName('NAME').AsString := 'TestName' + inttostr(i);
     ABufDataset.Post;
     end;
@@ -69,6 +76,52 @@ begin
   CheckTrue(ABufDataset.EOF);
 end;
 
+function TTestSpecificTBufDataset.GetAutoIncDataset: TBufDataset;
+var
+  ds : TBufDataset;
+  f: TField;
+begin
+  ds := TBufDataset.Create(nil);
+  F := TAutoIncField.Create(ds);
+  F.FieldName:='ID';
+  F.DataSet:=ds;
+  F := TStringField.Create(ds);
+  F.FieldName:='NAME';
+  F.DataSet:=ds;
+  F.Size:=50;
+  DS.CreateDataset;
+
+  TestDataset(ds,True);
+  result := ds;
+end;
+
+procedure TTestSpecificTBufDataset.IntTestAutoIncFieldStreaming(XML: boolean);
+var
+  ds : TBufDataset;
+  fn: string;
+begin
+  ds := GetAutoIncDataset;
+  fn := GetTempFileName;
+  if xml then
+    ds.SaveToFile(fn,dfXML)
+  else
+    ds.SaveToFile(fn);
+  DS.Close;
+  ds.Free;
+
+  ds := TBufDataset.Create(nil);
+  ds.LoadFromFile(fn);
+  ds.Last;
+  CheckEquals(10,ds.FieldByName('Id').AsInteger);
+  ds.Append;
+  ds.FieldByName('NAME').asstring := 'Test';
+  ds.Post;
+  CheckEquals(11,ds.FieldByName('Id').AsInteger);
+  ds.Free;
+
+  DeleteFile(fn);
+end;
+
 procedure TTestSpecificTBufDataset.SetUp;
 begin
   DBConnector.StartTest;
@@ -176,6 +229,25 @@ begin
   end;
 end;
 
+procedure TTestSpecificTBufDataset.TestAutoIncField;
+var
+  ds : TBufDataset;
+begin
+  ds := GetAutoIncDataset;
+  DS.Close;
+  ds.Free;
+end;
+
+procedure TTestSpecificTBufDataset.TestAutoIncFieldStreaming;
+begin
+  IntTestAutoIncFieldStreaming(false);
+end;
+
+procedure TTestSpecificTBufDataset.TestAutoIncFieldStreamingXML;
+begin
+  IntTestAutoIncFieldStreaming(true);
+end;
+
 initialization
 {$ifdef fpc}