paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-04 17:10:20 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Implemented autoincremental fields for TBufDataset

Browse Source 
git-svn-id: trunk@21757 -
This commit is contained in:
joost 2012-07-02 11:42:05 +00:00
parent ec67f10680
commit c02351da63
3 changed files with 133 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

54
packages/fcl-db/src/base/bufdataset.pas
View File

@ -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;

23
packages/fcl-db/src/base/xmldatapacketreader.pp
View File

@ -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');

78
packages/fcl-db/tests/testspecifictbufdataset.pas
View File

@ -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}