Browse Source

+ Rework of buffer management by Joost Van der Sluis

michael 21 years ago
parent
commit
9fad381d29
5 changed files with 224 additions and 291 deletions
  1. 2 3
      fcl/db/Dataset.txt
  2. 206 279
      fcl/db/dataset.inc
  3. 11 8
      fcl/db/db.pp
  4. 5 1
      fcl/db/dbs.inc
  5. BIN
      fcl/db/odbc/testodbc.mdb

+ 2 - 3
fcl/db/Dataset.txt

@@ -13,7 +13,6 @@ General remarks
 
 
 - All fields and descendents implemented.
 - All fields and descendents implemented.
 - No calculated fields.
 - No calculated fields.
-- No Datasource yet. (although DataEvent is implemented in TField)
 - No persistent fields; this must be added later.
 - No persistent fields; this must be added later.
 
 
 
 
@@ -38,7 +37,7 @@ The Buffers
 A buffer contains all the data for 1 record of the dataset, and also
 A buffer contains all the data for 1 record of the dataset, and also
 the bookmark information. (bookmarkinformation is REQUIRED)
 the bookmark information. (bookmarkinformation is REQUIRED)
 
 
-The dataset allocates by default 'DefultBufferCount+1' records(buffers)
+The dataset allocates by default 'DefaultBufferCount+1' records(buffers)
 This constant can be changed, at the beginning of dataset.inc;
 This constant can be changed, at the beginning of dataset.inc;
 if you know you'll be working with big datasets, you can 
 if you know you'll be working with big datasets, you can 
 increase this constant.
 increase this constant.
@@ -49,7 +48,7 @@ The following constants are userd when handling this array:
 FBuffercount : The number of buffers allocated, minus one.
 FBuffercount : The number of buffers allocated, minus one.
 FRecordCount : The number of buffers that is actually filled in.
 FRecordCount : The number of buffers that is actually filled in.
 FActiveBuffer : The index of the active record.
 FActiveBuffer : The index of the active record.
-FCurrentRecord : The current Buffer. Should be phased out.
+FCurrentRecord : The current record in the underlaying dataset.
 
 
 So the following picture follows from this:
 So the following picture follows from this:
 
 

+ 206 - 279
fcl/db/dataset.inc

@@ -56,13 +56,12 @@ begin
   Inherited Destroy;
   Inherited Destroy;
 end;
 end;
 
 
-
+// This procedure must be called when the first record is made/read
 Procedure TDataset.ActivateBuffers;
 Procedure TDataset.ActivateBuffers;
 
 
 begin
 begin
   FBOF:=False;
   FBOF:=False;
   FEOF:=False;
   FEOF:=False;
-  FRecordCount:=1;
   FActiveRecord:=0;
   FActiveRecord:=0;
 end;
 end;
 
 
@@ -74,7 +73,7 @@ end;
 
 
 Procedure TDataset.BindFields(Binding: Boolean);
 Procedure TDataset.BindFields(Binding: Boolean);
 
 
-Var I : longint;
+// Var I : longint;
 
 
 begin
 begin
   {
   {
@@ -313,7 +312,6 @@ end;
 Procedure TDataset.DoInternalOpen;
 Procedure TDataset.DoInternalOpen;
 
 
 begin
 begin
-  FBufferCount:=0;
   FDefaultFields:=FieldCount=0;
   FDefaultFields:=FieldCount=0;
   DoBeforeOpen;
   DoBeforeOpen;
   Try
   Try
@@ -323,20 +321,10 @@ begin
     InternalOpen;
     InternalOpen;
     FBOF:=True;
     FBOF:=True;
 {$ifdef dsdebug}
 {$ifdef dsdebug}
-    Writeln ('Setting buffer size');
-{$endif}
-{$ifdef dsdebug}
-    Writeln ('Setting buffer size');
+    Writeln ('Calling RecalcBufListSize');
 {$endif}
 {$endif}
-    (*
-    SetBufListSize(DefaultBufferCount);
-    {$ifdef dsdebug}
-    Writeln ('Getting next records');
-    {$endif}
-    GetNextRecords;
-    *)
+    FRecordcount := 0;
     RecalcBufListSize;
     RecalcBufListSize;
-    //SetBufferCount(DefaultBufferCount);
 {$ifdef dsdebug}
 {$ifdef dsdebug}
     Writeln ('Setting state to browse');
     Writeln ('Setting state to browse');
 {$endif}
 {$endif}
@@ -350,16 +338,6 @@ begin
   end;
   end;
 end;
 end;
 
 
-Function TDataset.RequiredBuffers : longint;
-{
-  If later some datasource requires more buffers (grids etc)
-  then it should be taken into account here...
-}
-
-begin
-  Result:=0;
-end;
-
 Procedure TDataset.DoInternalClose;
 Procedure TDataset.DoInternalClose;
 
 
 begin
 begin
@@ -431,7 +409,7 @@ end;
 Function TDataset.GetCanModify: Boolean;
 Function TDataset.GetCanModify: Boolean;
 
 
 begin
 begin
-  Result:=True;
+  Result:= not FIsUnidirectional;
 end;
 end;
 
 
 Procedure TDataset.GetChildren(Proc: TGetChildProc; Root: TComponent);
 Procedure TDataset.GetChildren(Proc: TGetChildProc; Root: TComponent);
@@ -514,43 +492,40 @@ begin
   //!! To be implemented
   //!! To be implemented
 end;
 end;
 
 
+
 Function TDataset.GetNextRecord: Boolean;
 Function TDataset.GetNextRecord: Boolean;
 
 
-Var Shifted : Boolean;
+  procedure ExchangeBuffers(var buf1,buf2 : pointer);
+
+  var tempbuf : pointer;
+
+  begin
+    tempbuf := buf1;
+    buf1 := buf2;
+    buf2 := tempbuf;
+  end;
 
 
 begin
 begin
 {$ifdef dsdebug}
 {$ifdef dsdebug}
   Writeln ('Getting next record. Internal RecordCount : ',FRecordCount);
   Writeln ('Getting next record. Internal RecordCount : ',FRecordCount);
-{$endif}
-  Shifted:=FRecordCount=FBufferCount;
-  If Shifted then
-    begin
-    ShiftBuffers(0,1);
-    Dec(FRecordCount);
-    end;
-{$ifdef dsdebug}
-  Writeln ('Getting data into buffer : ',FRecordCount);
 {$endif}
 {$endif}
   If FRecordCount>0 Then SetCurrentRecord(FRecordCount-1);
   If FRecordCount>0 Then SetCurrentRecord(FRecordCount-1);
-  Result:=GetRecord(FBuffers[FRecordCount],gmNext,True)=grOK;
-  If Result then
+  Result:=GetRecord(FBuffers[FBuffercount],gmNext,True)=grOK;
+
+  if result then
     begin
     begin
-    If FRecordCount=0 then
-      ActivateBuffers
-    else
-      If FRecordCount<FBufferCount then
-        Inc(FRecordCount);
-    FCurrentRecord:=FRecordCount - 1;
+      If FRecordCount=0 then ActivateBuffers;
+      if FRecordcount=FBuffercount then
+        shiftbuffersbackward
+      else
+        begin
+          inc(FRecordCount);
+          FCurrentRecord:=FRecordCount - 1;
+          ExchangeBuffers(Fbuffers[FCurrentRecord],FBuffers[FBuffercount]);
+        end;
     end
     end
   else
   else
-    begin
-    if shifted then
-      begin
-      ShiftBuffers(0,-1);
-      inc(FRecordCount);
-      end;
-    CursorPosChanged;
-    end;
+    cursorposchanged;
 {$ifdef dsdebug}
 {$ifdef dsdebug}
   Writeln ('Result getting next record : ',Result);
   Writeln ('Result getting next record : ',Result);
 {$endif}
 {$endif}
@@ -566,44 +541,31 @@ begin
   While (FRecordCount<FBufferCount) and GetNextRecord do
   While (FRecordCount<FBufferCount) and GetNextRecord do
     Inc(Result);
     Inc(Result);
 {$ifdef dsdebug}
 {$ifdef dsdebug}
-  Writeln ('Result Getting next record(s), GOT :',RESULT);
+  Writeln ('Result Getting next record(S), GOT :',RESULT);
 {$endif}
 {$endif}
 end;
 end;
 
 
 Function TDataset.GetPriorRecord: Boolean;
 Function TDataset.GetPriorRecord: Boolean;
 
 
-Var Shifted : boolean;
-
 begin
 begin
 {$ifdef dsdebug}
 {$ifdef dsdebug}
   Writeln ('GetPriorRecord: Getting previous record');
   Writeln ('GetPriorRecord: Getting previous record');
 {$endif}
 {$endif}
-  Shifted:=FRecordCount>0;
-  If Shifted Then
-    begin
-    SetCurrentRecord(0);
-    ShiftBuffers(0,-1);
-    end;
-  Result:=GetRecord(FBuffers[0],gmPrior,True)=grOK;
-  If Result then
+  If FRecordCount>0 Then SetCurrentRecord(0);
+  Result:=GetRecord(FBuffers[FBuffercount],gmPrior,True)=grOK;
+  if result then
     begin
     begin
-    If FRecordCount=0 then
-      ActivateBuffers
-    else
-      begin
-      If FrecordCount<FBufferCount then
-        Inc(FRecordCount);
-      end;
-    FCurrentRecord:=0;
+      If FRecordCount=0 then ActivateBuffers;
+      shiftbuffersforward;
+
+      if FRecordcount<FBuffercount then
+        inc(FRecordCount);
     end
     end
   else
   else
-    begin
-    If Shifted then
-      begin
-      ShiftBuffers(0,1);
-      end;
-    CursorPosChanged;
-    end;
+    cursorposchanged;
+{$ifdef dsdebug}
+  Writeln ('Result getting prior record : ',Result);
+{$endif}
 end;
 end;
 
 
 Function TDataset.GetPriorRecords: Longint;
 Function TDataset.GetPriorRecords: Longint;
@@ -678,10 +640,19 @@ begin
   //!! To be implemented
   //!! To be implemented
 end;
 end;
 
 
+Function TDataset.SetTempState(const Value: TDataSetState): TDataSetState;
+
+begin
+  result := FState;
+  FState := value;
+  inc(FDisableControlsCount);
+end;
+
 Procedure TDataset.RestoreState(const Value: TDataSetState);
 Procedure TDataset.RestoreState(const Value: TDataSetState);
 
 
 begin
 begin
-  //!! To be implemented
+  FState := value;
+  dec(FDisableControlsCount);
 end;
 end;
 
 
 Procedure TDataset.SetActive (Value : Boolean);
 Procedure TDataset.SetActive (Value : Boolean);
@@ -695,37 +666,45 @@ begin
   FActive:=Value;
   FActive:=Value;
 end;
 end;
 
 
-procedure TDataSet.SetBufferCount(const AValue: Longint);
-Var
-  ShiftCount: Integer;
+procedure TDataSet.RecalcBufListSize;
+
+var
+  i, j, ABufferCount: Integer;
+  DataLink: TDataLink;
+
 begin
 begin
 {$ifdef dsdebug}
 {$ifdef dsdebug}
-  Writeln('in SetBufferCount(',AValue,')');
+  Writeln('Recalculating buffer list size - check cursor');
 {$endif}
 {$endif}
-  If (FBufferCount=AValue) Then
-    exit;
-  If AValue<FRecordCount Then
-    Begin
-    If (AValue>0)And(ActiveRecord>AValue-1) Then
+  If Not IsCursorOpen Then
+    Exit;
+{$ifdef dsdebug}
+  Writeln('Recalculating buffer list size');
+{$endif}
+  ABufferCount := DefaultBufferCount;
+  for i := 0 to FDataSources.Count - 1 do
+    for j := 0 to TDataSource(FDataSources[i]).DataLinks.Count - 1 do
       begin
       begin
-      // ActiveRecord Will be pointing to a deleted record
-      // Move Buffers to a safe place and then adjust buffer count
-      ShiftCount:=FActiveRecord - Avalue + 1;
-      ShiftBuffers(0, ShiftCount);
-      FActiveRecord:=AValue-1;
-      End;
-    FRecordCount:=AValue;
-    // Current record Will be pointing to a invalid record
-    // if we are not in BOF or EOF state then make current record point
-    // to the last record in buffer
-    If FCurrentRecord<>-1 Then
-      Begin
-      FCurrentRecord:=FRecordCount - 1;
-      if FCurrentRecord=-1 Then
-        InternalFirst;
-      End;
-    End;
-  SetBufListSize(Avalue);
+      DataLink:=TDataLink(TDataSource(FDataSources[i]).DataLinks[j]);
+      if DataLink.BufferCount>ABufferCount then
+        ABufferCount:=DataLink.BufferCount;
+      end;
+
+  If (FBufferCount=ABufferCount) Then
+    exit;
+
+{$ifdef dsdebug}
+  Writeln('Setting buffer list size');
+{$endif}
+
+  if (ABuffercount<FRecordcount) then
+    begin
+    for i := 0 to (FActiveRecord-ABuffercount) do
+      shiftbuffersbackward;
+    FActiverecord := ABuffercount -1;
+    end;
+
+  SetBufListSize(ABufferCount);
   GetNextRecords;
   GetNextRecords;
 {$Ifdef dsDebug}
 {$Ifdef dsDebug}
   WriteLn(
   WriteLn(
@@ -759,7 +738,7 @@ begin
 {$endif}
 {$endif}
     ReAllocMem(FBuffers,(Value+1)*SizeOf(PChar));
     ReAllocMem(FBuffers,(Value+1)*SizeOf(PChar));
 {$ifdef dsdebug}
 {$ifdef dsdebug}
-    Writeln ('   Filling memory :',(Value-FBufferCount)*SizeOf(PChar));
+    Writeln ('   Filling memory :',(Value+1-FBufferCount)*SizeOf(PChar));
 {$endif}
 {$endif}
     FillChar(FBuffers[FBufferCount],(Value+1-FBufferCount)*SizeOF(Pchar),#0);
     FillChar(FBuffers[FBufferCount],(Value+1-FBufferCount)*SizeOF(Pchar),#0);
 {$ifdef dsdebug}
 {$ifdef dsdebug}
@@ -767,16 +746,16 @@ begin
 {$endif}
 {$endif}
     Try
     Try
 {$ifdef dsdebug}
 {$ifdef dsdebug}
-      Writeln ('   Assigning buffers :',(Value+1)*SizeOf(PChar));
+      Writeln ('   Assigning buffers :',(Value)*SizeOf(PChar));
 {$endif}
 {$endif}
       For I:=FBufferCount to Value do
       For I:=FBufferCount to Value do
         FBuffers[i]:=AllocRecordBuffer;
         FBuffers[i]:=AllocRecordBuffer;
 {$ifdef dsdebug}
 {$ifdef dsdebug}
-      Writeln ('   Assigned buffers ',FBufferCount,' :',(Value+1)*SizeOf(PChar));
+      Writeln ('   Assigned buffers ',FBufferCount,' :',(Value)*SizeOf(PChar));
 {$endif}
 {$endif}
     except
     except
       I:=FBufferCount;
       I:=FBufferCount;
-      While (I<=Value) and (FBuffers[i]<>Nil) do
+      While (I<(Value+1)) and (FBuffers[i]<>Nil) do
         begin
         begin
         FreeRecordBuffer(FBuffers[i]);
         FreeRecordBuffer(FBuffers[i]);
         Inc(i);
         Inc(i);
@@ -797,7 +776,7 @@ begin
       end;
       end;
     end;
     end;
   If Value=-1 then
   If Value=-1 then
-    Value:=0;  
+    Value:=0;
   FBufferCount:=Value;
   FBufferCount:=Value;
 {$ifdef dsdebug}
 {$ifdef dsdebug}
   Writeln ('   SetBufListSize: Final FBufferCount=',FBufferCount);
   Writeln ('   SetBufListSize: Final FBufferCount=',FBufferCount);
@@ -842,13 +821,13 @@ end;
 Procedure TDataset.SetFilterText(const Value: string);
 Procedure TDataset.SetFilterText(const Value: string);
 
 
 begin
 begin
-  //!! To be implemented
+  FFilterText := value;
 end;
 end;
 
 
 Procedure TDataset.SetFiltered(Value: Boolean);
 Procedure TDataset.SetFiltered(Value: Boolean);
 
 
 begin
 begin
-  //!! To be implemented
+  FFiltered := value;
 end;
 end;
 
 
 Procedure TDataset.SetFound(const Value: Boolean);
 Procedure TDataset.SetFound(const Value: Boolean);
@@ -892,12 +871,6 @@ begin
     end;
     end;
 end;
 end;
 
 
-Function TDataset.SetTempState(const Value: TDataSetState): TDataSetState;
-
-begin
-  //!! To be implemented
-end;
-
 Function TDataset.TempBuffer: PChar;
 Function TDataset.TempBuffer: PChar;
 
 
 begin
 begin
@@ -926,7 +899,7 @@ begin
 {$ifdef dsdebug}
 {$ifdef dsdebug}
   Writeln ('Active buffer requested. Returning:',ActiveRecord);
   Writeln ('Active buffer requested. Returning:',ActiveRecord);
 {$endif}
 {$endif}
-  Result:=FBuffers[ActiveRecord];
+  Result:=FBuffers[FActiveRecord];
 end;
 end;
 
 
 Procedure TDataset.Append;
 Procedure TDataset.Append;
@@ -1032,9 +1005,6 @@ begin
     writeln ('Delete: Internaldelete succeeded');
     writeln ('Delete: Internaldelete succeeded');
 {$endif}
 {$endif}
     FreeFieldBuffers;
     FreeFieldBuffers;
-{$ifdef dsdebug}
-    writeln ('Delete: Freeing field buffers');
-{$endif}
     SetState(dsBrowse);
     SetState(dsBrowse);
 {$ifdef dsdebug}
 {$ifdef dsdebug}
     writeln ('Delete: Browse mode set');
     writeln ('Delete: Browse mode set');
@@ -1062,9 +1032,45 @@ end;
 
 
 Procedure TDataset.DoInsertAppend(DoAppend : Boolean);
 Procedure TDataset.DoInsertAppend(DoAppend : Boolean);
 
 
-Var Buffer : PChar;
-    BookBeforeInsert : TBookmarkStr;
 
 
+  procedure DoInsert;
+
+  Var BookBeforeInsert : TBookmarkStr;
+      TempBuf : pointer;
+
+  begin
+  // need to scroll up al buffers after current one,
+  // but copy current bookmark to insert buffer.
+  If FRecordcount > 0 then BookBeforeInsert:=Bookmark;
+
+  if FActiveRecord < FRecordCount-1 then
+    begin
+    TempBuf := FBuffers[FBuffercount];
+    move(FBuffers[FActiveRecord],FBuffers[FActiveRecord+1],(Fbuffercount-FActiveRecord)*sizeof(FBuffers[0]));      FBuffers[FActiveRecord]:=TempBuf;
+    end
+  else
+    inc(FActiveRecord);
+
+  // Active buffer is now edit buffer. Initialize.
+  InitRecord(FBuffers[FActiveRecord]);
+  cursorposchanged;
+
+  // Put bookmark in edit buffer.
+  if FRecordCount=0 then
+    begin
+    fEOF := false;
+    SetBookmarkFlag(ActiveBuffer,bfBOF)
+    end
+  else
+    begin
+    fBOF := false;
+    if FRecordcount > 0 then SetBookMarkData(ActiveBuffer,@BookBeforeInsert);
+    end;
+  // update buffer count.
+  If FRecordCount<FBufferCount then
+    Inc(FRecordCount);
+  end;
+  
 begin
 begin
   If Not CanModify then
   If Not CanModify then
     DatabaseError(SDatasetReadOnly,Self);
     DatabaseError(SDatasetReadOnly,Self);
@@ -1076,45 +1082,25 @@ begin
 {$ifdef dsdebug}
 {$ifdef dsdebug}
     Writeln ('going to insert mode');
     Writeln ('going to insert mode');
 {$endif}
 {$endif}
-    // need to scroll up al buffers after current one,
-    // but copy current bookmark to insert buffer.
-    BookBeforeInsert:=Bookmark;
-    ShiftBuffers(1,FActiveRecord);
-    // Active buffer is now edit buffer. Initialize.
-    InitRecord(ActiveBuffer);
-    // Put bookmark in edit buffer.
-    if FRecordCount=0 then
-      SetBookmarkFlag(ActiveBuffer,bfBOF)
-    else
-      SetBookMarkData(ActiveBuffer,Pointer(BookBeforeInsert));
-    // update buffer count.
-    If FRecordCount<FBufferCount then
-      Inc(FRecordCount);
+
+    DoInsert;
     end
     end
   else
   else
-    // Tricky, need to get last record and scroll down.
     begin
     begin
 {$ifdef dsdebug}
 {$ifdef dsdebug}
     Writeln ('going to append mode');
     Writeln ('going to append mode');
 {$endif}
 {$endif}
-    Buffer:=FBuffers[0];
-    InitRecord(Buffer);
-    // just mark buffer as last. GetPreviousrecords will do an internallast
-    // Because of this...
-    SetBookMarkFlag(Buffer,bfEOF);
-    FRecordCount:=1;
-{$ifdef dsdebug}
-    Writeln ('DoInsertAppend: getting prior records');
-{$endif}
+    ClearBuffers;
+    InternalLast;
     GetPriorRecords;
     GetPriorRecords;
-    // update active record.
-    FactiveRecord:=FRecordCount-1;
+    FActiveRecord:=FRecordCount-1;
+    DoInsert;
+    SetBookmarkFlag(ActiveBuffer,bfEOF)
     end;
     end;
   SetState(dsInsert);
   SetState(dsInsert);
   try
   try
     DoOnNewRecord;
     DoOnNewRecord;
   except
   except
-    UpdateCursorPos;
     resync([]);
     resync([]);
     raise;
     raise;
   end;
   end;
@@ -1137,7 +1123,7 @@ begin
   If State in [dsedit,dsinsert] then exit;
   If State in [dsedit,dsinsert] then exit;
   If FRecordCount = 0 then
   If FRecordCount = 0 then
     begin
     begin
-    Insert;
+    Append;
     Exit;
     Exit;
     end;
     end;
   CheckBrowseMode;
   CheckBrowseMode;
@@ -1391,6 +1377,7 @@ Var
   Function ScrollBackward : Integer;
   Function ScrollBackward : Integer;
 
 
   begin
   begin
+    if FIsUniDirectional then DatabaseError(SUniDirectional);
     Result:=0;
     Result:=0;
 {$ifdef dsdebug}
 {$ifdef dsdebug}
     Writeln('Scrolling backward:',Abs(Distance));
     Writeln('Scrolling backward:',Abs(Distance));
@@ -1432,10 +1419,10 @@ begin
   CheckBrowseMode;
   CheckBrowseMode;
   Result:=0; TheResult:=0;
   Result:=0; TheResult:=0;
   PrevRecordCount:=FRecordCount;
   PrevRecordCount:=FRecordCount;
-  DoBeforeScroll;
   If ((Distance>0) and FEOF) or
   If ((Distance>0) and FEOF) or
      ((Distance<0) and FBOF) then
      ((Distance<0) and FBOF) then
     exit;
     exit;
+  DoBeforeScroll;
   Try
   Try
     If Distance>0 then
     If Distance>0 then
       Scrolled:=ScrollForward
       Scrolled:=ScrollForward
@@ -1445,13 +1432,13 @@ begin
 {$ifdef dsdebug}
 {$ifdef dsdebug}
     WriteLn('ActiveRecord=', FActiveRecord,' FEOF=',FEOF,' FBOF=',FBOF);
     WriteLn('ActiveRecord=', FActiveRecord,' FEOF=',FEOF,' FBOF=',FBOF);
 {$Endif}
 {$Endif}
-     If FRecordCount<>PrevRecordCount then
-       DataEvent(deDatasetChange,0)
-     else
-       DataEvent(deDatasetScroll,Scrolled);
-     DoAfterScroll;
+    If FRecordCount<>PrevRecordCount then
+      DataEvent(deDatasetChange,0)
+    else
+      DataEvent(deDatasetScroll,Scrolled);
+    DoAfterScroll;
+    Result:=TheResult;
   end;
   end;
-  Result:=TheResult;
 end;
 end;
 
 
 Procedure TDataset.Next;
 Procedure TDataset.Next;
@@ -1491,18 +1478,16 @@ begin
     CheckRequired;
     CheckRequired;
     DoBeforePost;
     DoBeforePost;
     If Not TryDoing(@InternalPost,OnPostError) then exit;
     If Not TryDoing(@InternalPost,OnPostError) then exit;
+    cursorposchanged;
 {$ifdef dsdebug}
 {$ifdef dsdebug}
     writeln ('Post: Internalpost succeeded');
     writeln ('Post: Internalpost succeeded');
 {$endif}
 {$endif}
     FreeFieldBuffers;
     FreeFieldBuffers;
-{$ifdef dsdebug}
-    writeln ('Post: Freeing field buffers');
-{$endif}
+    Resync([]);
     SetState(dsBrowse);
     SetState(dsBrowse);
 {$ifdef dsdebug}
 {$ifdef dsdebug}
     writeln ('Post: Browse mode set');
     writeln ('Post: Browse mode set');
 {$endif}
 {$endif}
-    Resync([]);
     DoAfterPost;
     DoAfterPost;
     end;
     end;
 end;
 end;
@@ -1522,33 +1507,6 @@ begin
   Resync([]);
   Resync([]);
 end;
 end;
 
 
-procedure TDataSet.RecalcBufListSize;
-var
-  i, j, MaxValue: Integer;
-  DataLink: TDataLink;
-begin
-{$ifdef dsdebug}
-  Writeln('Recalculating buffer list size - check cursor');
-{$endif}
-  If Not IsCursorOpen Then
-    Exit;
-{$ifdef dsdebug}
-  Writeln('Recalculating buffer list size');
-{$endif}
-  MaxValue := DefaultBufferCount;
-  for i := 0 to FDataSources.Count - 1 do
-    for j := 0 to TDataSource(FDataSources[i]).DataLinks.Count - 1 do
-      begin
-      DataLink:=TDataLink(TDataSource(FDataSources[i]).DataLinks[j]);
-      if DataLink.BufferCount>MaxValue then
-        MaxValue:=DataLink.BufferCount;
-      end;
-{$ifdef dsdebug}
-   Writeln('calling Setbuffercount');
-{$endif}
-  SetBufferCount(MaxValue); //SetBufListSize(MaxValue);
-end;
-
 Procedure TDataset.RegisterDataSource(ADatasource : TDataSource);
 Procedure TDataset.RegisterDataSource(ADatasource : TDataSource);
 
 
 begin
 begin
@@ -1559,66 +1517,56 @@ end;
 
 
 Procedure TDataset.Resync(Mode: TResyncMode);
 Procedure TDataset.Resync(Mode: TResyncMode);
 
 
-Var Count,ShiftCount : Longint;
+var i,count : integer;
 
 
 begin
 begin
   // See if we can find the requested record.
   // See if we can find the requested record.
 {$ifdef dsdebug}
 {$ifdef dsdebug}
     Writeln ('Resync called');
     Writeln ('Resync called');
 {$endif}
 {$endif}
-  If rmExact in Mode then
-    begin
-{$ifdef dsdebug}
-    Writeln ('Exact resync');
-{$endif}
-    { throw an exception if not found.
-      Normally the descendant should do this if DoCheck is true. }
-    If GetRecord(Fbuffers[0],gmcurrent,True)<>grOk Then
-      DatabaseError(SNoSuchRecord,Self);
-    end
-  else
-    { Can we find a record in the neighbourhood ?
-      Use Shortcut evaluation for this, or we'll have some funny results. }
-    If (GetRecord(Fbuffers[0],gmcurrent,True)<>grOk) and
-       (GetRecord(Fbuffers[0],gmprior,True)<>grOk) and
-       (GetRecord(Fbuffers[0],gmNext,True)<>grOk) then
-       begin
-{$ifdef dsdebug}
-       Writeln ('Resync: fuzzy resync');
-{$endif}
-       // nothing found, invalidate buffer and bail out.
-       ClearBuffers;
-       DataEvent(deDatasetChange,0);
-       Exit;
-       end;
+
+// place the cursor of the underlying dataset to the active record
+  SetCurrentRecord(FActiverecord);
+
+// Now look if the data on the current cursor of the underlying dataset is still available
+  If GetRecord(Fbuffers[0],gmcurrent,True)<>grOk Then
+// If that fails and rmExact is set, then raise an exception
+    If rmExact in Mode then
+      DatabaseError(SNoSuchRecord,Self)
+// else, if rmexact is not set, try to fetch the next  or prior record in the underlying dataset
+    else if (GetRecord(Fbuffers[0],gmnext,True)<>grOk) and
+            (GetRecord(Fbuffers[0],gmprior,True)<>grOk) then
+      begin
 {$ifdef dsdebug}
 {$ifdef dsdebug}
-   Writeln ('Resync: Center in  resync: ',(rmCenter in Mode));
+      Writeln ('Resync: fuzzy resync');
 {$endif}
 {$endif}
+      // nothing found, invalidate buffer and bail out.
+      ClearBuffers;
+      DataEvent(deDatasetChange,0);
+      exit;
+      end;
+  FCurrentRecord := 0;
+
+
+// If we've arrived here, FBuffer[0] is the current record
   If (rmCenter in Mode) then
   If (rmCenter in Mode) then
-    ShiftCount:=FbufferCount div 2
+    count := (FRecordCount div 2)
   else
   else
-    // keep current position.
-    ShiftCount:=FActiveRecord;
-  // Reposition on 0
-{$ifdef dsdebug}
-  Writeln ('Resync: activating buffers');
-{$endif}
-  ActivateBuffers;
-  try
-    Count:=0;
-{$ifdef dsdebug}
-    Writeln ('Resync: Getting previous ',ShiftCount,' records');
-{$endif}
-    While (Count<ShiftCount) and GetPriorRecord do
-      Inc(Count);
-    FActiveRecord:=Count;
-    // fill rest of buffers, adjust ActiveBuffer.
-    GetNextRecords;
-    Inc(FActiveRecord,GetPriorRecords);
-  finally
-    // Notify Everyone
-    DataEvent(deDatasetChange,0);
-  end;
+    count := FActiveRecord;
+  i := 0;
+  FRecordcount := 1;
+  FActiveRecord := 0;
+
+// Fill the buffers before the active record
+  while (i < count) and GetPriorRecord do
+    inc(i);
+  FActiveRecord := i;
+// Fill the rest of the buffer
+  getnextrecords;
+// If the buffer is not full yet, try to fetch some more prior records
+  if FRecordcount < FBuffercount then getpriorrecords;
+// That's all folks!
+  DataEvent(deDatasetChange,0);
 end;
 end;
 
 
 Procedure TDataset.SetFields(const Values: array of const);
 Procedure TDataset.SetFields(const Values: array of const);
@@ -1707,48 +1655,24 @@ begin
   Result:=FFieldList.Count;
   Result:=FFieldList.Count;
 end;
 end;
 
 
-Procedure TDataset.ShiftBuffers (Offset, Distance : longint);
+Procedure TDataset.ShiftBuffersBackward;
 
 
-Var Temp : Pointer;
-    MoveSize : Longint;
+var TempBuf : pointer;
 
 
-  Procedure ShiftBuffersUp;
-  begin
-{$ifdef DSDEBUG}
-    writeln ('Shifting buffers up from ',OffSet,' with distance :',Distance);
-    writeln ('Moving ',(FBufferCount-Distance), ' Buffers at ',Distance);
-{$endif}
-    Move(FBuffers[Offset],Temp^,MoveSize);
-    Move(FBuffers[Offset+Distance],FBuffers[Offset],(FBufferCount-Distance-Offset)*SizeOf(Pchar));
-    Move(Temp^,FBuffers[FBufferCount-Distance-Offset],MoveSize);
-  end;
+begin
+  TempBuf := FBuffers[0];
+  move(FBuffers[1],FBuffers[0],(fbuffercount)*sizeof(FBuffers[0]));
+  FBuffers[buffercount]:=TempBuf;
+end;
 
 
-  Procedure ShiftBuffersDown;
+Procedure TDataset.ShiftBuffersForward;
 
 
-  begin
-    // Distance is NEGATIVE
-{$ifdef DSDEBUG}
-    writeln ('Shifting buffers down with distance :',Abs(Distance));
-    writeln ('Moving ',Movesize div 4,' Buffers at ',FBufferCount+Distance);
-{$endif}
-    Move(FBuffers[FbufferCount+Distance],Temp^ ,MoveSize);
-    Move(FBuffers[0],FBuffers[Abs(Distance)],(FBufferCount+Distance)*SizeOf(Pchar));
-    Move(Temp^ ,FBuffers[0],MoveSize);
-  end;
+var TempBuf : pointer;
 
 
 begin
 begin
-  If Abs(Distance)>=BufferCount then
-    Exit;
-  try
-    MoveSize:=SizeOf(Pchar)*Abs(Distance);
-    GetMem(Temp,MoveSize);
-    If Distance<0 Then
-      ShiftBuffersDown
-    else If Distance>0 then
-      ShiftBuffersUp;
-  Finally
-    FreeMem(temp);
-  end;
+  TempBuf := FBuffers[FBufferCount];
+  move(FBuffers[0],FBuffers[1],(fbuffercount)*sizeof(FBuffers[0]));
+  FBuffers[0]:=TempBuf;
 end;
 end;
 
 
 Procedure TDataset.UnRegisterDataSource(ADatasource : TDatasource);
 Procedure TDataset.UnRegisterDataSource(ADatasource : TDatasource);
@@ -1760,7 +1684,10 @@ end;
 
 
 {
 {
   $Log$
   $Log$
-  Revision 1.17  2004-08-03 19:08:48  michael
+  Revision 1.18  2004-08-13 07:06:02  michael
+  + Rework of buffer management by Joost Van der Sluis
+
+  Revision 1.17  2004/08/03 19:08:48  michael
   + Latest patch from Micha Nelissen
   + Latest patch from Micha Nelissen
 
 
   Revision 1.16  2004/08/02 15:13:42  michael
   Revision 1.16  2004/08/02 15:13:42  michael

+ 11 - 8
fcl/db/db.pp

@@ -793,7 +793,6 @@ type
     FBeforePost: TDataSetNotifyEvent;
     FBeforePost: TDataSetNotifyEvent;
     FBeforeScroll: TDataSetNotifyEvent;
     FBeforeScroll: TDataSetNotifyEvent;
     FBlobFieldCount: Longint;
     FBlobFieldCount: Longint;
-    FBookmark: TBookmarkStr;
     FBookmarkSize: Longint;
     FBookmarkSize: Longint;
     FBuffers : TBufferArray;
     FBuffers : TBufferArray;
     FBufferCount: Longint;
     FBufferCount: Longint;
@@ -826,23 +825,24 @@ type
     FRecNo: Longint;
     FRecNo: Longint;
     FRecordCount: Longint;
     FRecordCount: Longint;
     FRecordSize: Word;
     FRecordSize: Word;
+    FIsUniDirectional: Boolean;
     FState : TDataSetState;
     FState : TDataSetState;
     Procedure DoInsertAppend(DoAppend : Boolean);
     Procedure DoInsertAppend(DoAppend : Boolean);
     Procedure DoInternalOpen;
     Procedure DoInternalOpen;
     Procedure DoInternalClose;
     Procedure DoInternalClose;
     Function  GetBuffer (Index : longint) : Pchar;
     Function  GetBuffer (Index : longint) : Pchar;
     Function  GetField (Index : Longint) : TField;
     Function  GetField (Index : Longint) : TField;
-    procedure RecalcBufListSize;
     Procedure RegisterDataSource(ADatasource : TDataSource);
     Procedure RegisterDataSource(ADatasource : TDataSource);
     Procedure RemoveField (Field : TField);
     Procedure RemoveField (Field : TField);
     Procedure SetActive (Value : Boolean);
     Procedure SetActive (Value : Boolean);
-    procedure SetBufferCount(const AValue: Longint);
     Procedure SetField (Index : Longint;Value : TField);
     Procedure SetField (Index : Longint;Value : TField);
-    Procedure ShiftBuffers (Offset,Distance : Longint);
+    Procedure ShiftBuffersForward;
+    Procedure ShiftBuffersBackward;
     Function  TryDoing (P : TDataOperation; Ev : TDatasetErrorEvent) : Boolean;
     Function  TryDoing (P : TDataOperation; Ev : TDatasetErrorEvent) : Boolean;
     Procedure UnRegisterDataSource(ADatasource : TDatasource);
     Procedure UnRegisterDataSource(ADatasource : TDatasource);
     Procedure UpdateFieldDefs;
     Procedure UpdateFieldDefs;
   protected
   protected
+    procedure RecalcBufListSize;
     procedure ActivateBuffers; virtual;
     procedure ActivateBuffers; virtual;
     procedure BindFields(Binding: Boolean);
     procedure BindFields(Binding: Boolean);
     function  BookmarkAvailable: Boolean;
     function  BookmarkAvailable: Boolean;
@@ -898,7 +898,6 @@ type
     procedure Loaded; override;
     procedure Loaded; override;
     procedure OpenCursor(InfoQuery: Boolean); virtual;
     procedure OpenCursor(InfoQuery: Boolean); virtual;
     procedure RefreshInternalCalcFields(Buffer: PChar); virtual;
     procedure RefreshInternalCalcFields(Buffer: PChar); virtual;
-    Function  RequiredBuffers : longint;
     procedure RestoreState(const Value: TDataSetState);
     procedure RestoreState(const Value: TDataSetState);
     procedure SetBookmarkStr(const Value: TBookmarkStr); virtual;
     procedure SetBookmarkStr(const Value: TBookmarkStr); virtual;
     procedure SetBufListSize(Value: Longint);
     procedure SetBufListSize(Value: Longint);
@@ -1010,13 +1009,14 @@ type
 //    property Fields[Index: Longint]: TField read GetField write SetField;
 //    property Fields[Index: Longint]: TField read GetField write SetField;
     property Found: Boolean read FFound;
     property Found: Boolean read FFound;
     property Modified: Boolean read FModified;
     property Modified: Boolean read FModified;
+    property IsUniDirectional: Boolean read FIsUniDirectional write FIsUniDirectional default False;
     property RecordCount: Longint read GetRecordCount;
     property RecordCount: Longint read GetRecordCount;
     property RecNo: Longint read FRecNo write FRecNo;
     property RecNo: Longint read FRecNo write FRecNo;
     property RecordSize: Word read FRecordSize;
     property RecordSize: Word read FRecordSize;
     property State: TDataSetState read FState;
     property State: TDataSetState read FState;
     property Fields : TFields Read FFieldList;
     property Fields : TFields Read FFieldList;
-    property Filter: string read FFilterText write FFilterText;
-    property Filtered: Boolean read FFiltered write FFiltered default False;
+    property Filter: string read FFilterText write SetFilterText;
+    property Filtered: Boolean read FFiltered write SetFiltered default False;
     property FilterOptions: TFilterOptions read FFilterOptions write FFilterOptions;
     property FilterOptions: TFilterOptions read FFilterOptions write FFilterOptions;
     property Active: Boolean read FActive write SetActive default False;
     property Active: Boolean read FActive write SetActive default False;
     property AutoCalcFields: Boolean read FAutoCalcFields write FAutoCalcFields;
     property AutoCalcFields: Boolean read FAutoCalcFields write FAutoCalcFields;
@@ -1500,7 +1500,10 @@ end.
 
 
 {
 {
   $Log$
   $Log$
-  Revision 1.19  2004-07-25 11:32:40  michael
+  Revision 1.20  2004-08-13 07:06:02  michael
+  + Rework of buffer management by Joost Van der Sluis
+
+  Revision 1.19  2004/07/25 11:32:40  michael
   * Patches from Joost van der Sluis
   * Patches from Joost van der Sluis
     interbase.pp:
     interbase.pp:
         * Removed unused Fprepared
         * Removed unused Fprepared

+ 5 - 1
fcl/db/dbs.inc

@@ -39,6 +39,7 @@ Const
   SNoDatasetRegistered = 'No such dataset registered : "%s"';
   SNoDatasetRegistered = 'No such dataset registered : "%s"';
   SNotConnected = 'Operation cannot be performed on an disconnected database';
   SNotConnected = 'Operation cannot be performed on an disconnected database';
   SConnected = 'Operation cannot be performed on an connected database';
   SConnected = 'Operation cannot be performed on an connected database';
+  SUniDirectional = 'Operation cannot be performed on an unidirectional dataset';
   SNoSuchRecord = 'Could not find the requested record.';
   SNoSuchRecord = 'Could not find the requested record.';
   SDatasetReadOnly = 'Dataset is read-only.';
   SDatasetReadOnly = 'Dataset is read-only.';
   SNeedField = 'Field %s is required, but not supplied.';
   SNeedField = 'Field %s is required, but not supplied.';
@@ -48,7 +49,10 @@ Const
 
 
 {
 {
   $Log$
   $Log$
-  Revision 1.5  2003-08-16 16:42:21  michael
+  Revision 1.6  2004-08-13 07:06:02  michael
+  + Rework of buffer management by Joost Van der Sluis
+
+  Revision 1.5  2003/08/16 16:42:21  michael
   + Fixes in TDBDataset etc. Changed MySQLDb to use database as well
   + Fixes in TDBDataset etc. Changed MySQLDb to use database as well
 
 
   Revision 1.4  2002/09/07 15:15:23  peter
   Revision 1.4  2002/09/07 15:15:23  peter

BIN
fcl/db/odbc/testodbc.mdb