paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-15 06:29:38 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ Replaced the array-based record-buffer for a linked-list buffer

Browse Source 
git-svn-id: trunk@3111 -
This commit is contained in:
joost 2006-04-01 16:03:41 +00:00
parent 3129dd042e
commit a75c1e5dd3
2 changed files with 189 additions and 348 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

497
fcl/db/bufdataset.inc
View File

@ -18,7 +18,6 @@
---------------------------------------------------------------------} ---------------------------------------------------------------------}
constructor TBufDataset.Create(AOwner : TComponent); constructor TBufDataset.Create(AOwner : TComponent);
begin begin
Inherited Create(AOwner); Inherited Create(AOwner);
SetLength(FUpdateBuffer,0); SetLength(FUpdateBuffer,0);
@ -27,34 +26,28 @@ begin
end; end;
procedure TBufDataset.SetPacketRecords(aValue : integer); procedure TBufDataset.SetPacketRecords(aValue : integer);
begin begin
if aValue > 0 then FPacketRecords := aValue if aValue > 0 then FPacketRecords := aValue
else DatabaseError(SInvPacketRecordsValue); else DatabaseError(SInvPacketRecordsValue);
end; end;
destructor TBufDataset.Destroy; destructor TBufDataset.Destroy;
begin begin
inherited destroy; inherited destroy;
end; end;
Function TBufDataset.GetCanModify: Boolean; Function TBufDataset.GetCanModify: Boolean;
begin begin
Result:= False; Result:= False;
end; end;
function TBufDataset.intAllocRecordBuffer: PChar; function TBufDataset.intAllocRecordBuffer: PChar;
begin begin
// Only the internal buffers of TDataset provide bookmark information // Note: Only the internal buffers of TDataset provide bookmark information
result := AllocMem(FRecordsize); result := AllocMem(FRecordsize+sizeof(TBufRecLinkItem));
result^ := #1; // this 'deletes' the record
end; end;
function TBufDataset.AllocRecordBuffer: PChar; function TBufDataset.AllocRecordBuffer: PChar;
begin begin
result := AllocMem(FRecordsize + sizeof(TBufBookmark)); result := AllocMem(FRecordsize + sizeof(TBufBookmark));
result^ := #1; // this 'deletes' the record result^ := #1; // this 'deletes' the record
@ -70,44 +63,44 @@ procedure TBufDataset.InternalOpen;
begin begin
CalcRecordSize; CalcRecordSize;
FBRecordcount := 0; // FBRecordcount := 0;
FBDeletedRecords := 0; // FBDeletedRecords := 0;
FBBuffercount := 0;
FBCurrentrecord := -1; FFirstRecBuf := pointer(IntAllocRecordBuffer);
FLastRecBuf := FFirstRecBuf;
FCurrentRecBuf := FLastRecBuf;
FOpen:=True; FOpen:=True;
FIsEOF := false;
FIsbOF := true;
end; end;
procedure TBufDataset.InternalClose; procedure TBufDataset.InternalClose;
var i : integer; var pc : pchar;
begin begin
FOpen:=False; FOpen:=False;
CancelUpdates; CancelUpdates;
for i := 0 to FBRecordCount-1 do FreeRecordBuffer(FBBuffers[i]); FCurrentRecBuf := FFirstRecBuf;
If FBBufferCount > 0 then ReAllocMem(FBBuffers,0); while assigned(FCurrentRecBuf) do
FBRecordcount := 0; begin
FBBuffercount := 0; pc := pointer(FCurrentRecBuf);
FCurrentRecBuf := FCurrentRecBuf^.next;
FreeRecordBuffer(pc);
end;
SetLength(FFieldBufPositions,0); SetLength(FFieldBufPositions,0);
FBCurrentrecord := -1;
FIsEOF := true;
FIsbOF := true;
end; end;
procedure TBufDataset.InternalFirst; procedure TBufDataset.InternalFirst;
begin begin
FBCurrentRecord := -1; FCurrentRecBuf := FFirstRecBuf;
FIsEOF := false;
end; end;
procedure TBufDataset.InternalLast; procedure TBufDataset.InternalLast;
begin begin
repeat repeat
until getnextpacket < FPacketRecords; until getnextpacket < FPacketRecords;
FIsBOF := false; if FLastRecBuf <> FFirstRecBuf then
FBCurrentRecord := FBRecordcount; FCurrentRecBuf := FLastRecBuf;
end; end;
procedure unSetDeleted(NullMask : pbyte); //inline; procedure unSetDeleted(NullMask : pbyte); //inline;
@ -145,140 +138,82 @@ end;
function TBufDataset.GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult; function TBufDataset.GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult;
var x : longint;
RecUpdBuf : PRecUpdateBuffer;
FieldUpdBuf : PFieldUpdateBuffer;
NullMask : pbyte;
begin begin
Result := grOK; Result := grOK;
case GetMode of case GetMode of
gmPrior : gmPrior :
if FIsBOF then if not assigned(PBufRecLinkItem(FCurrentRecBuf)^.prior) then
result := grBOF
else if FBCurrentRecord <= 0 then
begin begin
Result := grBOF; Result := grBOF;
FBCurrentRecord := -1;
end end
else else
begin begin
Dec(FBCurrentRecord); FCurrentRecBuf := PBufRecLinkItem(FCurrentRecBuf)^.prior;
FIsEof := false;
end; end;
gmCurrent : gmCurrent :
if (FBCurrentRecord < 0) or (FBCurrentRecord >= FBRecordCount) then if FCurrentRecBuf = FLastRecBuf then
Result := grError; Result := grError;
gmNext : gmNext :
if FIsEOF then if FCurrentRecBuf = FLastRecBuf then // Dataset is empty (just opened)
result := grEOF begin
else if FBCurrentRecord >= (FBRecordCount - 1) then if getnextpacket = 0 then result := grEOF;
end
else if (PBufRecLinkItem(FCurrentRecBuf)^.next = FLastRecBuf) then
begin begin
if getnextpacket > 0 then if getnextpacket > 0 then
begin begin
Inc(FBCurrentRecord); FCurrentRecBuf := PBufRecLinkItem(FCurrentRecBuf)^.next;
FIsBof := false;
end end
else else
begin begin
FIsEOF := true;
result:=grEOF; result:=grEOF;
end end
end end
else else
begin begin
Inc(FBCurrentRecord); FCurrentRecBuf := PBufRecLinkItem(FCurrentRecBuf)^.next;
FIsBof := false;
end; end;
end; end;
if Result = grOK then if Result = grOK then
begin begin
if GetDeleted(pbyte(FBBuffers[FBCurrentRecord])) then
begin
if getmode = gmCurrent then
if DoCheck then
begin
Result := grError;
DatabaseError(SDeletedRecord);
exit;
end
else
getmode := gmnext;
Result := GetRecord(Buffer,getmode,DoCheck);
exit
end;
with PBufBookmark(Buffer + RecordSize)^ do with PBufBookmark(Buffer + RecordSize)^ do
begin begin
BookmarkData := FBCurrentRecord; BookmarkData := FCurrentRecBuf;
BookmarkFlag := bfCurrent; BookmarkFlag := bfCurrent;
end; end;
move(FBBuffers[FBCurrentRecord]^,buffer^,RecordSize); move((pointer(FCurrentRecBuf)+sizeof(TBufRecLinkItem))^,buffer^,RecordSize);
// Cached Updates:
If GetRecordUpdateBuffer(FBCurrentRecord,RecUpdBuf) then
begin
NullMask := pbyte(buffer);
inc(buffer,FNullmaskSize);
for x := 0 to FieldDefs.count-1 do
begin
if GetFieldUpdateBuffer(x,RecUpdBuf,FieldUpdBuf) then
If not FieldUpdBuf^.IsNull then
begin
unSetFieldIsNull(NullMask,x);
move(FieldUpdBuf^.NewValue^,buffer^,GetFieldSize(FieldDefs[x]));
end
else
SetFieldIsNull(NullMask,x);
Inc(Buffer, GetFieldSize(FieldDefs[x]));
end;
end;
end end
else if (Result = grError) and doCheck then else if (Result = grError) and doCheck then
DatabaseError('No record'); DatabaseError('No record');
end; end;
function TBufDataset.GetRecordUpdateBuffer(rno : integer;var RecUpdBuf : PRecUpdateBuffer) : boolean; function TBufDataset.GetRecordUpdateBuffer : boolean;
var r : integer; var x : integer;
CurrBuff : PChar;
begin begin
Result := False; GetBookmarkData(ActiveBuffer,@CurrBuff);
for r := 0 to high(FUpdateBuffer) do if (FCurrentUpdateBuffer >= length(FUpdateBuffer)) or (FUpdateBuffer[FCurrentUpdateBuffer].BookmarkData <> CurrBuff) then
if (FUpdateBuffer[r].RecordNo = rno) and (@FUpdateBuffer[r] <> FEditBuf) then // Neglect the edit-buffer for x := 0 to high(FUpdateBuffer) do
if FUpdateBuffer[x].BookmarkData = CurrBuff then
begin begin
RecUpdBuf := @FUpdateBuffer[r]; FCurrentUpdateBuffer := x;
Result := True; break;
Break;
end;
end;
function TBufDataset.GetFieldUpdateBuffer(fieldno : integer;RecUpdBuf : PRecUpdateBuffer;var FieldUpdBuf : pFieldUpdateBuffer) : boolean;
var f : integer;
begin
Result := False;
for f := 0 to High(RecUpdBuf^.FieldsUpdateBuffer) do
if RecUpdBuf^.FieldsUpdateBuffer[f].FieldNo = fieldno then
begin
FieldUpdBuf := @RecUpdBuf^.FieldsUpdateBuffer[f];
Result := True;
Break;
end; end;
Result := (FCurrentUpdateBuffer < length(FUpdateBuffer)) and (FUpdateBuffer[FCurrentUpdateBuffer].BookmarkData = CurrBuff);
end; end;
procedure TBufDataset.InternalSetToRecord(Buffer: PChar); procedure TBufDataset.InternalSetToRecord(Buffer: PChar);
begin begin
FBCurrentRecord := PBufBookmark(Buffer + RecordSize)^.BookmarkData; FCurrentRecBuf := PBufBookmark(Buffer + RecordSize)^.BookmarkData;
FIsEOF := False;
FIsBOF := False;
end; end;
procedure TBufDataset.SetBookmarkData(Buffer: PChar; Data: Pointer); procedure TBufDataset.SetBookmarkData(Buffer: PChar; Data: Pointer);
begin begin
PBufBookmark(Buffer + RecordSize)^.BookmarkData := PInteger(Data)^; PBufBookmark(Buffer + RecordSize)^.BookmarkData := pointer(Data^);
end; end;
procedure TBufDataset.SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); procedure TBufDataset.SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag);
@ -288,7 +223,7 @@ end;
procedure TBufDataset.GetBookmarkData(Buffer: PChar; Data: Pointer); procedure TBufDataset.GetBookmarkData(Buffer: PChar; Data: Pointer);
begin begin
PInteger(Data)^ := PBufBookmark(Buffer + RecordSize)^.BookmarkData; pointer(Data^) := PBufBookmark(Buffer + RecordSize)^.BookmarkData;
end; end;
function TBufDataset.GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; function TBufDataset.GetBookmarkFlag(Buffer: PChar): TBookmarkFlag;
@ -298,35 +233,23 @@ end;
procedure TBufDataset.InternalGotoBookmark(ABookmark: Pointer); procedure TBufDataset.InternalGotoBookmark(ABookmark: Pointer);
begin begin
FBCurrentRecord := Plongint(ABookmark)^; FCurrentRecBuf := ABookmark;
FIsEOF := False;
FIsBOF := False;
end; end;
function TBufDataset.getnextpacket : integer; function TBufDataset.getnextpacket : integer;
var i : integer; var i : integer;
b : boolean; pb : pchar;
begin begin
i := 0; for i := 0 to FPacketRecords-1 do
if FBBufferCount < FBRecordCount+FPacketRecords then
begin begin
FBBufferCount := FBBuffercount + FPacketRecords; pb := pchar(pointer(FLastRecBuf)+sizeof(TBufRecLinkItem));
ReAllocMem(FBBuffers,FBBuffercount*SizeOf(PChar)); if (loadbuffer(pb)<>grOk) then break;
PBufRecLinkItem(FLastRecBuf)^.next := pointer(IntAllocRecordBuffer);
PBufRecLinkItem(PBufRecLinkItem(FLastRecBuf)^.next)^.prior := FLastRecBuf;
FLastRecBuf := PBufRecLinkItem(FLastRecBuf)^.next;
end; end;
repeat
FBBuffers[FBRecordCount+i] := intAllocRecordBuffer;
b := (loadbuffer(FBBuffers[FBRecordCount+i])<>grOk);
inc(i);
until (i = FPacketRecords) or b;
if b then
begin
dec(i);
FreeRecordBuffer(FBBuffers[FBRecordCount+i]);
end;
FBRecordCount := FBRecordCount + i;
result := i; result := i;
end; end;
@ -364,14 +287,12 @@ begin
NullMask := pointer(buffer); NullMask := pointer(buffer);
fillchar(Nullmask^,FNullmaskSize,0); fillchar(Nullmask^,FNullmaskSize,0);
inc(buffer,FNullmaskSize); inc(buffer,FNullmaskSize);
for x := 0 to FieldDefs.count-1 do for x := 0 to FieldDefs.count-1 do
begin begin
if not LoadField(FieldDefs[x],buffer) then if not LoadField(FieldDefs[x],buffer) then
SetFieldIsNull(NullMask,x); SetFieldIsNull(NullMask,x);
inc(buffer,GetFieldSize(FieldDefs[x])); inc(buffer,GetFieldSize(FieldDefs[x]));
end; end;
Result := grOK; Result := grOK;
@ -385,9 +306,7 @@ end;
function TBufDataset.GetFieldData(Field: TField; Buffer: Pointer): Boolean; function TBufDataset.GetFieldData(Field: TField; Buffer: Pointer): Boolean;
var var CurrBuff : pchar;
x : longint;
CurrBuff : pchar;
begin begin
Result := False; Result := False;
@ -395,10 +314,13 @@ begin
begin begin
if state = dsOldValue then if state = dsOldValue then
begin begin
if FApplyingUpdates then if not GetRecordUpdateBuffer then
CurrBuff := FBBuffers[fbcurrentrecord] // This makes it possible for ApplyUpdates to get values from deleted records begin
else // There is no old value available
CurrBuff := FBBuffers[GetRecNo]; result := false;
exit;
end;
currbuff := FUpdateBuffer[FCurrentUpdateBuffer].OldValuesBuffer+sizeof(TBufRecLinkItem);
end end
else else
begin begin
@ -429,11 +351,9 @@ begin
end; end;
procedure TBufDataset.SetFieldData(Field: TField; Buffer: Pointer); procedure TBufDataset.SetFieldData(Field: TField; Buffer: Pointer);
var
x : longint; var CurrBuff : pointer;
CurrBuff : pointer; NullMask : pbyte;
NullMask : pbyte;
FieldUpdBuf : PFieldUpdateBuffer;
begin begin
if not (state in [dsEdit, dsInsert]) then if not (state in [dsEdit, dsInsert]) then
@ -446,122 +366,50 @@ begin
CurrBuff := ActiveBuffer; CurrBuff := ActiveBuffer;
NullMask := CurrBuff; NullMask := CurrBuff;
inc(Currbuff,FNullmaskSize); inc(CurrBuff,FFieldBufPositions[Field.FieldNo-1]);
if assigned(buffer) then
for x := 0 to FieldDefs.count-1 do
begin begin
if (Field.FieldName = FieldDefs[x].Name) then Move(Buffer^, CurrBuff^, GetFieldSize(FieldDefs[Field.FieldNo-1]));
begin unSetFieldIsNull(NullMask,Field.FieldNo-1);
if assigned(buffer) then end
begin else
Move(Buffer^, CurrBuff^, GetFieldSize(FieldDefs[x])); SetFieldIsNull(NullMask,Field.FieldNo-1);
unSetFieldIsNull(NullMask,x);
end
else
SetFieldIsNull(NullMask,x);
// cached updates
with FEditBuf^ do
begin
if not GetFieldUpdateBuffer(x,FEditBuf,FieldUpdBuf) then
begin
SetLength(FieldsUpdateBuffer,length(FieldsUpdateBuffer)+1);
FieldUpdBuf := @FieldsUpdateBuffer[high(FieldsUpdateBuffer)];
GetMem(FieldUpdBuf^.NewValue,GetFieldSize(FieldDefs[x]));
FieldUpdBuf^.FieldNo := x;
end;
if assigned(buffer) then
begin
Move(Buffer^, FieldUpdBuf^.NewValue^, GetFieldSize(FieldDefs[x]));
FieldUpdBuf^.IsNull := False;
end
else FieldUpdBuf^.IsNull := True;
end;
Break;
end
else Inc(CurrBuff, GetFieldSize(FieldDefs[x]));
end;
if not (State in [dsCalcFields, dsFilter, dsNewValue]) then if not (State in [dsCalcFields, dsFilter, dsNewValue]) then
DataEvent(deFieldChange, Ptrint(Field)); DataEvent(deFieldChange, Ptrint(Field));
end; end;
end; end;
procedure TBufDataset.InternalEdit;
begin
if not GetRecordUpdateBuffer(recno,FEditBuf) then
begin
If not assigned(FEditBuf) then
begin
SetLength(FUpdateBuffer,length(FUpdateBuffer)+1);
FEditBuf := @FUpdateBuffer[high(FUpdateBuffer)];
end;
FEditBuf^.UpdateKind := ukModify;
FEditBuf^.RecordNo := getrecno;
end;
end;
procedure TBufDataset.InternalInsert;
begin
if FBRecordCount > FBBufferCount-1 then
begin
inc(FBBufferCount);
ReAllocMem(FBBuffers,FBBuffercount*SizeOf(PChar));
end;
inc(FBRecordCount);
FBCurrentRecord := FBRecordCount -1;
FBBuffers[FBCurrentRecord] := intAllocRecordBuffer;
fillchar(FBBuffers[FBCurrentRecord]^,FNullmaskSize,255);
unSetDeleted(pbyte(FBBuffers[FBCurrentRecord]));
fillchar(ActiveBuffer^,FNullmaskSize,255);
unSetDeleted(pbyte(ActiveBuffer));
// cached updates:
If not assigned(FEditBuf) then
begin
SetLength(FUpdateBuffer,length(FUpdateBuffer)+1);
FEditBuf := @FUpdateBuffer[high(FUpdateBuffer)];
end;
FEditBuf^.RecordNo := FBCurrentRecord;
FEditBuf^.UpdateKind := ukInsert;
with PBufBookmark(ActiveBuffer + RecordSize)^ do
begin
BookmarkData := FBCurrentRecord;
BookmarkFlag := bfInserted;
end;
end;
procedure TBufDataset.InternalDelete; procedure TBufDataset.InternalDelete;
var tel : integer; var RecToDelete : PBufRecLinkItem;
begin begin
SetDeleted(pbyte(FBBuffers[FBCurrentRecord])); GetBookmarkData(ActiveBuffer,@RecToDelete);
SetDeleted(pbyte(ActiveBuffer)); SetDeleted(pbyte(ActiveBuffer));
inc(FBDeletedRecords);
if GetRecordUpdateBuffer(recno,FEditBuf) and (FEditBuf^.UpdateKind = ukInsert) then if RecToDelete <> FFirstRecBuf then RecToDelete^.prior^.next := RecToDelete^.next
else FFirstRecBuf := RecToDelete^.next;
RecToDelete^.next^.prior := RecToDelete^.prior;
FCurrentRecBuf := RecToDelete^.next;
if not GetRecordUpdateBuffer then
begin begin
if assigned(FEditBuf^.FieldsUpdateBuffer) then FCurrentUpdateBuffer := length(FUpdateBuffer);
for tel := 0 to high(FEditBuf^.FieldsUpdateBuffer) do SetLength(FUpdateBuffer,FCurrentUpdateBuffer+1);
if not FEditBuf^.FieldsUpdateBuffer[tel].IsNull then
freemem(FEditBuf^.FieldsUpdateBuffer[tel].NewValue); FUpdateBuffer[FCurrentUpdateBuffer].OldValuesBuffer := pchar(RecToDelete);
setlength(FEditBuf^.FieldsUpdateBuffer,0); FUpdateBuffer[FCurrentUpdateBuffer].BookmarkData := RecToDelete;
FEditBuf^.RecordNo := -1;
end end
else else
begin begin
If not assigned(FEditBuf) then FUpdateBuffer[FCurrentUpdateBuffer].BookmarkData := FUpdateBuffer[FCurrentUpdateBuffer].OldValuesBuffer;
begin FreeRecordBuffer(pchar(RecToDelete));
SetLength(FUpdateBuffer,length(FUpdateBuffer)+1);
FEditBuf := @FUpdateBuffer[high(FUpdateBuffer)];
end;
FEditBuf^.RecordNo := FBCurrentRecord;
FEditBuf^.UpdateKind := ukDelete;
end; end;
FEditBuf := nil;
FUpdateBuffer[FCurrentUpdateBuffer].UpdateKind := ukDelete;
end; end;
@ -573,10 +421,9 @@ end;
procedure TBufDataset.CancelUpdates; procedure TBufDataset.CancelUpdates;
var r,f : integer;
begin begin
for r := 0 to high(FUpdateBuffer) do // To be implemented
{ for r := 0 to high(FUpdateBuffer) do
begin begin
if FUpdateBuffer[r].RecordNo > -1 then if FUpdateBuffer[r].RecordNo > -1 then
if FUpdateBuffer[r].UpdateKind = ukDelete then if FUpdateBuffer[r].UpdateKind = ukDelete then
@ -594,72 +441,46 @@ begin
end; end;
SetLength(FUpdateBuffer,0); SetLength(FUpdateBuffer,0);
if FOpen then Resync([]); if FOpen then Resync([]);}
end; end;
procedure TBufDataset.ApplyUpdates; procedure TBufDataset.ApplyUpdates;
var SaveBookmark : Integer; var SaveBookmark : pchar;
r,i : Integer; r : Integer;
buffer : PChar; FailedCount : integer;
x : integer;
FieldUpdBuf : PFieldUpdateBuffer;
NullMask : pbyte;
begin begin
CheckBrowseMode; CheckBrowseMode;
// There is no bookmark available if the dataset is empty // There is no bookmark available if the dataset is empty
if not IsEmpty then if not IsEmpty then
SaveBookMark := GetRecNo; GetBookmarkData(ActiveBuffer,@SaveBookmark);
r := 0; r := 0;
FailedCount := 0;
while r < Length(FUpdateBuffer) do while r < Length(FUpdateBuffer) do
begin begin
if (@FUpdateBuffer[r] <> FEditBuf) and // Neglect edit-buffer if assigned(FUpdateBuffer[r].BookmarkData) then
(FUpdateBuffer[r].RecordNo <> -1) then // And the 'deleted' buffers
begin begin
FApplyingUpdates := true; InternalGotoBookmark(FUpdateBuffer[r].BookmarkData);
if FUpdateBuffer[r].UpdateKind = ukDelete then Resync([rmExact,rmCenter]);
InternalGotoBookmark(@(FUpdateBuffer[r].RecordNo))
else
begin
InternalGotoBookMark(@FUpdateBuffer[r].RecordNo);
Resync([rmExact,rmCenter]);
end;
if ApplyRecUpdate(FUpdateBuffer[r].UpdateKind) then if ApplyRecUpdate(FUpdateBuffer[r].UpdateKind) then
begin begin
buffer := FBBuffers[FUpdateBuffer[r].RecordNo]; FreeRecordBuffer(FUpdateBuffer[r].OldValuesBuffer);
NullMask := pbyte(buffer); FUpdateBuffer[r].BookmarkData := nil;
end
inc(buffer,FNullmaskSize); else
Inc(FailedCount);
for x := 0 to FieldDefs.count-1 do
begin
if GetFieldUpdateBuffer(x,@FUpdateBuffer[r],FieldUpdBuf) then
If not FieldUpdBuf^.IsNull then
begin
unSetFieldIsNull(NullMask,x);
move(FieldUpdBuf^.NewValue^,buffer^,GetFieldSize(FieldDefs[x]));
FreeMem(FieldUpdBuf^.NewValue);
end
else
SetFieldIsNull(NullMask,x);
Inc(Buffer, GetFieldSize(FieldDefs[x]));
end;
for i := r to high(FUpdateBuffer)-1 do
FUpdateBuffer[i] := FupdateBuffer[i+1];
dec(r);
SetLength(FUpdateBuffer,high(FUpdateBuffer));
end;
FApplyingUpdates := False;
end; end;
inc(r); inc(r);
end; end;
if failedcount = 0 then
SetLength(FUpdateBuffer,0);
if not IsEmpty then if not IsEmpty then
begin begin
InternalGotoBookMark(@SaveBookMark); InternalGotoBookMark(SaveBookMark);
Resync([rmExact,rmCenter]); Resync([rmExact,rmCenter]);
end end
else else
@ -668,38 +489,67 @@ end;
procedure TBufDataset.InternalPost; procedure TBufDataset.InternalPost;
begin Var tmpRecBuffer : PBufRecLinkItem;
if state in [dsEdit, dsInsert] then CurrBuff : PChar;
begin
if Length(FUpdateBuffer[High(FUpdateBuffer)].FieldsUpdateBuffer) > 0 then
FEditBuf := nil;
end;
end;
procedure TBufDataset.InternalCancel;
var tel : integer;
begin begin
if state in [dsEdit, dsInsert] then if state = dsInsert then
begin begin
if state = dsInsert then if GetBookmarkFlag(ActiveBuffer) = bfEOF then
// Append
FCurrentRecBuf := FLastRecBuf
else
// 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
GetBookmarkData(ActiveBuffer,@FCurrentRecBuf);
// Create the new record buffer
tmpRecBuffer := FCurrentRecBuf^.prior;
FCurrentRecBuf^.prior := pointer(IntAllocRecordBuffer);
FCurrentRecBuf^.prior^.next := FCurrentRecBuf;
FCurrentRecBuf := FCurrentRecBuf^.prior;
If assigned(tmpRecBuffer) then // if not, it's the first record
begin begin
SetDeleted(pbyte(FBBuffers[FBCurrentRecord])); FCurrentRecBuf^.prior := tmpRecBuffer;
SetDeleted(pbyte(ActiveBuffer)); tmpRecBuffer^.next := FCurrentRecBuf
inc(FBDeletedRecords); end
else
FFirstRecBuf := FCurrentRecBuf;
// Link the newly created record buffer to the newly created TDataset record
with PBufBookmark(ActiveBuffer + RecordSize)^ do
begin
BookmarkData := FCurrentRecBuf;
BookmarkFlag := bfInserted;
end; end;
FEditBuf^.RecordNo := -1; end
else
GetBookmarkData(ActiveBuffer,@FCurrentRecBuf);
// clear the fieldbuffers if not GetRecordUpdateBuffer then
if assigned(FEditBuf^.FieldsUpdateBuffer) then begin
for tel := 0 to high(FEditBuf^.FieldsUpdateBuffer) do FCurrentUpdateBuffer := length(FUpdateBuffer);
if not FEditBuf^.FieldsUpdateBuffer[tel].IsNull then SetLength(FUpdateBuffer,FCurrentUpdateBuffer+1);
freemem(FEditBuf^.FieldsUpdateBuffer[tel].NewValue);
setlength(FEditBuf^.FieldsUpdateBuffer,0); FUpdateBuffer[FCurrentUpdateBuffer].BookmarkData := FCurrentRecBuf;
if state = dsEdit then
begin
// Update the oldvalues-buffer
FUpdateBuffer[FCurrentUpdateBuffer].OldValuesBuffer := intAllocRecordBuffer;
move(FCurrentRecBuf^,FUpdateBuffer[FCurrentUpdateBuffer].OldValuesBuffer^,RecordSize+sizeof(TBufRecLinkItem));
FUpdateBuffer[FCurrentUpdateBuffer].UpdateKind := ukModify;
end
else
FUpdateBuffer[FCurrentUpdateBuffer].UpdateKind := ukInsert;
end; end;
end;
CurrBuff := pchar(FCurrentRecBuf);
inc(Currbuff,sizeof(TBufRecLinkItem));
move(ActiveBuffer^,CurrBuff^,RecordSize);
end;
procedure TBufDataset.CalcRecordSize; procedure TBufDataset.CalcRecordSize;
@ -723,8 +573,12 @@ begin
end; end;
procedure TBufDataset.InternalInitRecord(Buffer: PChar); procedure TBufDataset.InternalInitRecord(Buffer: PChar);
begin begin
FillChar(Buffer^, FRecordSize, #0); FillChar(Buffer^, FRecordSize, #0);
fillchar(Buffer^,FNullmaskSize,255);
unSetDeleted(pbyte(Buffer));
end; end;
procedure TBufDataset.SetRecNo(Value: Longint); procedure TBufDataset.SetRecNo(Value: Longint);
@ -736,7 +590,7 @@ end;
function TBufDataset.GetRecNo: Longint; function TBufDataset.GetRecNo: Longint;
begin begin
GetBookmarkData(ActiveBuffer,@Result); // GetBookmarkData(ActiveBuffer,@Result);
end; end;
function TBufDataset.IsCursorOpen: Boolean; function TBufDataset.IsCursorOpen: Boolean;
@ -748,7 +602,7 @@ end;
Function TBufDataset.GetRecordCount: Longint; Function TBufDataset.GetRecordCount: Longint;
begin begin
Result := FBRecordCount-FBDeletedRecords; // Result := FBRecordCount-FBDeletedRecords;
end; end;
Function TBufDataset.Locate(const KeyFields: string; const KeyValues: Variant; options: TLocateOptions) : boolean; Function TBufDataset.Locate(const KeyFields: string; const KeyValues: Variant; options: TLocateOptions) : boolean;
@ -768,7 +622,7 @@ var keyfield : TField; // Field to search in
begin begin
// For now it is only possible to search in one field at the same time // For now it is only possible to search in one field at the same time
result := False; { result := False;
keyfield := FieldByName(keyfields); keyfield := FieldByName(keyfields);
CheckNull := VarIsNull(KeyValues); CheckNull := VarIsNull(KeyValues);
@ -821,12 +675,9 @@ begin
if Result then if Result then
begin begin
bm.BookmarkData := i; // bm.BookmarkData := i;
bm.BookmarkFlag := bfCurrent; bm.BookmarkFlag := bfCurrent;
GotoBookmark(@bm); GotoBookmark(@bm);
end; end;}
end; end;

40
fcl/db/db.pp
View File

@ -1472,50 +1472,43 @@ type
PBufBookmark = ^TBufBookmark; PBufBookmark = ^TBufBookmark;
TBufBookmark = record TBufBookmark = record
BookmarkData : integer; BookmarkData : Pointer;
BookmarkFlag : TBookmarkFlag; BookmarkFlag : TBookmarkFlag;
end; end;
PFieldUpdateBuffer = ^TFieldUpdateBuffer; PBufRecLinkItem = ^TBufRecLinkItem;
TFieldUpdateBuffer = record TBufRecLinkItem = record
FieldNo : integer; prior : PBufRecLinkItem;
NewValue : pointer; next : PBufRecLinkItem;
IsNull : boolean;
end; end;
TFieldsUpdateBuffer = array of TFieldUpdateBuffer;
PRecUpdateBuffer = ^TRecUpdateBuffer; PRecUpdateBuffer = ^TRecUpdateBuffer;
TRecUpdateBuffer = record TRecUpdateBuffer = record
RecordNo : integer;
FieldsUpdateBuffer : TFieldsUpdateBuffer;
UpdateKind : TUpdateKind; UpdateKind : TUpdateKind;
BookmarkData : pointer;
OldValuesBuffer : pchar;
end; end;
TRecordsUpdateBuffer = array of TRecUpdateBuffer; TRecordsUpdateBuffer = array of TRecUpdateBuffer;
TBufDataset = class(TDBDataSet) TBufDataset = class(TDBDataSet)
private private
FBBuffers : TBufferArray; FCurrentRecBuf : PBufRecLinkItem;
FBRecordCount : integer; FLastRecBuf : PBufRecLinkItem;
FBBufferCount : integer; FFirstRecBuf : PBufRecLinkItem;
FBCurrentRecord : integer;
FIsEOF : boolean;
FIsBOF : boolean;
FPacketRecords : integer; FPacketRecords : integer;
FRecordSize : Integer; FRecordSize : Integer;
FNullmaskSize : byte; FNullmaskSize : byte;
FOpen : Boolean; FOpen : Boolean;
FUpdateBuffer : TRecordsUpdateBuffer; FUpdateBuffer : TRecordsUpdateBuffer;
FEditBuf : PRecUpdateBuffer; FCurrentUpdateBuffer : integer;
FApplyingUpdates: boolean;
FBDeletedRecords: integer;
FFieldBufPositions : array of longint; FFieldBufPositions : array of longint;
procedure CalcRecordSize; procedure CalcRecordSize;
function LoadBuffer(Buffer : PChar): TGetResult; function LoadBuffer(Buffer : PChar): TGetResult;
function GetFieldSize(FieldDef : TFieldDef) : longint; function GetFieldSize(FieldDef : TFieldDef) : longint;
function GetRecordUpdateBuffer(rno : integer;var RecUpdBuf : PRecUpdateBuffer) : boolean; function GetRecordUpdateBuffer : boolean;
function GetFieldUpdateBuffer(fieldno : integer;RecUpdBuf : PRecUpdateBuffer;var FieldUpdBuf : pFieldUpdateBuffer) : boolean;
procedure SetPacketRecords(aValue : integer); procedure SetPacketRecords(aValue : integer);
function IntAllocRecordBuffer: PChar; function IntAllocRecordBuffer: PChar;
protected protected
@ -1531,9 +1524,6 @@ type
function getnextpacket : integer; function getnextpacket : integer;
function GetRecordSize: Word; override; function GetRecordSize: Word; override;
procedure InternalPost; override; procedure InternalPost; override;
procedure InternalCancel; override;
procedure InternalEdit; override;
procedure InternalInsert; override;
procedure InternalDelete; override; procedure InternalDelete; override;
procedure InternalFirst; override; procedure InternalFirst; override;
procedure InternalLast; override; procedure InternalLast; override;