* update tdbf to release 6.9.1

git-svn-id: trunk@6721 -

packages/fcl-db/src/dbase/dbf.pas

@@ -117,7 +117,6 @@ type
     FParser: TDbfParser;
     FFieldNames: string;
     FValidExpression: Boolean;
-    FKeyTranslation: boolean;
     FOnMasterChange: TNotifyEvent;
     FOnMasterDisable: TNotifyEvent;
 
@@ -135,7 +134,6 @@ type
     destructor Destroy; override;
 
     property FieldNames: string read FFieldNames write SetFieldNames;
-    property KeyTranslation: boolean read FKeyTranslation;
     property ValidExpression: Boolean read FValidExpression write FValidExpression;
     property FieldsVal: PChar read GetFieldsVal;
     property Parser: TDbfParser read FParser;
@@ -223,6 +221,7 @@ type
     function  ParseIndexName(const AIndexName: string): string;
     procedure ParseFilter(const AFilter: string);
     function  GetDbfFieldDefs: TDbfFieldDefs;
+    function  ReadCurrentRecord(Buffer: PChar; var Acceptable: Boolean): TGetResult;
     function  SearchKeyBuffer(Buffer: PChar; SearchType: TSearchKeyType): Boolean;
     procedure SetRangeBuffer(LowRange: PChar; HighRange: PChar);
 
@@ -289,7 +288,7 @@ type
     destructor Destroy; override;
 
     { abstract methods }
-    function GetFieldData(Field: TField; Buffer: Pointer): Boolean; 
+    function GetFieldData(Field: TField; Buffer: Pointer): Boolean;
       {$ifdef SUPPORT_OVERLOAD} overload; {$endif} override; {virtual abstract}
     { virtual methods (mostly optionnal) }
     procedure Resync(Mode: TResyncMode); override;
@@ -441,6 +440,8 @@ type
     property AfterCancel;
     property BeforeDelete;
     property AfterDelete;
+    property BeforeRefresh;
+    property AfterRefresh;
     property BeforeScroll;
     property AfterScroll;
     property OnCalcFields;
@@ -794,12 +795,29 @@ begin
     OnFilterRecord(Self, Acceptable);
 end;
 
+function TDbf.ReadCurrentRecord(Buffer: PChar; var Acceptable: Boolean): TGetResult;
+var
+  lPhysicalRecNo: Integer;
+  pRecord: pDbfRecord;
+begin
+  lPhysicalRecNo := FCursor.PhysicalRecNo;
+  if (lPhysicalRecNo = 0) or not FDbfFile.IsRecordPresent(lPhysicalRecNo) then
+  begin
+    Result := grError;
+    Acceptable := false;
+  end else begin
+    Result := grOK;
+    pRecord := pDbfRecord(Buffer);
+    FDbfFile.ReadRecord(lPhysicalRecNo, @pRecord^.DeletedFlag);
+    Acceptable := (FShowDeleted or (pRecord^.DeletedFlag <> '*'))
+  end;
+end;
+
 function TDbf.GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult; {override virtual abstract from TDataset}
 var
-  pRecord: pDBFRecord;
+  pRecord: pDbfRecord;
   acceptable: Boolean;
   SaveState: TDataSetState;
-  lPhysicalRecNo: Integer;
 //  s: string;
 begin
   if FCursor = nil then
@@ -808,7 +826,7 @@ begin
     exit;
   end;
 
-  pRecord := pDBFRecord(Buffer);
+  pRecord := pDbfRecord(Buffer);
   acceptable := false;
   repeat
     Result := grOK;
@@ -834,16 +852,7 @@ begin
     end;
 
     if (Result = grOK) then
-    begin
+      Result := ReadCurrentRecord(Buffer, acceptable);
-      lPhysicalRecNo := FCursor.PhysicalRecNo;
-      if (lPhysicalRecNo = 0) or not FDbfFile.IsRecordPresent(lPhysicalRecNo) then
-      begin
-        Result := grError;
-      end else begin
-        FDbfFile.ReadRecord(lPhysicalRecNo, @pRecord^.DeletedFlag);
-        acceptable := (FShowDeleted or (pRecord^.DeletedFlag <> '*'))
-      end;
-    end;
 
     if (Result = grOK) and acceptable then
     begin
@@ -1267,6 +1276,8 @@ begin
 // SetIndexName will have made the cursor for us if no index selected :-)
 //  if FCursor = nil then FCursor := TDbfCursor.Create(FDbfFile);
 
+  if FMasterLink.Active and Assigned(FIndexFile) then
+    CheckMasterRange;
   InternalFirst;
 
 //  FDbfFile.SetIndex(FIndexName);
@@ -1827,6 +1838,7 @@ var
   searchFlag: TSearchKeyType;
   matchRes: Integer;
   lTempBuffer: array [0..100] of Char;
+  acceptable, checkmatch: boolean;
 begin
   if loPartialKey in Options then
     searchFlag := stGreaterEqual
@@ -1835,23 +1847,31 @@ begin
   if TIndexCursor(FCursor).VariantToBuffer(KeyValues, @lTempBuffer[0]) = etString then
     Translate(@lTempBuffer[0], @lTempBuffer[0], true);
   Result := FIndexFile.SearchKey(@lTempBuffer[0], searchFlag);
-  if Result then
+  if not Result then
-  begin
+    exit;
-    Result := GetRecord(TempBuffer, gmCurrent, false) = grOK;
+
-    if not Result then
+  checkmatch := false;
+  repeat
+    if ReadCurrentRecord(TempBuffer, acceptable) = grError then
     begin
-      Result := GetRecord(TempBuffer, gmNext, false) = grOK;
+      Result := false;
-      if Result then
+      exit;
-      begin
-        matchRes := TIndexCursor(FCursor).IndexFile.MatchKey(@lTempBuffer[0]);
-        if loPartialKey in Options then
-          Result := matchRes <= 0
-        else
-          Result := matchRes =  0;
-      end;
     end;
-    FFilterBuffer := TempBuffer;
+    if acceptable then break;
+    checkmatch := true;
+    FCursor.Next;
+  until false;
+
+  if checkmatch then
+  begin
+    matchRes := TIndexCursor(FCursor).IndexFile.MatchKey(@lTempBuffer[0]);
+    if loPartialKey in Options then
+      Result := matchRes <= 0
+    else
+      Result := matchRes =  0;
   end;
+
+  FFilterBuffer := TempBuffer;
 end;
 
 function TDbf.LocateRecord(const KeyFields: String; const KeyValues: Variant;
@@ -2798,7 +2818,8 @@ var
   tempBuffer: array[0..300] of char;
 begin
   fieldsVal := FMasterLink.FieldsVal;
-  if FMasterLink.KeyTranslation then
+  if (TDbf(FMasterLink.DataSet).DbfFile.UseCodePage <> FDbfFile.UseCodePage)
+        and (FMasterLink.Parser.ResultType = etString) then
   begin
     FMasterLink.DataSet.Translate(fieldsVal, @tempBuffer[0], false);
     fieldsVal := @tempBuffer[0];
@@ -2807,7 +2828,7 @@ begin
   fieldsVal := TIndexCursor(FCursor).IndexFile.PrepareKey(fieldsVal, FMasterLink.Parser.ResultType);
   SetRangeBuffer(fieldsVal, fieldsVal);
 end;
-    
+
 procedure TDbf.MasterChanged(Sender: TObject);
 begin
   CheckBrowseMode;
@@ -2835,7 +2856,7 @@ begin
     DatabaseError(SCircularDataLink);
 {$endif}
   end;
-{$endif}  
+{$endif}
   FMasterLink.DataSource := Value;
 end;
 
@@ -2950,8 +2971,6 @@ begin
     FValidExpression := false;
     FParser.DbfFile := (DataSet as TDbf).DbfFile;
     FParser.ParseExpression(FFieldNames);
-    FKeyTranslation := TDbfFile(FParser.DbfFile).UseCodePage <> 
-      FDetailDataSet.DbfFile.UseCodePage;
     FValidExpression := true;
   end else begin
     FParser.ClearExpressions;

packages/fcl-db/src/dbase/dbf_dbffile.pas

@@ -2359,27 +2359,22 @@ begin
 end;
 
 function TDbfFile.Insert(Buffer: PChar): integer;
+type
+  TErrorContext = (ecNone, ecInsert, ecWriteIndex, ecWriteDbf);
 var
   newRecord: Integer;
   lIndex: TIndexFile;
-  error: Boolean;
 
-  procedure RollBackIndexesAndRaise(HighIndex: Integer; IndexError: Boolean);
+  procedure RollBackIndexesAndRaise(Count: Integer; ErrorContext: TErrorContext);
   var
     errorMsg: string;
     I: Integer;
   begin
     // rollback committed indexes
-    error := IndexError;
+    for I := 0 to Count-1 do
-    for I := 0 to HighIndex do
     begin
       lIndex := TIndexFile(FIndexFiles.Items[I]);
       lIndex.Delete(newRecord, Buffer);
-      if lIndex.WriteError then
-      begin
-        lIndex.ResetError;
-        error := true;
-      end;
     end;
 
     // reset any dbf file error
@@ -2387,15 +2382,17 @@ var
 
     // if part of indexes committed -> always index error msg
     // if error while rolling back index -> index error msg
-    if error then
+    case ErrorContext of
-      errorMsg := STRING_WRITE_INDEX_ERROR
+      ecInsert: begin TIndexFile(FIndexFiles.Items[Count]).InsertError; exit; end;
-    else
+      ecWriteIndex: errorMsg := STRING_WRITE_INDEX_ERROR;
-      errorMsg := STRING_WRITE_ERROR;
+      ecWriteDbf: errorMsg := STRING_WRITE_ERROR;
+    end;
     raise EDbfWriteError.Create(errorMsg);
   end;
 
 var
   I: Integer;
+  error: TErrorContext;
 begin
   // get new record index
   Result := 0;
@@ -2405,34 +2402,24 @@ begin
     Inc(newRecord);
   // write autoinc value
   ApplyAutoIncToBuffer(Buffer);
-  // check indexes -> possible key violation
+  error := ecNone;
-  I := 0; error := false;
+  I := 0;
-  while (I < FIndexFiles.Count) and not error do
+  while I < FIndexFiles.Count do
   begin
     lIndex := TIndexFile(FIndexFiles.Items[I]);
-    error := lIndex.CheckKeyViolation(Buffer);
+    if not lIndex.Insert(newRecord, Buffer) then
-    Inc(I);
+      error := ecInsert;
-  end;
-  // error occured while inserting? -> abort
-  if error then
-  begin
-    UnlockPage(newRecord);
-    lIndex.InsertError;
-    // don't have to exit -- unreachable code
-  end;
-
-  // no key violation, insert record into index(es)
-  for I := 0 to FIndexFiles.Count-1 do
-  begin
-    lIndex := TIndexFile(FIndexFiles.Items[I]);
-    lIndex.Insert(newRecord, Buffer);
     if lIndex.WriteError then
+      error := ecWriteIndex;
+    if error <> ecNone then
     begin
       // if there's an index write error, I shouldn't
       // try to write the dbf header and the new record,
       // but raise an exception right away
-      RollBackIndexesAndRaise(I, True);
+      UnlockPage(newRecord);
+      RollBackIndexesAndRaise(I, ecWriteIndex);
     end;
+    Inc(I);
   end;
 
   // indexes ok -> continue inserting
@@ -2455,7 +2442,8 @@ begin
     // At this point I should "roll back"
     // the already written index records.
     // if this fails, I'm in deep trouble!
-    RollbackIndexesAndRaise(FIndexFiles.Count-1, False);
+    UnlockPage(newRecord);
+    RollbackIndexesAndRaise(FIndexFiles.Count, ecWriteDbf);
   end;
 
   // write locking info
@@ -2479,7 +2467,7 @@ begin
     WriteHeader;
     UnlockPage(0);
     // roll back indexes too
-    RollbackIndexesAndRaise(FIndexFiles.Count-1, False);
+    RollbackIndexesAndRaise(FIndexFiles.Count, ecWriteDbf);
   end else
     Result := newRecord;
 end;
@@ -2533,13 +2521,26 @@ end;
 procedure TDbfFile.UnlockRecord(RecNo: Integer; Buffer: PChar);
 var
   I: Integer;
-  lIndex: TIndexFile;
+  lIndex, lErrorIndex: TIndexFile;
 begin
   // update indexes, possible key violation
-  for I := 0 to FIndexFiles.Count - 1 do
+  I := 0;
+  while I < FIndexFiles.Count do
   begin
     lIndex := TIndexFile(FIndexFiles.Items[I]);
-    lIndex.Update(RecNo, FPrevBuffer, Buffer);
+    if not lIndex.Update(RecNo, FPrevBuffer, Buffer) then
+    begin
+      // error -> rollback
+      lErrorIndex := lIndex;
+      while I > 0 do
+      begin
+        Dec(I);
+        lIndex := TIndexFile(FIndexFiles.Items[I]);
+        lIndex.Update(RecNo, Buffer, FPrevBuffer);
+      end;
+      lErrorIndex.InsertError;
+    end;
+    Inc(I);
   end;
   // write new record buffer, all keys ok
   WriteRecord(RecNo, Buffer);
@@ -2563,13 +2564,24 @@ end;
 procedure TDbfFile.RecordRecalled(RecNo: Integer; Buffer: PChar);
 var
   I: Integer;
-  lIndex: TIndexFile;
+  lIndex, lErrorIndex: TIndexFile;
 begin
   // notify indexes: record recalled
-  for I := 0 to FIndexFiles.Count - 1 do
+  I := 0;
+  while I < FIndexFiles.Count do
   begin
     lIndex := TIndexFile(FIndexFiles.Items[I]);
-    lIndex.RecordRecalled(RecNo, Buffer);
+    if not lIndex.RecordRecalled(RecNo, Buffer) then
+    begin
+      lErrorIndex := lIndex;
+      while I > 0 do
+      begin
+        Dec(I);
+        lIndex.RecordDeleted(RecNo, Buffer);
+      end;
+      lErrorIndex.InsertError;
+    end;
+    Inc(I);
   end;
 end;
 

packages/fcl-db/src/dbase/dbf_idxfile.pas

@@ -106,9 +106,11 @@ type
     FLowBracket: Integer;               //  = FLowIndex if FPageNo = FLowPage
     FLowIndex: Integer;
     FLowPage: Integer;
+    FLowPageTemp: Integer;
     FHighBracket: Integer;              //  = FHighIndex if FPageNo = FHighPage
     FHighIndex: Integer;
     FHighPage: Integer;
+    FHighPageTemp: Integer;
 
     procedure LocalInsert(RecNo: Integer; Buffer: PChar; LowerPageNo: Integer);
     procedure LocalDelete;
@@ -164,6 +166,8 @@ type
     procedure RecalcWeight;
     procedure UpdateWeight;
     procedure Flush;
+    procedure SaveBracket;
+    procedure RestoreBracket;
 
     property Key: PChar read GetKeyData;
     property Entry: Pointer read FEntry;
@@ -224,6 +228,7 @@ type
 {$endif}
   protected
     FIndexName: string;
+    FLastError: string;
     FParsers: array[0..MaxIndexes-1] of TDbfIndexParser;
     FIndexHeaders: array[0..MaxIndexes-1] of Pointer;
     FIndexHeaderModified: array[0..MaxIndexes-1] of Boolean;
@@ -242,6 +247,7 @@ type
     FTagOffset: Integer;
     FHeaderPageNo: Integer;
     FSelectedIndex: Integer;
+    FRangeIndex: Integer;
     FIsDescending: Boolean;
     FUniqueMode: TIndexUniqueType;
     FModifyMode: TIndexModifyMode;
@@ -270,6 +276,7 @@ type
     function  GetNewPageNo: Integer;
     procedure TouchHeader(AHeader: Pointer);
     function  CreateTempFile(BaseName: string): TPagedFile;
+    procedure ConstructInsertErrorMsg;
     procedure WriteIndexHeader(AIndex: Integer);
     procedure SelectIndexVars(AIndex: Integer);
     procedure CalcKeyProperties;
@@ -278,11 +285,12 @@ type
     function  CalcTagOffset(AIndex: Integer): Pointer;
 
     function  FindKey(AInsert: boolean): Integer;
-    procedure InsertKey(Buffer: PChar);
+    function  InsertKey(Buffer: PChar): Boolean;
     procedure DeleteKey(Buffer: PChar);
-    procedure InsertCurrent;
+    function  InsertCurrent: Boolean;
     procedure DeleteCurrent;
-    procedure UpdateCurrent(PrevBuffer, NewBuffer: PChar);
+    function  UpdateCurrent(PrevBuffer, NewBuffer: PChar): Boolean;
+    function  UpdateIndex(Index: Integer; PrevBuffer, NewBuffer: PChar): Boolean;
     procedure ReadIndexes;
     procedure Resync(Relative: boolean);
     procedure ResyncRoot;
@@ -329,12 +337,12 @@ type
     procedure AddNewLevel;
     procedure UnlockHeader;
     procedure InsertError;
-    procedure Insert(RecNo: Integer; Buffer: PChar);
+    function  Insert(RecNo: Integer; Buffer: PChar): Boolean;
-    procedure Update(RecNo: Integer; PrevBuffer, NewBuffer: PChar);
+    function  Update(RecNo: Integer; PrevBuffer, NewBuffer: PChar): Boolean;
     procedure Delete(RecNo: Integer; Buffer: PChar);
     function  CheckKeyViolation(Buffer: PChar): Boolean;
     procedure RecordDeleted(RecNo: Integer; Buffer: PChar);
-    procedure RecordRecalled(RecNo: Integer; Buffer: PChar);
+    function  RecordRecalled(RecNo: Integer; Buffer: PChar): Boolean;
     procedure DeleteIndex(const AIndexName: string);
     procedure RepageFile;
     procedure CompactFile;
@@ -345,6 +353,8 @@ type
     function  SearchKey(Key: PChar; SearchType: TSearchKeyType): Boolean;
     function  Find(RecNo: Integer; Buffer: PChar): Integer;
     function  IndexOf(const AIndexName: string): Integer;
+    procedure DisableRange;
+    procedure EnableRange;
 
     procedure GetIndexNames(const AList: TStrings);
     procedure GetIndexInfo(const AIndexName: string; IndexDef: TDbfIndexDef);
@@ -633,7 +643,7 @@ end;
 
 procedure IncIntLE(var AVariable: Integer; Amount: Integer);
 begin
-  AVariable := SwapIntLE(SwapIntLE(AVariable) + Amount);
+  AVariable := SwapIntLE(DWord(Integer(SwapIntLE(AVariable)) + Amount));
 end;
 
 //==========================================================
@@ -656,9 +666,8 @@ begin
   EnumSystemLocales(@LocaleCallBack, LCID_SUPPORTED);
 end;
 
-//==========================================================
+{ TIndexPage }
-//============ TIndexPage
+
-//==========================================================
 constructor TIndexPage.Create(Parent: TIndexFile);
 begin
   FIndexFile := Parent;
@@ -1386,6 +1395,18 @@ begin
     FLowerPage.RecurLast;
 end;
 
+procedure TIndexPage.SaveBracket;
+begin
+  FLowPageTemp := FLowPage;
+  FHighPageTemp := FHighPage;
+end;
+
+procedure TIndexPage.RestoreBracket;
+begin
+  FLowPage := FLowPageTemp;
+  FHighPage := FHighPageTemp;
+end;
+
 //==============================================================================
 //============ Mdx specific access routines
 //==============================================================================
@@ -1733,6 +1754,7 @@ begin
   FUpdateMode := umCurrent;
   FModifyMode := mmNormal;
   FTempMode := TDbfFile(ADbfFile).TempMode;
+  FRangeIndex := -1;
   SelectIndexVars(-1);
   for I := 0 to MaxIndexes - 1 do
   begin
@@ -2772,9 +2794,9 @@ begin
     UnlockPage(0);
 end;
 
-procedure TIndexFile.Insert(RecNo: Integer; Buffer: PChar); {override;}
+function TIndexFile.Insert(RecNo: Integer; Buffer: PChar): Boolean; {override;}
 var
-  I, curSel: Integer;
+  I, curSel, count: Integer;
 begin
   // check if updating all or only current
   FUserRecNo := RecNo;
@@ -2782,15 +2804,28 @@ begin
   begin
     // remember currently selected index
     curSel := FSelectedIndex;
-    for I := 0 to SwapWordLE(PMdxHdr(Header)^.TagsUsed) - 1 do
+    Result := true;
+    I := 0;
+    count := SwapWordLE(PMdxHdr(Header)^.TagsUsed);
+    while I < count do
     begin
       SelectIndexVars(I);
-      InsertKey(Buffer);
+      Result := InsertKey(Buffer);
+      if not Result then
+      begin
+        while I > 0 do
+        begin
+          Dec(I);
+          DeleteKey(Buffer);
+        end;
+        break;
+      end;
+      Inc(I);
     end;
     // restore previous selected index
     SelectIndexVars(curSel);
   end else begin
-    InsertKey(Buffer);
+    Result := InsertKey(Buffer);
   end;
 
   // check range, disabled by insert
@@ -2949,8 +2984,9 @@ begin
     TranslateString(GetACP, FCodePage, Result, Result, KeyLen);
 end;
 
-procedure TIndexFile.InsertKey(Buffer: PChar);
+function TIndexFile.InsertKey(Buffer: PChar): boolean;
 begin
+  Result := true;
   // ignore deleted records
   if (FModifyMode = mmNormal) and (FUniqueMode = iuDistinct) and (Buffer^ = '*') then
     exit;
@@ -2960,16 +2996,17 @@ begin
     // get key from buffer
     FUserKey := ExtractKeyFromBuffer(Buffer);
     // patch through
-    InsertCurrent;
+    Result := InsertCurrent;
   end;
 end;
 
-procedure TIndexFile.InsertCurrent;
+function TIndexFile.InsertCurrent: boolean;
   // insert in current index
   // assumes: FUserKey is an OEM key
 begin
   // only insert if not recalling or mode = distinct
   // modify = mmDeleteRecall /\ unique <> distinct -> key already present
+  Result := true;
   if (FModifyMode <> mmDeleteRecall) or (FUniqueMode = iuDistinct) then
   begin
     // temporarily remove range to find correct location of key
@@ -2989,20 +3026,31 @@ begin
       begin
         // raising -> reset modify mode
         FModifyMode := mmNormal;
-        InsertError;
+        ConstructInsertErrorMsg;
+        Result := false;
       end;
     end;
   end;
 end;
 
-procedure TIndexFile.InsertError;
+procedure TIndexFile.ConstructInsertErrorMsg;
 var
   InfoKey: string;
 begin
-  // prepare info for user
+  if Length(FLastError) > 0 then exit;
   InfoKey := FUserKey;
   SetLength(InfoKey, KeyLen);
-  raise EDbfError.CreateFmt(STRING_KEY_VIOLATION, [GetName, PhysicalRecNo, TrimRight(InfoKey)]);
+  FLastError := Format(STRING_KEY_VIOLATION, [GetName,
+    PhysicalRecNo, TrimRight(InfoKey)]);
+end;
+
+procedure TIndexFile.InsertError;
+var
+  errorStr: string;
+begin
+  errorStr := FLastError;
+  FLastError := '';
+  raise EDbfError.Create(errorStr);
 end;
 
 procedure TIndexFile.Delete(RecNo: Integer; Buffer: PChar);
@@ -3059,9 +3107,15 @@ begin
   end;
 end;
 
-procedure TIndexFile.Update(RecNo: Integer; PrevBuffer, NewBuffer: PChar);
+function TIndexFile.UpdateIndex(Index: Integer; PrevBuffer, NewBuffer: PChar): Boolean;
+begin
+  SelectIndexVars(Index);
+  Result := UpdateCurrent(PrevBuffer, NewBuffer);
+end;
+
+function TIndexFile.Update(RecNo: Integer; PrevBuffer, NewBuffer: PChar): Boolean;
 var
-  I, curSel: Integer;
+  I, curSel, count: Integer;
 begin
   // check if updating all or only current
   FUserRecNo := RecNo;
@@ -3069,42 +3123,60 @@ begin
   begin
     // remember currently selected index
     curSel := FSelectedIndex;
-    for I := 0 to SwapWordLE(PMdxHdr(Header)^.TagsUsed) - 1 do
+    Result := true;
+    I := 0;
+    count := SwapWordLE(PMdxHdr(Header)^.TagsUsed);
+    while I < count do
     begin
-      SelectIndexVars(I);
+      Result := UpdateIndex(I, PrevBuffer, NewBuffer);
-      UpdateCurrent(PrevBuffer, NewBuffer);
+      if not Result then
+      begin
+        // rollback updates to previous indexes
+        while I > 0 do
+        begin
+          Dec(I);
+          UpdateIndex(I, NewBuffer, PrevBuffer);
+        end;
+        break;
+      end;
+      Inc(I);
     end;
     // restore previous selected index
     SelectIndexVars(curSel);
   end else begin
-    UpdateCurrent(PrevBuffer, NewBuffer);
+    Result := UpdateCurrent(PrevBuffer, NewBuffer);
   end;
   // check range, disabled by delete/insert
   if (FRoot.LowPage = 0) and (FRoot.HighPage = 0) then
     ResyncRange(true);
 end;
 
-procedure TIndexFile.UpdateCurrent(PrevBuffer, NewBuffer: PChar);
+function TIndexFile.UpdateCurrent(PrevBuffer, NewBuffer: PChar): boolean;
 var
+  InsertKey, DeleteKey: PChar;
   TempBuffer: array [0..100] of Char;
 begin
+  Result := true;
   if FCanEdit and (PIndexHdr(FIndexHeader)^.KeyLen <> 0) then
   begin
-    // get key from newbuffer
+    DeleteKey := ExtractKeyFromBuffer(PrevBuffer);
-    FUserKey := ExtractKeyFromBuffer(NewBuffer);
+    Move(DeleteKey^, TempBuffer, SwapWordLE(PIndexHdr(FIndexHeader)^.KeyLen));
-    Move(FUserKey^, TempBuffer, SwapWordLE(PIndexHdr(FIndexHeader)^.KeyLen));
+    DeleteKey := @TempBuffer[0];
-    // get key from prevbuffer
+    InsertKey := ExtractKeyFromBuffer(NewBuffer);
-    FUserKey := ExtractKeyFromBuffer(PrevBuffer);
 
     // compare to see if anything changed
-    if CompareKey(@TempBuffer[0]) <> 0 then
+    if CompareKeys(DeleteKey, InsertKey) <> 0 then
     begin
-      // first set userkey to key to delete
+      FUserKey := DeleteKey;
-      // FUserKey = KeyFrom(PrevBuffer)
       DeleteCurrent;
-      // now set userkey to key to insert
+      FUserKey := InsertKey;
-      FUserKey := @TempBuffer[0];
+      Result := InsertCurrent;
-      InsertCurrent;
+      if not Result then
+      begin
+        FUserKey := DeleteKey;
+        InsertCurrent;
+        FUserKey := InsertKey;
+      end;
     end;
   end;
 end;
@@ -3333,11 +3405,11 @@ begin
   FModifyMode := mmNormal;
 end;
 
-procedure TIndexFile.RecordRecalled(RecNo: Integer; Buffer: PChar);
+function TIndexFile.RecordRecalled(RecNo: Integer; Buffer: PChar): Boolean;
 begin
   // are we distinct -> then reinsert record in index
   FModifyMode := mmDeleteRecall;
-  Insert(RecNo, Buffer);
+  Result := Insert(RecNo, Buffer);
   FModifyMode := mmNormal;
 end;
 
@@ -3664,6 +3736,30 @@ begin
   until TempPage = nil;
 end;
 
+procedure TIndexFile.DisableRange;
+var
+  TempPage: TIndexPage;
+begin
+  TempPage := FRoot;
+  repeat
+    TempPage.SaveBracket;
+    TempPage := TempPage.LowerPage;
+  until TempPage = nil;
+  CancelRange;
+end;
+
+procedure TIndexFile.EnableRange;
+var
+  TempPage: TIndexPage;
+begin
+  TempPage := FRoot;
+  repeat
+    TempPage.RestoreBracket;
+    TempPage := TempPage.LowerPage;
+  until TempPage = nil;
+  FRangeActive := true;
+end;
+
 function MemComp(P1, P2: Pointer; const Length: Integer): Integer;
 var
   I: Integer;
@@ -3781,9 +3877,22 @@ begin
     found := IndexOf(AIndexName);
   end else
     found := 0;
+  // if changing index, range is N/A anymore
+  if FRangeActive and (found <> FSelectedIndex) then
+  begin
+    FRangeIndex := FSelectedIndex;
+    DisableRange;
+  end;
   // we can now select by index
   if found >= 0 then
+  begin
     SelectIndexVars(found);
+    if found = FRangeIndex then
+    begin
+      EnableRange;
+      FRangeIndex := -1;
+    end;
+  end;
 end;
 
 function TIndexFile.CalcTagOffset(AIndex: Integer): Pointer;

packages/fcl-db/src/dbase/history.txt

@@ -40,6 +40,8 @@ V6.9.1
 - fix index result too long bug
 - add support for big endian
 - fix non-raw string field filter
+- fix index inserts/updates to be reverted on key violations
+- allow lookups to ignore active filter
 
 ------------------------
 V6.9.0