update tdbf to release 6.4.8

git-svn-id: trunk@3358 -

fcl/db/dbase/dbf.pas

@@ -163,6 +163,9 @@ type
     FFilterBuffer: PChar;
     FTempBuffer: PChar;
     FEditingRecNo: Integer;
+{$ifdef SUPPORT_VARIANTS}    
+    FLocateRecNo: Integer;
+{$endif}    
     FLanguageID: Byte;
     FTableLevel: Integer;
     FExclusive: Boolean;
@@ -212,7 +215,6 @@ type
     procedure MasterChanged(Sender: TObject);
     procedure MasterDisabled(Sender: TObject);
     procedure DetermineTranslationMode;
-    procedure CheckMasterRange;
     procedure UpdateRange;
     procedure SetShowDeleted(Value: Boolean);
     procedure GetFieldDefsFromDbfFieldDefs;
@@ -274,6 +276,8 @@ type
     procedure SetIndexFieldNames(const Value: string); {virtual;}
 
 {$ifdef SUPPORT_VARIANTS}
+    function  LocateRecordLinear(const KeyFields: String; const KeyValues: Variant; Options: TLocateOptions): Boolean;
+    function  LocateRecordIndex(const KeyFields: String; const KeyValues: Variant; Options: TLocateOptions): Boolean;
     function  LocateRecord(const KeyFields: String; const KeyValues: Variant; Options: TLocateOptions): Boolean;
 {$endif}
 
@@ -318,6 +322,7 @@ type
     procedure RegenerateIndexes;
 
     procedure CancelRange;
+    procedure CheckMasterRange;
 {$ifdef SUPPORT_VARIANTS}
     function  SearchKey(Key: Variant; SearchType: TSearchKeyType): Boolean;
     procedure SetRange(LowRange: Variant; HighRange: Variant);
@@ -387,7 +392,7 @@ type
     property FilePathFull: string read FAbsolutePath write SetFilePath stored false;
     property Indexes: TDbfIndexDefs read FIndexDefs write SetDbfIndexDefs stored false;
     property IndexDefs: TDbfIndexDefs read FIndexDefs write SetDbfIndexDefs;
-    property IndexFieldNames: string read GetIndexFieldNames write SetIndexFieldNames;
+    property IndexFieldNames: string read GetIndexFieldNames write SetIndexFieldNames stored false;
     property IndexName: string read GetIndexName write SetIndexName;
     property MasterFields: string read GetMasterFields write SetMasterFields;
     property MasterSource: TDataSource read GetDataSource write SetDataSource;
@@ -460,7 +465,7 @@ uses
   Types,
   dbf_wtil,
 {$endif}
-{$ifdef DELPHI_6}
+{$ifdef SUPPORT_SEPARATE_VARIANTS_UNIT}
   Variants,
 {$endif}
   dbf_idxcur,
@@ -706,24 +711,11 @@ begin
   if Field.FieldNo>0 then
   begin
     Result := FDbfFile.GetFieldData(Field.FieldNo-1, Field.DataType, Src, Buffer);
-  end else begin { calculated fields.... }
+  end else begin { weird calculated fields voodoo (from dbtables).... }
     Inc(PChar(Src), Field.Offset + GetRecordSize);
-//    Result := Boolean(PChar(Buffer)[0]);
-    Result := true;
-    if {Result and  (Src <> nil) and } (Buffer <> nil) then
-    begin
-      // A ftBoolean was 1 byte in Delphi 3
-      // it is now 2 byte in Delphi 5
-      // not sure about delphi 4.
-{$ifdef DELPHI_5}
-        Move(Src^, Buffer^, Field.DataSize);
-{$else}
-      if Field.DataType = ftBoolean then
-        Move(Src^, Buffer^, 1)
-      else
-        Move(Src^, Buffer^, Field.DataSize);
-{$endif}
-    end;
+    Result := Boolean(Src[0]);
+    if Result and (Buffer <> nil) then
+      Move(Src[1], Buffer^, Field.DataSize);
   end;
 end;
 
@@ -822,6 +814,11 @@ begin
 
     if (Result = grOK) and acceptable then
     begin
+      pRecord^.BookmarkData.PhysicalRecNo := FCursor.PhysicalRecNo;
+      pRecord^.BookmarkFlag := bfCurrent;
+      pRecord^.SequentialRecNo := FCursor.SequentialRecNo;
+      GetCalcFields(Buffer);
+
       if Filtered or FFindRecordFilter then
       begin
         FFilterBuffer := Buffer;
@@ -835,15 +832,8 @@ begin
       Result := grError;
   until (Result <> grOK) or acceptable;
 
-  if (Result = grOK) and not FFindRecordFilter then
-  begin
-    pRecord^.BookmarkData.PhysicalRecNo := FCursor.PhysicalRecNo;
-    pRecord^.BookmarkFlag := bfCurrent;
-    pRecord^.SequentialRecNo := FCursor.SequentialRecNo;
-    GetCalcFields(Buffer);
-  end else begin
+  if Result <> grOK then
     pRecord^.BookmarkData.PhysicalRecNo := -1;
-  end;
 end;
 
 function TDbf.GetRecordSize: Word; {override virtual abstract from TDataset}
@@ -1554,13 +1544,18 @@ begin
       lSrcField := DataSet.Fields[I];
       with lFieldDefs.AddFieldDef do
       begin
-        FieldName := lSrcField.Name;
+        if Length(lSrcField.Name) > 0 then
+          FieldName := lSrcField.Name
+        else
+          FieldName := lSrcField.FieldName;
         FieldType := lSrcField.DataType;
         Required := lSrcField.Required;
-        Size := lSrcField.Size;
-        if (0 <= lSrcField.FieldNo) 
-            and (lSrcField.FieldNo < lPhysFieldDefs.Count) then
-          Precision := lPhysFieldDefs.Items[lSrcField.FieldNo].Precision;
+        if (1 <= lSrcField.FieldNo) 
+            and (lSrcField.FieldNo <= lPhysFieldDefs.Count) then
+        begin
+          Size := lPhysFieldDefs.Items[lSrcField.FieldNo-1].Size;
+          Precision := lPhysFieldDefs.Items[lSrcField.FieldNo-1].Precision;
+        end;
       end;
     end;
 
@@ -1684,17 +1679,20 @@ begin
 
   DoBeforeScroll;
   saveRecNo := FCursor.SequentialRecNo;
+  FLocateRecNo := -1;
   Result := LocateRecord(KeyFields, KeyValues, Options);
   CursorPosChanged;
   if Result then
   begin
+    if FLocateRecNo <> -1 then
+      FCursor.PhysicalRecNo := FLocateRecNo;
     Resync([]);
     DoAfterScroll;
   end else
     FCursor.SequentialRecNo := saveRecNo;
 end;
 
-function TDbf.LocateRecord(const KeyFields: String; const KeyValues: Variant;
+function TDbf.LocateRecordLinear(const KeyFields: String; const KeyValues: Variant;
     Options: TLocateOptions): Boolean;
 var
   lstKeys              : TList;
@@ -1703,7 +1701,6 @@ var
   bMatchedData         : Boolean;
   bVarIsArray          : Boolean;
   varCompare           : Variant;
-  doLinSearch          : Boolean;
 
   function CompareValues: Boolean;
   var
@@ -1740,96 +1737,138 @@ var
   end;
 
 var
-  searchFlag: TSearchKeyType;
-  lPhysRecNo, matchRes: Integer;
   SaveState: TDataSetState;
-  lTempBuffer: array [0..100] of Char;
-
+  lPhysRecNo: integer;
 begin
   Result := false;
-  doLinSearch := true;
-  // index active?
-  if FCursor is TIndexCursor then
-  begin
-    // matches field to search on?
-    if TIndexCursor(FCursor).IndexFile.Expression = KeyFields then
+  bVarIsArray := false;
+  lstKeys := TList.Create;
+  FFilterBuffer := TempBuffer;
+  SaveState := SetTempState(dsFilter);
+  try
+    GetFieldList(lstKeys, KeyFields);
+    if VarArrayDimCount(KeyValues) = 0 then
+      bMatchedData := lstKeys.Count = 1
+    else if VarArrayDimCount (KeyValues) = 1 then
     begin
-      // can do index search
-      doLinSearch := false;
-      if loPartialKey in Options then
-        searchFlag := stGreaterEqual
-      else
-        searchFlag := stEqual;
-      TIndexCursor(FCursor).VariantToBuffer(KeyValues, @lTempBuffer[0]);
-      Result := FIndexFile.SearchKey(@lTempBuffer[0], searchFlag);
-      if Result then
+      bMatchedData := VarArrayHighBound (KeyValues,1) + 1 = lstKeys.Count;
+      bVarIsArray := true;
+    end else
+      bMatchedData := false;
+    if bMatchedData then
+    begin
+      FCursor.First;
+      while not Result and FCursor.Next do
       begin
-        Result := GetRecord(TempBuffer, gmCurrent, false) = grOK;
-        if not Result then
+        lPhysRecNo := FCursor.PhysicalRecNo;
+        if (lPhysRecNo = 0) or not FDbfFile.IsRecordPresent(lPhysRecNo) then
+          break;
+        
+        FDbfFile.ReadRecord(lPhysRecNo, @PDbfRecord(FFilterBuffer)^.DeletedFlag);
+        Result := FShowDeleted or (PDbfRecord(FFilterBuffer)^.DeletedFlag <> '*');
+        if Result and Filtered then
+          DoFilterRecord(Result);
+        
+        iIndex := 0;
+        while Result and (iIndex < lstKeys.Count) Do
         begin
-          Result := GetRecord(TempBuffer, gmNext, false) = grOK;
-          if Result then
-          begin
-            matchRes := TIndexCursor(FCursor).IndexFile.MatchKey(@lTempBuffer[0]);
-            if loPartialKey in Options then
-              Result := matchRes <= 0
-            else
-              Result := matchRes =  0;
-          end;
+          Field := TField (lstKeys [iIndex]);
+          if bVarIsArray then
+            varCompare := KeyValues [iIndex]
+          else
+            varCompare := KeyValues;
+          Result := CompareValues;
+          Inc(iIndex);
         end;
-        FFilterBuffer := TempBuffer;
       end;
     end;
+  finally
+    lstKeys.Free;
+    RestoreState(SaveState);
   end;
+end;
 
-  if doLinSearch then
+function TDbf.LocateRecordIndex(const KeyFields: String; const KeyValues: Variant;
+    Options: TLocateOptions): Boolean;
+var
+  searchFlag: TSearchKeyType;
+  matchRes: Integer;
+  lTempBuffer: array [0..100] of Char;
+begin
+  if loPartialKey in Options then
+    searchFlag := stGreaterEqual
+  else
+    searchFlag := stEqual;
+  TIndexCursor(FCursor).VariantToBuffer(KeyValues, @lTempBuffer[0]);
+  Result := FIndexFile.SearchKey(@lTempBuffer[0], searchFlag);
+  if Result then
   begin
-    bVarIsArray := false;
-    lstKeys := TList.Create;
-    FFilterBuffer := TempBuffer;
-    SaveState := SetTempState(dsFilter);
-    try
-      GetFieldList(lstKeys, KeyFields);
-      if VarArrayDimCount(KeyValues) = 0 then
-        bMatchedData := lstKeys.Count = 1
-      else if VarArrayDimCount (KeyValues) = 1 then
+    Result := GetRecord(TempBuffer, gmCurrent, false) = grOK;
+    if not Result then
+    begin
+      Result := GetRecord(TempBuffer, gmNext, false) = grOK;
+      if Result then
       begin
-        bMatchedData := VarArrayHighBound (KeyValues,1) + 1 = lstKeys.Count;
-        bVarIsArray := true;
-      end else
-        bMatchedData := false;
-      if bMatchedData then
+        matchRes := TIndexCursor(FCursor).IndexFile.MatchKey(@lTempBuffer[0]);
+        if loPartialKey in Options then
+          Result := matchRes <= 0
+        else
+          Result := matchRes =  0;
+      end;
+    end;
+    FFilterBuffer := TempBuffer;
+  end;
+end;
+
+function TDbf.LocateRecord(const KeyFields: String; const KeyValues: Variant;
+    Options: TLocateOptions): Boolean;
+var
+  lCursor, lSaveCursor: TVirtualCursor;
+  lSaveIndexName, lIndexName: string;
+  lIndexDef: TDbfIndexDef;
+  lIndexFile, lSaveIndexFile: TIndexFile;
+begin
+  lCursor := nil;
+  lSaveCursor := nil;
+  lIndexFile := nil;
+  lSaveIndexFile := FIndexFile;
+  if (FCursor is TIndexCursor) 
+    and (TIndexCursor(FCursor).IndexFile.Expression = KeyFields) then
+  begin
+    lCursor := FCursor;
+  end else begin
+    lIndexDef := FIndexDefs.GetIndexByField(KeyFields);
+    if lIndexDef <> nil then
+    begin
+      lIndexName := ParseIndexName(lIndexDef.IndexFile);
+      lIndexFile := FDbfFile.GetIndexByName(lIndexName);
+      if lIndexFile <> nil then
       begin
-        FCursor.First;
-        while not Result and FCursor.Next do
-        begin
-          lPhysRecNo := FCursor.PhysicalRecNo;
-          if (lPhysRecNo = 0) or not FDbfFile.IsRecordPresent(lPhysRecNo) then
-            break;
-          
-          FDbfFile.ReadRecord(lPhysRecNo, @PDbfRecord(FFilterBuffer)^.DeletedFlag);
-          Result := FShowDeleted or (PDbfRecord(FFilterBuffer)^.DeletedFlag <> '*');
-          if Result and Filtered then
-            DoFilterRecord(Result);
-          
-          iIndex := 0;
-          while Result and (iIndex < lstKeys.Count) Do
-          begin
-            Field := TField (lstKeys [iIndex]);
-            if bVarIsArray then
-              varCompare := KeyValues [iIndex]
-            else
-              varCompare := KeyValues;
-            Result := CompareValues;
-            Inc(iIndex);
-          end;
-        end;
+        lSaveCursor := FCursor;
+        lCursor := TIndexCursor.Create(lIndexFile);
+        lSaveIndexName := lIndexFile.IndexName;
+        lIndexFile.IndexName := lIndexName;
+        FIndexFile := lIndexFile;
       end;
-    finally
-      lstKeys.Free;
-      RestoreState(SaveState);
     end;
   end;
+  if lCursor <> nil then
+  begin
+    FCursor := lCursor;
+    Result := LocateRecordIndex(KeyFields, KeyValues, Options);
+    if lSaveCursor <> nil then
+    begin
+      FCursor.Free;
+      FCursor := lSaveCursor;
+    end;
+    if lIndexFile <> nil then
+    begin
+      FLocateRecNo := FIndexFile.PhysicalRecNo;
+      lIndexFile.IndexName := lSaveIndexName;
+      FIndexFile := lSaveIndexFile;
+    end;
+  end else
+    Result := LocateRecordLinear(KeyFields, KeyValues, Options);
 end;
 
 {$endif}
@@ -2030,26 +2069,18 @@ end;
 
 procedure TDbf.SetFieldData(Field: TField; Buffer: Pointer); {override virtual abstract from TDataset}
 var
-  pRecord: pDbfRecord;
-  Dst: Pointer;
+  Dst: PChar;
 begin
   if (Field.FieldNo >= 0) then
   begin
-    pRecord := pDbfRecord(ActiveBuffer);
-    dst := @pRecord^.DeletedFlag;
+    Dst := @PDbfRecord(ActiveBuffer)^.DeletedFlag;
     FDbfFile.SetFieldData(Field.FieldNo - 1,Field.DataType,Buffer,Dst);
   end else begin    { ***** fkCalculated, fkLookup ***** }
-    pRecord := pDbfRecord(CalcBuffer);
-    Dst := @pRecord^.DeletedFlag;
+    Dst := @PDbfRecord(CalcBuffer)^.DeletedFlag;
     Inc(PChar(Dst), RecordSize + Field.Offset);
-//    Boolean(dst^) := LongBool(Buffer);
-//    if Boolean(dst^) then begin
-//      Inc(Integer(dst), 1);
+    Boolean(Dst[0]) := Buffer <> nil;
     if Buffer <> nil then
-      Move(Buffer^, Dst^, Field.DataSize)
-    else
-      FillChar(Dst^, Field.DataSize, #0);
-//    end;
+      Move(Buffer^, Dst[1], Field.DataSize)
   end;     { end of ***** fkCalculated, fkLookup ***** }
   if not (State in [dsCalcFields, dsFilter, dsNewValue]) then begin
     DataEvent(deFieldChange, PtrInt(Field));
@@ -2667,7 +2698,7 @@ function TDbf.SearchKeyPChar(Key: PChar; SearchType: TSearchKeyType): Boolean;
 var
   StringBuf: array [0..100] of Char;
 begin
-  if FIndexFile = nil then
+  if FCursor = nil then
   begin
     Result := false;
     exit;

fcl/db/dbase/dbf_common.inc

@@ -190,6 +190,7 @@
 {$ifdef DELPHI_6}
 
   {$define SUPPORT_PATHDELIM}
+  {$define SUPPORT_SEPARATE_VARIANTS_UNIT}
 
 {$endif}
 {$endif}
@@ -226,6 +227,8 @@
   {$define SUPPORT_UINT32_CARDINAL}
   {$define SUPPORT_REINTRODUCE}
   {$define SUPPORT_MATH_UNIT}
+  {$define SUPPORT_VARIANTS}
+  {$define SUPPORT_SEPARATE_VARIANTS_UNIT}
 
   // FPC 2.0.x improvements
   {$ifdef VER2}

fcl/db/dbase/dbf_common.pas

@@ -22,6 +22,8 @@ const
 
   TDBF_TABLELEVEL_FOXPRO = 25;
 
+  JulianDateDelta = 1721425; { number of days between 1.1.4714 BC and "0" }
+
 type
   EDbfError = class (EDatabaseError);
   EDbfWriteError = class (EDbfError);

fcl/db/dbase/dbf_dbffile.pas

@@ -1146,9 +1146,8 @@ var
   TempDstDef, TempSrcDef: TDbfFieldDef;
   OldIndexFiles: TStrings;
   IndexName, NewBaseName: string;
-  I, lRecNo, lFieldNo, lFieldSize, lBlobRecNo, lWRecNo, srcOffset, dstOffset: Integer;
+  I, lRecNo, lFieldNo, lFieldSize, lBlobPageNo, lWRecNo, srcOffset, dstOffset: Integer;
   pBuff, pDestBuff: PChar;
-  pBlobRecNoBuff: array[1..11] of Char;
   RestructFieldInfo: PRestructFieldInfo;
   BlobStream: TMemoryStream;
 begin
@@ -1303,19 +1302,18 @@ begin
             if TempDstDef.IsBlob and ((DbfFieldDefs = nil) or (TempDstDef.CopyFrom >= 0)) then
             begin
               // get current blob blockno
-              GetFieldData(lFieldNo, ftString, pBuff, @pBlobRecNoBuff[1]);
-              lBlobRecNo := StrToIntDef(pBlobRecNoBuff, -1);
+              GetFieldData(lFieldNo, ftInteger, pBuff, @lBlobPageNo);
               // valid blockno read?
-              if lBlobRecNo >= 0 then
+              if lBlobPageNo > 0 then
               begin
                 BlobStream.Clear;
-                FMemoFile.ReadMemo(lBlobRecNo, BlobStream);
+                FMemoFile.ReadMemo(lBlobPageNo, BlobStream);
                 BlobStream.Position := 0;
                 // always append
-                DestDbfFile.FMemoFile.WriteMemo(lBlobRecNo, 0, BlobStream);
+                DestDbfFile.FMemoFile.WriteMemo(lBlobPageNo, 0, BlobStream);
               end;
               // write new blockno
-              DestDbfFile.SetFieldData(lFieldNo, ftInteger, @lBlobRecNo, pDestBuff);
+              DestDbfFile.SetFieldData(lFieldNo, ftInteger, @lBlobPageNo, pDestBuff);
             end else if (DbfFieldDefs <> nil) and (TempDstDef.CopyFrom >= 0) then
             begin
               // copy content of field
@@ -1497,6 +1495,7 @@ begin
   FieldSize := AFieldDef.Size;
   Src := PChar(Src) + FieldOffset;
   asciiContents := false;
+  Result := true;
   // field types that are binary and of which the fieldsize should not be truncated
   case AFieldDef.NativeFieldType of
     '+', 'I':
@@ -1549,7 +1548,7 @@ begin
         Result := (PInteger(Src)^ <> 0) or (PInteger(PChar(Src)+4)^ <> 0);
         if Result and (Dst <> nil) then
         begin
-          timeStamp.Date := PInteger(Src)^ - 1721425;
+          timeStamp.Date := PInteger(Src)^ - JulianDateDelta;
           timeStamp.Time := PInteger(PChar(Src)+4)^;
           date := TimeStampToDateTime(timeStamp);
           SaveDateToDst;
@@ -1803,7 +1802,7 @@ begin
         end else begin
           LoadDateFromSrc;
           timeStamp := DateTimeToTimeStamp(date);
-          PInteger(Dst)^ := timeStamp.Date + 1721425;
+          PInteger(Dst)^ := timeStamp.Date + JulianDateDelta;
           PInteger(PChar(Dst)+4)^ := timeStamp.Time;
         end;
       end;
@@ -2129,42 +2128,47 @@ begin
       // always uppercase index expression
       IndexField := AnsiUpperCase(IndexField);
       try
-        // create index if asked
-        lIndexFile.CreateIndex(IndexField, IndexName, Options);
-        // add all records
-        PackIndex(lIndexFile, IndexName);
-        // if we wanted to open index readonly, but we created it, then reopen
-        if Mode = pfReadOnly then
-        begin
-          lIndexFile.CloseFile;
-          lIndexFile.Mode := pfReadOnly;
-          lIndexFile.OpenFile;
-        end;
-        // if mdx file just created, write changes to dbf header
-        // set MDX flag to true
-        PDbfHdr(Header)^.MDXFlag := 1;
-        WriteHeader;
-      except
-        // :-( need to undo 'damage'....
-        // remove index from list(s) if just added
-        if addedIndexFile >= 0 then
-          FIndexFiles.Delete(addedIndexFile);
-        if addedIndexName >= 0 then
-          FIndexNames.Delete(addedIndexName);
-        // delete index file itself
-        lIndexFile.DeleteIndex(IndexName);
-        // if no file created, do not destroy!
-        if addedIndexFile >= 0 then
-        begin
-          lIndexFile.Close;
-          Sysutils.DeleteFile(lIndexFileName);
-          if FMdxFile = lIndexFile then
-            FMdxFile := nil;
-          lIndexFile.Free;
+        try
+          // create index if asked
+          lIndexFile.CreateIndex(IndexField, IndexName, Options);
+          // add all records
+          PackIndex(lIndexFile, IndexName);
+          // if we wanted to open index readonly, but we created it, then reopen
+          if Mode = pfReadOnly then
+          begin
+            lIndexFile.CloseFile;
+            lIndexFile.Mode := pfReadOnly;
+            lIndexFile.OpenFile;
+          end;
+          // if mdx file just created, write changes to dbf header
+          // set MDX flag to true
+          PDbfHdr(Header)^.MDXFlag := 1;
+          WriteHeader;
+        except
+          on EDbfError do
+          begin
+            // :-( need to undo 'damage'....
+            // remove index from list(s) if just added
+            if addedIndexFile >= 0 then
+              FIndexFiles.Delete(addedIndexFile);
+            if addedIndexName >= 0 then
+              FIndexNames.Delete(addedIndexName);
+            // if no file created, do not destroy!
+            if addedIndexFile >= 0 then
+            begin
+              lIndexFile.Close;
+              Sysutils.DeleteFile(lIndexFileName);
+              if FMdxFile = lIndexFile then
+                FMdxFile := nil;
+              lIndexFile.Free;
+            end;
+            raise;
+          end;
         end;
+      finally
+        // return to previous mode
+        if TempMode <> pfNone then EndExclusive;
       end;
-      // return to previous mode
-      if TempMode <> pfNone then EndExclusive;
     end;
   end;
 end;
@@ -2203,24 +2207,35 @@ begin
   if lIndexFile.CacheSize < 16384 * 1024 then
     lIndexFile.CacheSize := 16384 * 1024;
 {$endif}
-  while cur <= last do
-  begin
-    ReadRecord(cur, FPrevBuffer);
-    lIndexFile.Insert(cur, FPrevBuffer);
-    inc(cur);
-  end;
-  // restore previous mode
+  try
+    try
+      while cur <= last do
+      begin
+        ReadRecord(cur, FPrevBuffer);
+        lIndexFile.Insert(cur, FPrevBuffer);
+        inc(cur);
+      end;
+    except
+      on E: EDbfError do
+      begin
+        lIndexFile.DeleteIndex(lIndexFile.IndexName);
+        raise;
+      end;
+    end;
+  finally
+    // restore previous mode
 {$ifdef USE_CACHE}
-  BufferAhead := false;
-  lIndexFile.BufferAhead := true;
+    BufferAhead := false;
+    lIndexFile.BufferAhead := true;
 {$endif}
-  lIndexFile.Flush;
+    lIndexFile.Flush;
 {$ifdef USE_CACHE}
-  lIndexFile.BufferAhead := false;
-  lIndexFile.CacheSize := prevCache;
+    lIndexFile.BufferAhead := false;
+    lIndexFile.CacheSize := prevCache;
 {$endif}
-  lIndexFile.UpdateMode := prevMode;
-  lIndexFile.IndexName := prevIndex;
+    lIndexFile.UpdateMode := prevMode;
+    lIndexFile.IndexName := prevIndex;
+  end;
 end;
 
 procedure TDbfFile.RepageIndex(AIndexFile: string);
@@ -2690,8 +2705,11 @@ begin
 {$ifdef WIN32}
   FUserNameLen := MAX_COMPUTERNAME_LENGTH+1;
   SetLength(FUserName, FUserNameLen);
-//  Windows.GetUserName(@FUserName[0], FUserNameLen);
-  Windows.GetComputerName(PChar(FUserName), FUserNameLen);
+  Windows.GetComputerName(PChar(FUserName), 
+    {$ifdef DELPHI_3}Windows.DWORD({$endif}
+      FUserNameLen
+    {$ifdef DELPHI_3}){$endif}
+    );
   SetLength(FUserName, FUserNameLen);
 {$else}  
 {$ifdef FPC}

fcl/db/dbase/dbf_fields.pas

@@ -258,7 +258,10 @@ begin
   // convert VCL fieldtypes to native DBF fieldtypes
   VCLToNative;
   // for integer / float fields try fill in size/precision
-  CheckSizePrecision;
+  if FSize = 0 then
+    SetDefaultSize
+  else
+    CheckSizePrecision;
   // VCL does not have default value support
   AllocBuffers;
   FHasDefault := false;
@@ -430,7 +433,7 @@ begin
     ftFloat:
       begin
         FSize := 18;
-        FPrecision := 9;
+        FPrecision := 8;
       end;
     ftCurrency, ftBCD:
       begin

fcl/db/dbase/dbf_idxfile.pas

@@ -2916,6 +2916,9 @@ end;
 
 procedure TIndexFile.InsertKey(Buffer: PChar);
 begin
+  // ignore deleted records
+  if (FModifyMode = mmNormal) and (FUniqueMode = iuDistinct) and (Buffer^ = '*') then
+    exit;
   // check proper index and modifiability
   if FCanEdit and (PIndexHdr(FIndexHeader)^.KeyLen <> 0) then
   begin

fcl/db/dbase/dbf_parser.pas

@@ -208,6 +208,7 @@ type
     FFieldDef: TDbfFieldDef;
     FDbfFile: TDbfFile;
     FFieldName: string;
+    FExprWord: TExprWord;
   protected
     function GetFieldVal: Pointer; virtual; abstract;
     function GetFieldType: TExpressionType; virtual; abstract;
@@ -857,7 +858,7 @@ begin
     if Args[1][arg1len-1] = '*' then
     begin
       arg0len := StrLen(Args[0]);
-      match := arg1len >= arg0len - 1;
+      match := arg0len >= arg1len - 1;
       if match then
         match := AnsiStrLIComp(Args[0], Args[1], arg1len-1) = 0;
     end else begin
@@ -923,7 +924,7 @@ begin
     if Args[1][arg1len-1] = '*' then
     begin
       arg0len := StrLen(Args[0]);
-      match := arg1len >= arg0len - 1;
+      match := arg0len >= arg1len - 1;
       if match then
         match := AnsiStrLComp(Args[0], Args[1], arg1len-1) = 0;
     end else begin
@@ -1355,8 +1356,6 @@ begin
     // clear and regenerate functions
     FCaseInsensitive := NewInsensitive;
     FillExpressList;
-    if Length(Expression) > 0 then
-      ParseExpression(Expression);
   end;
 end;
 
@@ -1367,8 +1366,6 @@ begin
     // refill function list
     FPartialMatch := NewPartialMatch;
     FillExpressList;
-    if Length(Expression) > 0 then
-      ParseExpression(Expression);
   end;
 end;
 
@@ -1384,7 +1381,11 @@ begin
 end;
 
 procedure TDbfParser.FillExpressList;
+var
+  lExpression: string;
 begin
+  lExpression := FCurrentExpression;
+  ClearExpressions;
   FWordsList.FreeAll;
   FWordsList.AddList(DbfWordsGeneralList, 0, DbfWordsGeneralList.Count - 1);
   if FCaseInsensitive then
@@ -1405,6 +1406,8 @@ begin
       FWordsList.AddList(DbfWordsSensNoPartialList, 0, DbfWordsSensNoPartialList.Count - 1);
     end;
   end;
+  if Length(lExpression) > 0 then
+    ParseExpression(lExpression);
 end;
 
 function TDbfParser.GetVariableInfo(VarName: string): TDbfFieldDef;
@@ -1430,46 +1433,39 @@ begin
         begin
           { raw string fields have fixed length, not null-terminated }
           TempFieldVar := TRawStringFieldVar.Create(FieldInfo, TDbfFile(FDbfFile));
-          DefineStringVariableFixedLen(VarName, TempFieldVar.FieldVal, FieldInfo.Size);
+          TempFieldVar.FExprWord := DefineStringVariableFixedLen(VarName, TempFieldVar.FieldVal, FieldInfo.Size);
         end else begin
           { ansi string field function translates and null-terminates field value }
           TempFieldVar := TAnsiStringFieldVar.Create(FieldInfo, TDbfFile(FDbfFile));
-          DefineStringVariable(VarName, TempFieldVar.FieldVal);
+          TempFieldVar.FExprWord := DefineStringVariable(VarName, TempFieldVar.FieldVal);
         end;
       end;
     ftBoolean:
       begin
         TempFieldVar := TBooleanFieldVar.Create(FieldInfo, TDbfFile(FDbfFile));
-        DefineBooleanVariable(VarName, TempFieldVar.FieldVal);
+        TempFieldVar.FExprWord := DefineBooleanVariable(VarName, TempFieldVar.FieldVal);
       end;
     ftFloat:
       begin
         TempFieldVar := TFloatFieldVar.Create(FieldInfo, TDbfFile(FDbfFile));
-        DefineFloatVariable(VarName, TempFieldVar.FieldVal);
+        TempFieldVar.FExprWord := DefineFloatVariable(VarName, TempFieldVar.FieldVal);
       end;
     ftAutoInc, ftInteger, ftSmallInt:
       begin
         TempFieldVar := TIntegerFieldVar.Create(FieldInfo, TDbfFile(FDbfFile));
-        DefineIntegerVariable(VarName, TempFieldVar.FieldVal);
-      end;
-{
-    ftSmallInt:
-      begin
-        TempFieldVar := TSmallIntFieldVar.Create(FieldInfo, TDbfFile(FDbfFile));
-        DefineSmallIntVariable(VarName, TempFieldVar.FieldVal);
+        TempFieldVar.FExprWord := DefineIntegerVariable(VarName, TempFieldVar.FieldVal);
       end;
-}
 {$ifdef SUPPORT_INT64}
     ftLargeInt:
       begin
         TempFieldVar := TLargeIntFieldVar.Create(FieldInfo, TDbfFile(FDbfFile));
-        DefineLargeIntVariable(VarName, TempFieldVar.FieldVal);
+        TempFieldVar.FExprWord := DefineLargeIntVariable(VarName, TempFieldVar.FieldVal);
       end;
 {$endif}
     ftDate, ftDateTime:
       begin
         TempFieldVar := TDateTimeFieldVar.Create(FieldInfo, TDbfFile(FDbfFile));
-        DefineDateTimeVariable(VarName, TempFieldVar.FieldVal);
+        TempFieldVar.FExprWord := DefineDateTimeVariable(VarName, TempFieldVar.FieldVal);
       end;
   else
     raise EDbfError.CreateFmt(STRING_INDEX_BASED_ON_INVALID_FIELD, [VarName]);
@@ -1497,7 +1493,7 @@ begin
     for I := 0 to FFieldVarList.Count - 1 do
     begin
       // replacing with nil = undefining variable
-      ReplaceFunction(TFieldVar(FFieldVarList.Objects[I]).FieldName, nil);
+      FWordsList.DoFree(TFieldVar(FFieldVarList.Objects[I]).FExprWord);
       TFieldVar(FFieldVarList.Objects[I]).Free;
     end;
     FFieldVarList.Clear;
@@ -1509,7 +1505,7 @@ end;
 
 procedure TDbfParser.ParseExpression(AExpression: string);
 var
-  TempBuffer: array[0..4000] of Char;
+  TempBuffer: pchar;
 begin
   // clear any current expression
   ClearExpressions;
@@ -1525,8 +1521,13 @@ begin
     if ResultType = etString then
     begin
       // make empty record
-      TDbfFile(FDbfFile).InitRecord(@TempBuffer[0]);
-      FResultLen := StrLen(ExtractFromBuffer(@TempBuffer[0]));
+      GetMem(TempBuffer, TDbfFile(FDbfFile).RecordSize);
+      try
+        TDbfFile(FDbfFile).InitRecord(TempBuffer);
+        FResultLen := StrLen(ExtractFromBuffer(TempBuffer));
+      finally
+        FreeMem(TempBuffer);
+      end;
     end;
   end else begin
     // simple field, create field variable for it

fcl/db/dbase/dbf_prscore.pas

@@ -58,7 +58,6 @@ type
 
     procedure CompileExpression(AnExpression: string);
     procedure EvaluateCurrent;
-    procedure ReplaceExprWord(OldExprWord, NewExprWord: TExprWord); virtual;
     procedure DisposeList(ARec: PExpressionRec);
     procedure DisposeTree(ExprRec: PExpressionRec);
     function CurrentExpression: string; virtual; abstract;
@@ -73,20 +72,18 @@ type
     constructor Create;
     destructor Destroy; override;
 
-    procedure AddReplaceExprWord(AExprWord: TExprWord);
-    procedure DefineFloatVariable(AVarName: string; AValue: PDouble);
-    procedure DefineIntegerVariable(AVarName: string; AValue: PInteger);
+    function DefineFloatVariable(AVarName: string; AValue: PDouble): TExprWord;
+    function DefineIntegerVariable(AVarName: string; AValue: PInteger): TExprWord;
 //    procedure DefineSmallIntVariable(AVarName: string; AValue: PSmallInt);
 {$ifdef SUPPORT_INT64}
-    procedure DefineLargeIntVariable(AVarName: string; AValue: PLargeInt);
+    function DefineLargeIntVariable(AVarName: string; AValue: PLargeInt): TExprWord;
 {$endif}
-    procedure DefineDateTimeVariable(AVarName: string; AValue: PDateTimeRec);
-    procedure DefineBooleanVariable(AVarName: string; AValue: PBoolean);
-    procedure DefineStringVariable(AVarName: string; AValue: PPChar);
-    procedure DefineStringVariableFixedLen(AVarName: string; AValue: PPChar; ALength: Integer);
-    procedure DefineFunction(AFunctName, AShortName, ADescription, ATypeSpec: string;
-        AMinFunctionArg: Integer; AResultType: TExpressionType; AFuncAddress: TExprFunc);
-    procedure ReplaceFunction(OldName: string; AFunction: TObject);
+    function DefineDateTimeVariable(AVarName: string; AValue: PDateTimeRec): TExprWord;
+    function DefineBooleanVariable(AVarName: string; AValue: PBoolean): TExprWord;
+    function DefineStringVariable(AVarName: string; AValue: PPChar): TExprWord;
+    function DefineStringVariableFixedLen(AVarName: string; AValue: PPChar; ALength: Integer): TExprWord;
+    function DefineFunction(AFunctName, AShortName, ADescription, ATypeSpec: string;
+        AMinFunctionArg: Integer; AResultType: TExpressionType; AFuncAddress: TExprFunc): TExprWord;
     procedure Evaluate(AnExpression: string);
     function AddExpression(AnExpression: string): Integer;
     procedure ClearExpressions; virtual;
@@ -897,56 +894,56 @@ begin
   end;
 end;
 
-procedure TCustomExpressionParser.DefineFunction(AFunctName, AShortName, ADescription, ATypeSpec: string;
-  AMinFunctionArg: Integer; AResultType: TExpressionType; AFuncAddress: TExprFunc);
+function TCustomExpressionParser.DefineFunction(AFunctName, AShortName, ADescription, ATypeSpec: string;
+  AMinFunctionArg: Integer; AResultType: TExpressionType; AFuncAddress: TExprFunc): TExprWord;
 begin
-  AddReplaceExprWord(TFunction.Create(AFunctName, AShortName, ATypeSpec, AMinFunctionArg, AResultType, AFuncAddress, ADescription));
+  Result := TFunction.Create(AFunctName, AShortName, ATypeSpec, AMinFunctionArg, AResultType, AFuncAddress, ADescription);
+  FWordsList.Add(Result);
 end;
 
-procedure TCustomExpressionParser.DefineIntegerVariable(AVarName: string; AValue: PInteger);
+function TCustomExpressionParser.DefineIntegerVariable(AVarName: string; AValue: PInteger): TExprWord;
 begin
-  AddReplaceExprWord(TIntegerVariable.Create(AVarName, AValue));
+  Result := TIntegerVariable.Create(AVarName, AValue);
+  FWordsList.Add(Result);
 end;
 
-{
-procedure TCustomExpressionParser.DefineSmallIntVariable(AVarName: string; AValue: PSmallInt);
-begin
-  AddReplaceExprWord(TSmallIntVariable.Create(AVarName, AValue));
-end;
-}
-
 {$ifdef SUPPORT_INT64}
 
-procedure TCustomExpressionParser.DefineLargeIntVariable(AVarName: string; AValue: PLargeInt);
+function TCustomExpressionParser.DefineLargeIntVariable(AVarName: string; AValue: PLargeInt): TExprWord;
 begin
-  AddReplaceExprWord(TLargeIntVariable.Create(AVarName, AValue));
+  Result := TLargeIntVariable.Create(AVarName, AValue);
+  FWordsList.Add(Result);
 end;
 
 {$endif}
 
-procedure TCustomExpressionParser.DefineDateTimeVariable(AVarName: string; AValue: PDateTimeRec);
+function TCustomExpressionParser.DefineDateTimeVariable(AVarName: string; AValue: PDateTimeRec): TExprWord;
 begin
-  AddReplaceExprWord(TDateTimeVariable.Create(AVarName, AValue));
+  Result := TDateTimeVariable.Create(AVarName, AValue);
+  FWordsList.Add(Result);
 end;
 
-procedure TCustomExpressionParser.DefineBooleanVariable(AVarName: string; AValue: PBoolean);
+function TCustomExpressionParser.DefineBooleanVariable(AVarName: string; AValue: PBoolean): TExprWord;
 begin
-  AddReplaceExprWord(TBooleanVariable.Create(AVarName, AValue));
+  Result := TBooleanVariable.Create(AVarName, AValue);
+  FWordsList.Add(Result);
 end;
 
-procedure TCustomExpressionParser.DefineFloatVariable(AVarName: string; AValue: PDouble);
+function TCustomExpressionParser.DefineFloatVariable(AVarName: string; AValue: PDouble): TExprWord;
 begin
-  AddReplaceExprWord(TFloatVariable.Create(AVarName, AValue));
+  Result := TFloatVariable.Create(AVarName, AValue);
+  FWordsList.Add(Result);
 end;
 
-procedure TCustomExpressionParser.DefineStringVariable(AVarName: string; AValue: PPChar);
+function TCustomExpressionParser.DefineStringVariable(AVarName: string; AValue: PPChar): TExprWord;
 begin
-  DefineStringVariableFixedLen(AVarName, AValue, -1);
+  Result := DefineStringVariableFixedLen(AVarName, AValue, -1);
 end;
 
-procedure TCustomExpressionParser.DefineStringVariableFixedLen(AVarName: string; AValue: PPChar; ALength: Integer);
+function TCustomExpressionParser.DefineStringVariableFixedLen(AVarName: string; AValue: PPChar; ALength: Integer): TExprWord;
 begin
-  AddReplaceExprWord(TStringVariable.Create(AVarName, AValue, ALength));
+  Result := TStringVariable.Create(AVarName, AValue, ALength);
+  FWordsList.Add(Result);
 end;
 
 {
@@ -977,32 +974,6 @@ begin
   end;
 end;
 
-procedure TCustomExpressionParser.ReplaceExprWord(OldExprWord, NewExprWord: TExprWord);
-var
-  J: Integer;
-  Rec: PExpressionRec;
-  p, pnew: pointer;
-begin
-  if OldExprWord.MaxFunctionArg <> NewExprWord.MaxFunctionArg then
-    raise Exception.Create('Cannot replace variable/function MaxFunctionArg doesn''t match');
-
-  p := OldExprWord.AsPointer;
-  pnew := NewExprWord.AsPointer;
-  Rec := FCurrentRec;
-  repeat
-    if (Rec^.ExprWord = OldExprWord) then
-    begin
-      Rec^.ExprWord := NewExprWord;
-      Rec^.Oper := NewExprWord.ExprFunc;
-    end;
-    if p <> nil then
-      for J := 0 to Rec^.ExprWord.MaxFunctionArg - 1 do
-        if Rec^.Args[J] = p then
-          Rec^.Args[J] := pnew;
-    Rec := Rec^.Next;
-  until Rec = nil;
-end;
-
 function TCustomExpressionParser.MakeRec: PExpressionRec;
 var
   I: Integer;
@@ -1044,26 +1015,6 @@ begin
   //CurrentIndex := Result;
 end;
 
-procedure TCustomExpressionParser.ReplaceFunction(OldName: string; AFunction:
-  TObject);
-var
-  I: Integer;
-begin
-  // clearing only allowed when expression is not present
-  if (AFunction = nil) and (FCurrentRec <> nil) then
-    raise Exception.Create('Cannot undefine function/variable while expression present');
-
-  if FWordsList.Search(PChar(OldName), I) then
-  begin
-    // if no function specified, then no need to replace!
-    if AFunction <> nil then
-      ReplaceExprWord(TExprWord(FWordsList.Items[I]), TExprWord(AFunction));
-    FWordsList.AtFree(I);
-  end;
-  if AFunction <> nil then
-    FWordsList.Add(AFunction);
-end;
-
 procedure TCustomExpressionParser.ClearExpressions;
 begin
   DisposeList(FCurrentRec);
@@ -1071,20 +1022,6 @@ begin
   FLastRec := nil;
 end;
 
-procedure TCustomExpressionParser.AddReplaceExprWord(AExprWord: TExprWord);
-var
-  IOldVar: Integer;
-begin
-  if FWordsList.Search(PChar(AExprWord.Name), IOldVar) then
-  begin
-    ReplaceExprWord(TExprWord(FWordsList.Items[IOldVar]), AExprWord);
-    FWordsList.AtFree(IOldVar);
-    FWordsList.Add(AExprWord);
-  end
-  else
-    FWordsList.Add(AExprWord);
-end;
-
 function TCustomExpressionParser.GetFunctionDescription(AFunction: string):
   string;
 var

fcl/db/dbase/history.txt

@@ -36,6 +36,19 @@ BUGS & WARNINGS
 V6.4.8
 
 - remove duplicate names, may cause ambiguity
+- allow duplicate names in function list for expressions
+- remember exprword reference for every field variable so we can remove it
+- prevent possible buffer overrun when parsing expression (thx leexgone)
+- fix some memory references in the parser
+- add ability for locate/lookup to use alternate index than current one
+- fix tdbf.copyfrom fieldname copy and fieldno index for size/precision
+- make TDbf.CheckMasterRange public so master/detail can be synced manually
+    when for example .DisableControls is active
+- allow calc/lookup fields to work in filters
+- fix loosing blobs when packing table (rep by cllerici)
+- support variants for freepascal
+- fix (filter) parser string partial matching for "A*" strings
+- make distinct index creation more robust
 
 
 ------------------------