Browse Source

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

git-svn-id: trunk@3111 -
joost 19 years ago
parent
commit
a75c1e5dd3
2 changed files with 188 additions and 347 deletions
  1. 173 322
      fcl/db/bufdataset.inc
  2. 15 25
      fcl/db/db.pp

+ 173 - 322
fcl/db/bufdataset.inc

@@ -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
-  result := AllocMem(FRecordsize);
-  result^ := #1; // this 'deletes' the record
+  // Note: Only the internal buffers of TDataset provide bookmark information
+  result := AllocMem(FRecordsize+sizeof(TBufRecLinkItem));
 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;
-  FBDeletedRecords := 0;
-  FBBuffercount := 0;
-  FBCurrentrecord := -1;
+//  FBRecordcount := 0;
+//  FBDeletedRecords := 0;
+
+  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]);
-  If FBBufferCount > 0 then ReAllocMem(FBBuffers,0);
-  FBRecordcount := 0;
-  FBBuffercount := 0;
+  FCurrentRecBuf := FFirstRecBuf;
+  while assigned(FCurrentRecBuf) do
+    begin
+    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;
-  FIsEOF := false;
+  FCurrentRecBuf := FFirstRecBuf;
 end;
 end;
 
 
 procedure TBufDataset.InternalLast;
 procedure TBufDataset.InternalLast;
 begin
 begin
   repeat
   repeat
   until getnextpacket < FPacketRecords;
   until getnextpacket < FPacketRecords;
-  FIsBOF := false;
-  FBCurrentRecord := FBRecordcount;
+  if FLastRecBuf <> FFirstRecBuf then
+    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
-        result := grBOF
-      else if FBCurrentRecord <= 0 then
+      if not assigned(PBufRecLinkItem(FCurrentRecBuf)^.prior) then
         begin
         begin
         Result := grBOF;
         Result := grBOF;
-        FBCurrentRecord := -1;
         end
         end
       else
       else
         begin
         begin
-        Dec(FBCurrentRecord);
-        FIsEof := false;
+        FCurrentRecBuf := PBufRecLinkItem(FCurrentRecBuf)^.prior;
         end;
         end;
     gmCurrent :
     gmCurrent :
-      if (FBCurrentRecord < 0) or (FBCurrentRecord >= FBRecordCount) then
+      if FCurrentRecBuf = FLastRecBuf then
         Result := grError;
         Result := grError;
     gmNext :
     gmNext :
-      if FIsEOF then
-        result := grEOF
-      else if FBCurrentRecord >= (FBRecordCount - 1) then
+      if FCurrentRecBuf = FLastRecBuf then // Dataset is empty (just opened)
+        begin
+        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);
-          FIsBof := false;
+          FCurrentRecBuf := PBufRecLinkItem(FCurrentRecBuf)^.next;
           end
           end
         else
         else
           begin
           begin
-          FIsEOF := true;
           result:=grEOF;
           result:=grEOF;
           end
           end
         end
         end
       else
       else
         begin
         begin
-        Inc(FBCurrentRecord);
-        FIsBof := false;
+        FCurrentRecBuf := PBufRecLinkItem(FCurrentRecBuf)^.next;
         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);
-// 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;
+    move((pointer(FCurrentRecBuf)+sizeof(TBufRecLinkItem))^,buffer^,RecordSize);
     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;
-
-var r : integer;
-
-begin
-  Result := False;
-  for r := 0 to high(FUpdateBuffer) do
-    if (FUpdateBuffer[r].RecordNo = rno) and (@FUpdateBuffer[r] <> FEditBuf) then // Neglect the edit-buffer
-      begin
-      RecUpdBuf := @FUpdateBuffer[r];
-      Result := True;
-      Break;
-      end;
-end;
-
-function TBufDataset.GetFieldUpdateBuffer(fieldno : integer;RecUpdBuf : PRecUpdateBuffer;var FieldUpdBuf : pFieldUpdateBuffer) : boolean;
+function TBufDataset.GetRecordUpdateBuffer : boolean;
 
 
-var f : integer;
+var x : integer;
+    CurrBuff : PChar;
 
 
 begin
 begin
-  Result := False;
-  for f := 0 to High(RecUpdBuf^.FieldsUpdateBuffer) do
-    if RecUpdBuf^.FieldsUpdateBuffer[f].FieldNo = fieldno then
+  GetBookmarkData(ActiveBuffer,@CurrBuff);
+  if (FCurrentUpdateBuffer >= length(FUpdateBuffer)) or (FUpdateBuffer[FCurrentUpdateBuffer].BookmarkData <> CurrBuff) then
+   for x := 0 to high(FUpdateBuffer) do
+    if FUpdateBuffer[x].BookmarkData = CurrBuff then
       begin
       begin
-      FieldUpdBuf := @RecUpdBuf^.FieldsUpdateBuffer[f];
-      Result := True;
-      Break;
+      FCurrentUpdateBuffer := x;
+      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;
-  FIsEOF := False;
-  FIsBOF := False;
+  FCurrentRecBuf := PBufBookmark(Buffer + RecordSize)^.BookmarkData;
 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)^;
-  FIsEOF := False;
-  FIsBOF := False;
+  FCurrentRecBuf := ABookmark;
 end;
 end;
 
 
 function TBufDataset.getnextpacket : integer;
 function TBufDataset.getnextpacket : integer;
 
 
 var i : integer;
 var i : integer;
-    b : boolean;
-
+    pb : pchar;
+    
 begin
 begin
-  i := 0;
-  if FBBufferCount < FBRecordCount+FPacketRecords then
-    begin
-    FBBufferCount := FBBuffercount + FPacketRecords;
-    ReAllocMem(FBBuffers,FBBuffercount*SizeOf(PChar));
-    end;
-
-  repeat
-  FBBuffers[FBRecordCount+i] := intAllocRecordBuffer;
-  b := (loadbuffer(FBBuffers[FBRecordCount+i])<>grOk);
-  inc(i);
-  until (i = FPacketRecords) or b;
-  if b then
+  for i := 0 to FPacketRecords-1 do
     begin
     begin
-    dec(i);
-    FreeRecordBuffer(FBBuffers[FBRecordCount+i]);
+    pb := pchar(pointer(FLastRecBuf)+sizeof(TBufRecLinkItem));
+    if (loadbuffer(pb)<>grOk) then break;
+    PBufRecLinkItem(FLastRecBuf)^.next := pointer(IntAllocRecordBuffer);
+    PBufRecLinkItem(PBufRecLinkItem(FLastRecBuf)^.next)^.prior := FLastRecBuf;
+    FLastRecBuf := PBufRecLinkItem(FLastRecBuf)^.next;
     end;
     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
-  x        : longint;
-  CurrBuff : pchar;
+var 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
-        CurrBuff := FBBuffers[fbcurrentrecord] // This makes it possible for ApplyUpdates to get values from deleted records
-      else
-        CurrBuff := FBBuffers[GetRecNo];
+      if not GetRecordUpdateBuffer then
+        begin
+        // There is no old value available
+        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;
-  CurrBuff : pointer;
-  NullMask : pbyte;
-  FieldUpdBuf : PFieldUpdateBuffer;
+
+var CurrBuff : pointer;
+    NullMask : pbyte;
 
 
 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);
-
-    for x := 0 to FieldDefs.count-1 do
+    inc(CurrBuff,FFieldBufPositions[Field.FieldNo-1]);
+    if assigned(buffer) then
       begin
       begin
-      if (Field.FieldName = FieldDefs[x].Name) then
-        begin
-        if assigned(buffer) then
-          begin
-          Move(Buffer^, CurrBuff^, GetFieldSize(FieldDefs[x]));
-          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;
+      Move(Buffer^, CurrBuff^, GetFieldSize(FieldDefs[Field.FieldNo-1]));
+      unSetFieldIsNull(NullMask,Field.FieldNo-1);
+      end
+    else
+      SetFieldIsNull(NullMask,Field.FieldNo-1);
+      
     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.InternalDelete;
 
 
-procedure TBufDataset.InternalInsert;
+var RecToDelete : PBufRecLinkItem;
 
 
 begin
 begin
-  if FBRecordCount > FBBufferCount-1 then
-    begin
-    inc(FBBufferCount);
-    ReAllocMem(FBBuffers,FBBuffercount*SizeOf(PChar));
-    end;
+  GetBookmarkData(ActiveBuffer,@RecToDelete);
+  SetDeleted(pbyte(ActiveBuffer));
 
 
-  inc(FBRecordCount);
-  FBCurrentRecord := FBRecordCount -1;
-  FBBuffers[FBCurrentRecord] := intAllocRecordBuffer;
-  fillchar(FBBuffers[FBCurrentRecord]^,FNullmaskSize,255);
-  unSetDeleted(pbyte(FBBuffers[FBCurrentRecord]));
-  fillchar(ActiveBuffer^,FNullmaskSize,255);
-  unSetDeleted(pbyte(ActiveBuffer));
+  if RecToDelete <> FFirstRecBuf then RecToDelete^.prior^.next := RecToDelete^.next
+  else FFirstRecBuf := RecToDelete^.next;
 
 
-  // cached updates:
-  If not assigned(FEditBuf) then
-    begin
-    SetLength(FUpdateBuffer,length(FUpdateBuffer)+1);
-    FEditBuf := @FUpdateBuffer[high(FUpdateBuffer)];
-    end;
-  FEditBuf^.RecordNo := FBCurrentRecord;
-  FEditBuf^.UpdateKind := ukInsert;
+  RecToDelete^.next^.prior :=  RecToDelete^.prior;
 
 
-  with PBufBookmark(ActiveBuffer + RecordSize)^ do
+  FCurrentRecBuf := RecToDelete^.next;
+  
+  if not GetRecordUpdateBuffer then
     begin
     begin
-    BookmarkData := FBCurrentRecord;
-    BookmarkFlag := bfInserted;
-    end;
-end;
-
-procedure TBufDataset.InternalDelete;
+    FCurrentUpdateBuffer := length(FUpdateBuffer);
+    SetLength(FUpdateBuffer,FCurrentUpdateBuffer+1);
 
 
-var tel : integer;
-
-begin
-  SetDeleted(pbyte(FBBuffers[FBCurrentRecord]));
-  SetDeleted(pbyte(ActiveBuffer));
-  inc(FBDeletedRecords);
-
-  if GetRecordUpdateBuffer(recno,FEditBuf) and (FEditBuf^.UpdateKind = ukInsert) then
-    begin
-    if assigned(FEditBuf^.FieldsUpdateBuffer) then
-      for tel := 0 to high(FEditBuf^.FieldsUpdateBuffer) do
-        if not FEditBuf^.FieldsUpdateBuffer[tel].IsNull then
-          freemem(FEditBuf^.FieldsUpdateBuffer[tel].NewValue);
-    setlength(FEditBuf^.FieldsUpdateBuffer,0);
-    FEditBuf^.RecordNo := -1;
+    FUpdateBuffer[FCurrentUpdateBuffer].OldValuesBuffer := pchar(RecToDelete);
+    FUpdateBuffer[FCurrentUpdateBuffer].BookmarkData := RecToDelete;
     end
     end
   else
   else
     begin
     begin
-    If not assigned(FEditBuf) then
-      begin
-      SetLength(FUpdateBuffer,length(FUpdateBuffer)+1);
-      FEditBuf := @FUpdateBuffer[high(FUpdateBuffer)];
-      end;
-    FEditBuf^.RecordNo := FBCurrentRecord;
-    FEditBuf^.UpdateKind := ukDelete;
+    FUpdateBuffer[FCurrentUpdateBuffer].BookmarkData := FUpdateBuffer[FCurrentUpdateBuffer].OldValuesBuffer;
+    FreeRecordBuffer(pchar(RecToDelete));
     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;
-    r,i          : Integer;
-    buffer       : PChar;
-    x            : integer;
-    FieldUpdBuf : PFieldUpdateBuffer;
-    NullMask    : pbyte;
+var SaveBookmark : pchar;
+    r            : Integer;
+    FailedCount  : integer;
 
 
 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
-       (FUpdateBuffer[r].RecordNo <> -1) then // And the 'deleted' buffers
+    if assigned(FUpdateBuffer[r].BookmarkData) then
       begin
       begin
-      FApplyingUpdates := true;
-      if FUpdateBuffer[r].UpdateKind = ukDelete then
-        InternalGotoBookmark(@(FUpdateBuffer[r].RecordNo))
-      else
-        begin
-        InternalGotoBookMark(@FUpdateBuffer[r].RecordNo);
-        Resync([rmExact,rmCenter]);
-        end;
+      InternalGotoBookmark(FUpdateBuffer[r].BookmarkData);
+      Resync([rmExact,rmCenter]);
       if ApplyRecUpdate(FUpdateBuffer[r].UpdateKind) then
       if ApplyRecUpdate(FUpdateBuffer[r].UpdateKind) then
         begin
         begin
-        buffer := FBBuffers[FUpdateBuffer[r].RecordNo];
-        NullMask := pbyte(buffer);
-
-        inc(buffer,FNullmaskSize);
-
-        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;
+        FreeRecordBuffer(FUpdateBuffer[r].OldValuesBuffer);
+        FUpdateBuffer[r].BookmarkData := nil;
+        end
+      else
+        Inc(FailedCount);
       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;
 
 
+Var tmpRecBuffer : PBufRecLinkItem;
+    CurrBuff     : PChar;
+
 begin
 begin
-  if state in [dsEdit, dsInsert] then
+  if state = dsInsert then
     begin
     begin
-    if Length(FUpdateBuffer[High(FUpdateBuffer)].FieldsUpdateBuffer) > 0 then
-      FEditBuf := nil;
-    end;
-end;
-
-procedure TBufDataset.InternalCancel;
+    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
+      FCurrentRecBuf^.prior := tmpRecBuffer;
+      tmpRecBuffer^.next := FCurrentRecBuf
+      end
+    else
+      FFirstRecBuf := FCurrentRecBuf;
 
 
-var tel : integer;
+    // Link the newly created record buffer to the newly created TDataset record
+    with PBufBookmark(ActiveBuffer + RecordSize)^ do
+      begin
+      BookmarkData := FCurrentRecBuf;
+      BookmarkFlag := bfInserted;
+      end;
+    end
+  else
+    GetBookmarkData(ActiveBuffer,@FCurrentRecBuf);
 
 
-begin
-  if state in [dsEdit, dsInsert] then
+  if not GetRecordUpdateBuffer then
     begin
     begin
-    if state = dsInsert then
+    FCurrentUpdateBuffer := length(FUpdateBuffer);
+    SetLength(FUpdateBuffer,FCurrentUpdateBuffer+1);
+
+    FUpdateBuffer[FCurrentUpdateBuffer].BookmarkData := FCurrentRecBuf;
+
+    if state = dsEdit then
       begin
       begin
-      SetDeleted(pbyte(FBBuffers[FBCurrentRecord]));
-      SetDeleted(pbyte(ActiveBuffer));
-      inc(FBDeletedRecords);
-      end;
-    FEditBuf^.RecordNo := -1;
-
-    // clear the fieldbuffers
-    if assigned(FEditBuf^.FieldsUpdateBuffer) then
-      for tel := 0 to high(FEditBuf^.FieldsUpdateBuffer) do
-        if not FEditBuf^.FieldsUpdateBuffer[tel].IsNull then
-          freemem(FEditBuf^.FieldsUpdateBuffer[tel].NewValue);
-    setlength(FEditBuf^.FieldsUpdateBuffer,0);
+      // 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;
 
 
-
-
-

+ 15 - 25
fcl/db/db.pp

@@ -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;
-  TFieldUpdateBuffer = record
-    FieldNo      : integer;
-    NewValue     : pointer;
-    IsNull       : boolean;
+  
+  PBufRecLinkItem = ^TBufRecLinkItem;
+  TBufRecLinkItem = record
+    prior   : PBufRecLinkItem;
+    next    : PBufRecLinkItem;
   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;
-    FBRecordCount   : integer;
-    FBBufferCount   : integer;
-    FBCurrentRecord : integer;
-    FIsEOF          : boolean;
-    FIsBOF          : boolean;
+    FCurrentRecBuf  : PBufRecLinkItem;
+    FLastRecBuf     : PBufRecLinkItem;
+    FFirstRecBuf    : PBufRecLinkItem;
+
     FPacketRecords  : integer;
     FPacketRecords  : integer;
     FRecordSize     : Integer;
     FRecordSize     : Integer;
     FNullmaskSize   : byte;
     FNullmaskSize   : byte;
     FOpen           : Boolean;
     FOpen           : Boolean;
     FUpdateBuffer   : TRecordsUpdateBuffer;
     FUpdateBuffer   : TRecordsUpdateBuffer;
-    FEditBuf        : PRecUpdateBuffer;
-    FApplyingUpdates: boolean;
-    FBDeletedRecords: integer;
+    FCurrentUpdateBuffer : 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 GetFieldUpdateBuffer(fieldno : integer;RecUpdBuf : PRecUpdateBuffer;var FieldUpdBuf : pFieldUpdateBuffer) : boolean;
+    function GetRecordUpdateBuffer : 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;