From 46ff92bb60a346ee768a6d30c6139ad8605983c1 Mon Sep 17 00:00:00 2001 From: marco Date: Fri, 20 Jan 2006 22:38:09 +0000 Subject: [PATCH] * 64-bit patches from Neli and Andrew git-svn-id: trunk@2315 - --- fcl/db/dbase/Makefile | 29 ++++- fcl/db/dbase/Makefile.fpc | 8 ++ fcl/db/dbase/dbf.pas | 217 +++++++++++++++++++++-------------- fcl/db/dbase/dbf_avl.pas | 5 + fcl/db/dbase/dbf_common.inc | 41 ++++++- fcl/db/dbase/dbf_common.pas | 27 ++++- fcl/db/dbase/dbf_dbffile.pas | 146 ++++++++++++++++------- fcl/db/dbase/dbf_fields.pas | 32 ++++-- fcl/db/dbase/dbf_idxfile.pas | 5 +- fcl/db/dbase/dbf_memo.pas | 31 ++--- fcl/db/dbase/dbf_parser.pas | 71 ++++++------ fcl/db/dbase/dbf_pgcfile.pas | 4 +- fcl/db/dbase/history.txt | 39 +++++++ 13 files changed, 458 insertions(+), 197 deletions(-) diff --git a/fcl/db/dbase/Makefile b/fcl/db/dbase/Makefile index 0fdc9c93ef..04e43051c4 100644 --- a/fcl/db/dbase/Makefile +++ b/fcl/db/dbase/Makefile @@ -1,5 +1,5 @@ # -# Don't edit, this file is generated by FPCMake Version 2.0.0 [2006/01/13] +# Don't edit, this file is generated by FPCMake Version 2.0.0 [2006/01/20] # default: all MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-emx i386-watcom i386-netwlibc i386-wince m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos powerpc-linux powerpc-netbsd powerpc-macos powerpc-darwin powerpc-morphos sparc-linux sparc-netbsd sparc-solaris x86_64-linux x86_64-freebsd x86_64-win64 arm-linux arm-wince powerpc64-linux @@ -286,6 +286,15 @@ endif ifeq ($(FULL_TARGET),i386-wince) override TARGET_UNITS+=dbf endif +ifeq ($(FULL_TARGET),x86_64-linux) +override TARGET_UNITS+=dbf +endif +ifeq ($(FULL_TARGET),x86_64-freebsd) +override TARGET_UNITS+=dbf +endif +ifeq ($(FULL_TARGET),x86_64-win64) +override TARGET_UNITS+=dbf +endif ifeq ($(FULL_TARGET),i386-linux) override TARGET_EXAMPLES+=testdbf endif @@ -334,6 +343,15 @@ endif ifeq ($(FULL_TARGET),i386-wince) override TARGET_EXAMPLES+=testdbf endif +ifeq ($(FULL_TARGET),x86_64-linux) +override TARGET_EXAMPLES+=testdbf +endif +ifeq ($(FULL_TARGET),x86_64-freebsd) +override TARGET_EXAMPLES+=testdbf +endif +ifeq ($(FULL_TARGET),x86_64-win64) +override TARGET_EXAMPLES+=testdbf +endif ifeq ($(FULL_TARGET),i386-linux) override CLEAN_UNITS+=dbf_common dbf_cursor dbf_dbffile dbf_fields dbf_idxcur dbf_idxfile dbf_lang dbf_memo dbf_parser dbf_pgfile dbf_prscore dbf_prsdef dbf_prssupp dbf_str endif @@ -493,6 +511,15 @@ endif ifeq ($(FULL_TARGET),i386-wince) override INSTALL_UNITS+=dbf_common dbf_cursor dbf_dbffile dbf_fields dbf_idxcur dbf_idxfile dbf_lang dbf_memo dbf_parser dbf_pgfile dbf_prscore dbf_prsdef dbf_prssupp dbf_str endif +ifeq ($(FULL_TARGET),x86_64-linux) +override INSTALL_UNITS+=dbf_common dbf_cursor dbf_dbffile dbf_fields dbf_idxcur dbf_idxfile dbf_lang dbf_memo dbf_parser dbf_pgfile dbf_prscore dbf_prsdef dbf_prssupp dbf_str +endif +ifeq ($(FULL_TARGET),x86_64-freebsd) +override INSTALL_UNITS+=dbf_common dbf_cursor dbf_dbffile dbf_fields dbf_idxcur dbf_idxfile dbf_lang dbf_memo dbf_parser dbf_pgfile dbf_prscore dbf_prsdef dbf_prssupp dbf_str +endif +ifeq ($(FULL_TARGET),x86_64-win64) +override INSTALL_UNITS+=dbf_common dbf_cursor dbf_dbffile dbf_fields dbf_idxcur dbf_idxfile dbf_lang dbf_memo dbf_parser dbf_pgfile dbf_prscore dbf_prsdef dbf_prssupp dbf_str +endif override INSTALL_FPCPACKAGE=y ifeq ($(FULL_TARGET),i386-linux) override COMPILER_OPTIONS+=-S2 -Sh diff --git a/fcl/db/dbase/Makefile.fpc b/fcl/db/dbase/Makefile.fpc index 02b73cffdf..ffc930b217 100644 --- a/fcl/db/dbase/Makefile.fpc +++ b/fcl/db/dbase/Makefile.fpc @@ -9,6 +9,9 @@ main=fcl units_i386=dbf examples_i386=testdbf +units_x86_64=dbf +examples_x86_64=testdbf + [compiler] options=-S2 -Sh @@ -21,6 +24,11 @@ units_i386=dbf_common dbf_cursor dbf_dbffile dbf_fields dbf_idxcur \ dbf_idxfile dbf_lang dbf_memo dbf_parser dbf_pgfile \ dbf_prscore dbf_prsdef dbf_prssupp dbf_str + +units_x86_64=dbf_common dbf_cursor dbf_dbffile dbf_fields dbf_idxcur \ + dbf_idxfile dbf_lang dbf_memo dbf_parser dbf_pgfile \ + dbf_prscore dbf_prsdef dbf_prssupp dbf_str + [clean] units=dbf_common dbf_cursor dbf_dbffile dbf_fields dbf_idxcur \ dbf_idxfile dbf_lang dbf_memo dbf_parser dbf_pgfile \ diff --git a/fcl/db/dbase/dbf.pas b/fcl/db/dbase/dbf.pas index b49821ee35..5a26a3e3c0 100644 --- a/fcl/db/dbase/dbf.pas +++ b/fcl/db/dbase/dbf.pas @@ -348,9 +348,7 @@ type procedure CompactIndexFile(const AIndexFile: string); {$ifdef SUPPORT_VARIANTS} -{$ifdef USE_BUGGY_LOOKUP} function Lookup(const KeyFields: string; const KeyValues: Variant; const ResultFields: string): Variant; override; -{$endif} function Locate(const KeyFields: string; const KeyValues: Variant; Options: TLocateOptions): Boolean; {$ifndef FPC_VERSION}override;{$endif} {$endif} @@ -515,7 +513,7 @@ begin // TDbf(FBlobField.DataSet).SetModified(true); // is following better? seems to provide notification for user (from VCL) if not (FBlobField.DataSet.State in [dsCalcFields, dsFilter, dsNewValue]) then - TDbf(FBlobField.DataSet).DataEvent(deFieldChange, Longint(FBlobField)); + TDbf(FBlobField.DataSet).DataEvent(deFieldChange, PtrInt(FBlobField)); end; end; Dec(FRefCount); @@ -680,16 +678,18 @@ function TDbf.GetCurrentBuffer: PChar; begin case State of dsFilter: Result := FFilterBuffer; - dsCalcFields: Result := @(pDbfRecord(CalcBuffer)^.DeletedFlag); + dsCalcFields: Result := CalcBuffer; // dsSetKey: Result := FKeyBuffer; // TO BE Implemented else if IsEmpty then begin Result := nil; end else begin - Result := @(pDbfRecord(ActiveBuffer)^.DeletedFlag); + Result := ActiveBuffer; end; end; + if Result <> nil then + Result := @PDbfRecord(Result)^.DeletedFlag; end; function TDbf.GetFieldData(Field: TField; Buffer: Pointer): Boolean; {override virtual abstract from TDataset} @@ -824,7 +824,7 @@ begin begin if Filtered or FFindRecordFilter then begin - FFilterBuffer := @pRecord^.DeletedFlag; + FFilterBuffer := Buffer; SaveState := SetTempState(dsFilter); DoFilterRecord(acceptable); RestoreState(SaveState); @@ -901,9 +901,8 @@ begin // free blobs if FBlobStreams <> nil then begin - for I := 0 to Pred(FieldCount) do - if FBlobStreams^[I] <> nil then - FBlobStreams^[I].Free; + for I := 0 to Pred(FieldDefs.Count) do + FBlobStreams^[I].Free; FreeMemAndNil(Pointer(FBlobStreams)); end; FreeRecordBuffer(FTempBuffer); @@ -915,8 +914,6 @@ begin if FParser <> nil then FreeAndNil(FParser); - if (FDbfFile <> nil) and not FReadOnly then - FDbfFile.WriteHeader; FreeAndNil(FCursor); if FDbfFile <> nil then FreeAndNil(FDbfFile); @@ -927,7 +924,7 @@ var I: Integer; begin // cancel blobs - for I := 0 to Pred(FieldCount) do + for I := 0 to Pred(FieldDefs.Count) do if Assigned(FBlobStreams^[I]) then FBlobStreams^[I].Cancel; // if we have locked a record, unlock it @@ -1193,9 +1190,7 @@ begin BindFields(true); // create array of blobstreams to store memo's in. each field is a possible blob - GetMem(FBlobStreams, FieldCount * SizeOf(TDbfBlobStream)); - for I := 0 to Pred(FieldCount) do - FBlobStreams^[I] := nil; + FBlobStreams := AllocMem(FieldDefs.Count * SizeOf(TDbfBlobStream)); // check codepage settings DetermineTranslationMode; @@ -1290,7 +1285,7 @@ begin FEditingRecNo := FCursor.PhysicalRecNo; // reread blobs, execute cancel -> clears remembered memo pageno, // causing it to reread the memo contents - for I := 0 to Pred(FieldCount) do + for I := 0 to Pred(FieldDefs.Count) do if Assigned(FBlobStreams^[I]) then FBlobStreams^[I].Cancel; // try to lock this record @@ -1317,7 +1312,7 @@ begin // if internalpost is called, we know we are active pRecord := pDbfRecord(ActiveBuffer); // commit blobs - for I := 0 to Pred(FieldCount) do + for I := 0 to Pred(FieldDefs.Count) do if Assigned(FBlobStreams^[I]) then FBlobStreams^[I].Commit; if State = dsEdit then @@ -1525,9 +1520,13 @@ end; procedure TDbf.CopyFrom(DataSet: TDataSet; FileName: string; DateTimeAsString: Boolean; Level: Integer); var + lPhysFieldDefs, lFieldDefs: TDbfFieldDefs; + lSrcField, lDestField: TField; I: integer; begin FInCopyFrom := true; + lFieldDefs := TDbfFieldDefs.Create(nil); + lPhysFieldDefs := TDbfFieldDefs.Create(nil); try if Active then Close; @@ -1538,29 +1537,61 @@ begin if not DataSet.Active then DataSet.Open; DataSet.FieldDefs.Update; - FieldDefs.Assign(DataSet.FieldDefs); - IndexDefs.Clear; - CreateTable; + // first get a list of physical field defintions + // we need it for numeric precision in case source is tdbf + if DataSet is TDbf then + begin + lPhysFieldDefs.Assign(TDbf(DataSet).DbfFieldDefs); + IndexDefs.Assign(TDbf(DataSet).IndexDefs); + end else begin + lPhysFieldDefs.Assign(DataSet.FieldDefs); + IndexDefs.Clear; + end; + // convert list of tfields into a list of tdbffielddefs + // so that our tfields will correspond to the source tfields + for I := 0 to Pred(DataSet.FieldCount) do + begin + lSrcField := DataSet.Fields[I]; + with lFieldDefs.AddFieldDef do + begin + FieldName := lSrcField.Name; + 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; + end; + end; + + CreateTableEx(lFieldDefs); Open; DataSet.First; +{$ifdef USE_CACHE} + FDbfFile.BufferAhead := true; + if DataSet is TDbf then + TDbf(DataSet).DbfFile.BufferAhead := true; +{$endif} while not DataSet.EOF do begin Append; for I := 0 to Pred(FieldCount) do begin - if not DataSet.Fields[I].IsNull then + lSrcField := DataSet.Fields[I]; + lDestField := Fields[I]; + if not lSrcField.IsNull then begin - if DataSet.Fields[I].DataType = ftDateTime then + if lSrcField.DataType = ftDateTime then begin if FCopyDateTimeAsString then begin - Fields[I].AsString := DataSet.Fields[I].AsString; + lDestField.AsString := lSrcField.AsString; if Assigned(FOnCopyDateTimeAsString) then - FOnCopyDateTimeAsString(Self, Fields[I], DataSet.Fields[I]) + FOnCopyDateTimeAsString(Self, lDestField, lSrcField) end else - Fields[I].AsDateTime := DataSet.Fields[I].AsDateTime; + lDestField.AsDateTime := lSrcField.AsDateTime; end else - Fields[I].Assign(DataSet.Fields[I]); + lDestField.Assign(lSrcField); end; end; Post; @@ -1568,7 +1599,13 @@ begin end; Close; finally +{$ifdef USE_CACHE} + if (DataSet is TDbf) and (TDbf(DataSet).DbfFile <> nil) then + TDbf(DataSet).DbfFile.BufferAhead := false; +{$endif} FInCopyFrom := false; + lFieldDefs.Free; + lPhysFieldDefs.Free; end; end; @@ -1605,64 +1642,56 @@ begin end; {$ifdef SUPPORT_VARIANTS} -{$ifdef USE_BUGGY_LOOKUP} function TDbf.Lookup(const KeyFields: string; const KeyValues: Variant; const ResultFields: string): Variant; var // OldState: TDataSetState; - retBookmark: TBookmarkStr; + saveRecNo: integer; + saveState: TDataSetState; begin Result := Null; - if VarIsNull(KeyValues) then exit; + if (FCursor = nil) or VarIsNull(KeyValues) then exit; - retBookmark := Bookmark; - DisableControls; + saveRecNo := FCursor.SequentialRecNo; try if LocateRecord(KeyFields, KeyValues, []) then begin -{ - OldState := SetTempState(dsCalcFields); -// OldState := SetTempState(dsInternalCalc); - // disable Calculated fields - otherwise were heavy AVs - // and buffer troubles below + // FFilterBuffer contains record buffer + saveState := SetTempState(dsCalcFields); try -// CalculateFields(PChar(@FDbfCalcBuffer)); - CalculateFields(TempBuffer); -// CalculateFields(GetCurrentBuffer); - if KeyValues = FieldValues[KeyFields] then // there was bug in TDbf.SearchKey -} - Result := FieldValues[ResultFields]; // also there may be buffer troubles from above -{ + CalculateFields(FFilterBuffer); + if KeyValues = FieldValues[KeyFields] then + Result := FieldValues[ResultFields]; finally - (* else *) RestoreState(OldState); + RestoreState(saveState); end; -} end; finally - Bookmark := retBookmark; - EnableControls; + FCursor.SequentialRecNo := saveRecNo; end; end; -{$endif} - function TDbf.Locate(const KeyFields: string; const KeyValues: Variant; Options: TLocateOptions): Boolean; var - retBookmark: TBookmarkStr; + saveRecNo: integer; begin - DoBeforeScroll; - try - DisableControls; - retBookmark := Bookmark; - Result := LocateRecord(KeyFields, KeyValues, Options); - if Result then - DoAfterScroll - else - Bookmark := retBookmark; - finally - EnableControls; + if FCursor = nil then + begin + Result := false; + exit; end; + + DoBeforeScroll; + saveRecNo := FCursor.SequentialRecNo; + Result := LocateRecord(KeyFields, KeyValues, Options); + CursorPosChanged; + if Result then + begin + Resync([]); + DoAfterScroll; + end else + FCursor.SequentialRecNo := saveRecNo; end; function TDbf.LocateRecord(const KeyFields: String; const KeyValues: Variant; @@ -1675,7 +1704,6 @@ var bVarIsArray : Boolean; varCompare : Variant; doLinSearch : Boolean; - pIndexValue : PChar; function CompareValues: Boolean; var @@ -1713,13 +1741,12 @@ var var searchFlag: TSearchKeyType; - searchString: string; - strLength: Integer; + lPhysRecNo, matchRes: Integer; + SaveState: TDataSetState; + lTempBuffer: array [0..100] of Char; begin Result := false; - CheckBrowseMode; - doLinSearch := true; // index active? if FCursor is TIndexCursor then @@ -1733,18 +1760,24 @@ begin searchFlag := stGreaterEqual else searchFlag := stEqual; - Result := SearchKey(KeyValues, searchFlag); - if Result and (loPartialKey in Options) then + TIndexCursor(FCursor).VariantToBuffer(KeyValues, @lTempBuffer[0]); + Result := FIndexFile.SearchKey(@lTempBuffer[0], searchFlag); + if Result then begin - searchString := VarToStr(KeyValues); - strLength := Length(searchString); - pIndexValue := TIndexCursor(FCursor).IndexFile.ExtractKeyFromBuffer(GetCurrentBuffer); - if loCaseInsensitive in Options then + Result := GetRecord(TempBuffer, gmCurrent, false) = grOK; + if not Result then begin - Result := AnsiStrLIComp(pIndexValue, PChar(searchString), strLength) = 0; - end else begin - Result := StrLComp(pIndexValue, PChar(searchString), strLength) = 0; + 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; end; + FFilterBuffer := TempBuffer; end; end; end; @@ -1752,8 +1785,9 @@ begin if doLinSearch then begin bVarIsArray := false; - CursorPosChanged; lstKeys := TList.Create; + FFilterBuffer := TempBuffer; + SaveState := SetTempState(dsFilter); try GetFieldList(lstKeys, KeyFields); if VarArrayDimCount(KeyValues) = 0 then @@ -1766,10 +1800,18 @@ begin bMatchedData := false; if bMatchedData then begin - First; - while not Eof and not Result Do + FCursor.First; + while not Result and FCursor.Next do begin - Result := true; + 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 @@ -1779,14 +1821,13 @@ begin else varCompare := KeyValues; Result := CompareValues; - iIndex := iIndex + 1; + Inc(iIndex); end; - if not Result then - Next; end; end; finally lstKeys.Free; + RestoreState(SaveState); end; end; end; @@ -1834,11 +1875,11 @@ begin // check if in editing mode if user wants to write if (Mode = bmWrite) or (Mode = bmReadWrite) then if not (State in [dsEdit, dsInsert]) then -{$ifdef DELPHI_3} +{$ifdef DELPHI_3} DatabaseError(SNotEditing); -{$else} +{$else} DatabaseError(SNotEditing, Self); -{$endif} +{$endif} // already created a `placeholder' blob for this field? MemoFieldNo := Field.FieldNo - 1; if FBlobStreams^[MemoFieldNo] = nil then @@ -1861,7 +1902,7 @@ begin lBlob.ReadSize := 0; end; lBlob.MemoRecNo := MemoPageNo; - end else + end else if not lBlob.Dirty or (Mode = bmWrite) then begin // reading and memo is empty and not written yet, or rewriting @@ -2011,7 +2052,7 @@ begin // end; end; { end of ***** fkCalculated, fkLookup ***** } if not (State in [dsCalcFields, dsFilter, dsNewValue]) then begin - DataEvent(deFieldChange, Longint(Field)); + DataEvent(deFieldChange, PtrInt(Field)); end; end; @@ -2331,7 +2372,7 @@ begin Result := lIndexDef.SortField; end; -procedure tdbf.SetIndexFieldNames(const Value: string); +procedure TDbf.SetIndexFieldNames(const Value: string); var lIndexDef: TDbfIndexDef; begin diff --git a/fcl/db/dbase/dbf_avl.pas b/fcl/db/dbase/dbf_avl.pas index b8dabb41f0..c0fd818813 100644 --- a/fcl/db/dbase/dbf_avl.pas +++ b/fcl/db/dbase/dbf_avl.pas @@ -2,6 +2,11 @@ unit dbf_avl; interface +{$I dbf_common.inc} + +uses + Dbf_Common; + type TBal = -1..1; diff --git a/fcl/db/dbase/dbf_common.inc b/fcl/db/dbase/dbf_common.inc index ee0c422f73..152b5e662b 100644 --- a/fcl/db/dbase/dbf_common.inc +++ b/fcl/db/dbase/dbf_common.inc @@ -3,6 +3,12 @@ {.$define USE_CACHE} +// define the following if you want support for 65535 length character +// fields for all dbase files (and not only foxpro); if you define this, +// you will not be able to read MS Excel generated .dbf files! + +{.$define USE_LONG_CHAR_FIELDS} + // modifies unix unit dbf_wtil to use hungarian encodings (hack) {.$define HUNGARIAN} @@ -15,10 +21,6 @@ {.$define TDBF_UPDATE_FIRSTLAST_NODE} -// use this to enable the lookup function which is still buggy - -{.$define USE_BUGGY_LOOKUP} - // use this directive to suppress math exceptions, // instead NAN is returned. // Using this directive is slightly less efficient @@ -131,6 +133,29 @@ {$define DELPHI_3} {$endif} +{$ifdef VER180} // Delphi 2006 + {$define DELPHI_2006} + {$define DELPHI_2005} + {$define DELPHI_8} + {$define DELPHI_7} + {$define DELPHI_6} + {$define DELPHI_5} + {$define DELPHI_4} + {$define DELPHI_3} +{$endif} + +{$ifdef VER190} // Delphi 2007 + {$define DELPHI_2007} + {$define DELPHI_2006} + {$define DELPHI_2005} + {$define DELPHI_8} + {$define DELPHI_7} + {$define DELPHI_6} + {$define DELPHI_5} + {$define DELPHI_4} + {$define DELPHI_3} +{$endif} + //------------------------------------------------------- //--- Conclude supported features from delphi version --- //------------------------------------------------------- @@ -195,7 +220,6 @@ {$define SUPPORT_INT64} {$define SUPPORT_DEFAULT_PARAMS} {$define SUPPORT_NEW_TRANSLATE} - {$define SUPPORT_BACKWARD_FIELDDATA} {$define SUPPORT_NEW_FIELDDATA} {$define SUPPORT_FIELDDEF_TPERSISTENT} {$define SUPPORT_FIELDTYPES_V4} @@ -203,6 +227,13 @@ {$define SUPPORT_REINTRODUCE} {$define SUPPORT_MATH_UNIT} + // FPC 2.0.x improvements + {$ifdef VER2} + {$ifndef VER2_0_0} + {$define SUPPORT_BACKWARD_FIELDDATA} + {$endif} + {$endif} + // FPC 1.0.x exceptions: no 0/0 support {$ifdef VER1_0} {$undef NAN} diff --git a/fcl/db/dbase/dbf_common.pas b/fcl/db/dbase/dbf_common.pas index 725b3f7a15..437babcf12 100644 --- a/fcl/db/dbase/dbf_common.pas +++ b/fcl/db/dbase/dbf_common.pas @@ -17,7 +17,7 @@ uses const TDBF_MAJOR_VERSION = 6; - TDBF_MINOR_VERSION = 45; + TDBF_MINOR_VERSION = 47; TDBF_SUB_MINOR_VERSION = 0; TDBF_TABLELEVEL_FOXPRO = 25; @@ -44,6 +44,8 @@ type ftTime: (Time: Longint); ftDateTime: (DateTime: TDateTimeAlias); end; +{$else} + PtrInt = Longint; {$endif} PSmallInt = ^SmallInt; @@ -56,6 +58,10 @@ type PLargeInt = ^Int64; {$endif} +{$ifdef DELPHI_3} + dword = cardinal; +{$endif} + //------------------------------------- {$ifndef SUPPORT_FREEANDNIL} @@ -98,7 +104,8 @@ function GetFreeMemory: Integer; {$endif} // OH 2000-11-15 dBase7 support. Swap Byte order for 4 and 8 Byte Integer -function SwapInt(const Value: Cardinal): Cardinal; +function SwapWord(const Value: word): word; +function SwapInt(const Value: dword): dword; { SwapInt64 NOTE: do not call with same value for Value and Result ! } procedure SwapInt64(Value, Result: Pointer); register; @@ -112,6 +119,7 @@ function MemScan(const Buffer: Pointer; Chr: Byte; Length: Integer): Pointer; {$ifdef DELPHI_3} {$ifndef DELPHI_4} function Min(x, y: integer): integer; +function Max(x, y: integer): integer; {$endif} {$endif} @@ -340,9 +348,14 @@ end; // Utility routines //==================================================================== +function SwapWord(const Value: word): word; +begin + Result := ((Value and $FF) shl 8) or ((Value shr 8) and $FF); +end; + {$ifdef USE_ASSEMBLER_486_UP} -function SwapInt(const Value: Cardinal): Cardinal; register; assembler; +function SwapInt(const Value: dword): dword; register; assembler; asm BSWAP EAX; end; @@ -466,6 +479,14 @@ begin result := y; end; +function Max(x, y: integer): integer; +begin + if x < y then + result := y + else + result := x; +end; + {$endif} {$endif} diff --git a/fcl/db/dbase/dbf_dbffile.pas b/fcl/db/dbase/dbf_dbffile.pas index cf24c65871..d533204eb5 100644 --- a/fcl/db/dbase/dbf_dbffile.pas +++ b/fcl/db/dbase/dbf_dbffile.pas @@ -52,6 +52,7 @@ type FIndexFiles: TList; FDbfVersion: TXBaseVersion; FPrevBuffer: PChar; + FDefaultBuffer: PChar; FRecordBufferSize: Integer; FLockUserLen: DWORD; FFileCodePage: Cardinal; @@ -78,6 +79,7 @@ type protected procedure ConstructFieldDefs; + procedure InitDefaultBuffer; procedure UpdateNullField(Buffer: Pointer; AFieldDef: TDbfFieldDef; Action: TUpdateNullField); procedure WriteLockInfo(Buffer: PChar); @@ -293,11 +295,6 @@ begin FFieldDefs := TDbfFieldDefs.Create(nil); FIndexNames := TStringList.Create; FIndexFiles := TList.Create; - FOnLocaleError := nil; - FOnIndexMissing := nil; - FMdxFile := nil; - FForceClose := false; - FCopyDateTimeAsString := false; // now initialize inherited inherited; @@ -340,6 +337,7 @@ var MemoFileClass: TMemoFileClass; I: Integer; deleteLink: Boolean; + lModified: boolean; LangStr: PChar; version: byte; begin @@ -350,6 +348,7 @@ begin OpenFile; // check if we opened an already existing file + lModified := false; if not FileCreated then begin HeaderSize := sizeof(rDbfHdr); // temporary @@ -406,7 +405,7 @@ begin // 'RecordCount in Hdr : '+IntToStr(PDbfHdr(Header).RecordCount)+^M+ // 'expected : '+IntToStr(RecordCount)); PDbfHdr(Header)^.RecordCount := RecordCount; - WriteHeader; // Correct it + lModified := true; end; // determine codepage if FDbfVersion >= xBaseVII then @@ -474,10 +473,16 @@ begin FMemoFile.Open; // set header blob flag corresponding to field list if FDbfVersion <> xFoxPro then + begin PDbfHdr(Header)^.VerDBF := PDbfHdr(Header)^.VerDBF or $80; + lModified := true; + end; end else if FDbfVersion <> xFoxPro then + begin PDbfHdr(Header)^.VerDBF := PDbfHdr(Header)^.VerDBF and $7F; + lModified := true; + end; // check if mdx flagged if (FDbfVersion <> xFoxPro) and (PDbfHdr(Header)^.MDXFlag <> 0) then begin @@ -510,13 +515,19 @@ begin FOnIndexMissing(deleteLink); // correct flag if deleteLink then - PDbfHdr(Header)^.MDXFlag := 0 - else + begin + PDbfHdr(Header)^.MDXFlag := 0; + lModified := true; + end else FForceClose := true; end; end; end; + // record changes + if lModified then + WriteHeader; + // open indexes for I := 0 to FIndexFiles.Count - 1 do TIndexFile(FIndexFiles.Items[I]).Open; @@ -557,8 +568,8 @@ begin end; end; FreeAndNil(FMdxFile); - if FPrevBuffer <> nil then - FreeMemAndNil(Pointer(FPrevBuffer)); + FreeMemAndNil(Pointer(FPrevBuffer)); + FreeMemAndNil(Pointer(FDefaultBuffer)); // reset variables FFileLangId := 0; @@ -644,7 +655,11 @@ begin // apply field transformation tricks lSize := lFieldDef.Size; lPrec := lFieldDef.Precision; - if (FDbfVersion = xFoxPro) and (lFieldDef.NativeFieldType = 'C') then + if (lFieldDef.NativeFieldType = 'C') +{$ifndef USE_LONG_CHAR_FIELDS} + and (FDbfVersion = xFoxPro) +{$endif} + then begin lPrec := lSize shr 8; lSize := lSize and $FF; @@ -859,7 +874,11 @@ begin end; // apply field transformation tricks - if (lNativeFieldType = 'C') and (FDbfVersion = xFoxPro) then + if (lNativeFieldType = 'C') +{$ifdef USE_LONG_CHAR_FIELDS} + and (FDbfVersion = xFoxPro) +{$endif} + then begin lSize := lSize + lPrec shl 8; lPrec := 0; @@ -913,17 +932,8 @@ begin if FFieldDefs.Count >= 4096 then raise EDbfError.CreateFmt(STRING_INVALID_FIELD_COUNT, [FFieldDefs.Count]); -{ - // removed check because additional data could be present in record - - if (lFieldOffset <> PDbfHdr(Header).RecordSize) then - begin - // I removed the message because it confuses end-users. - // Though there is a major problem if the value is wrong... - // I try to fix it but it is likely to crash - PDbfHdr(Header).RecordSize := lFieldOffset; - end; -} + // do not check FieldOffset = PDbfHdr(Header).RecordSize because additional + // data could be present in record // get current position lPropHdrOffset := Stream.Position; @@ -978,7 +988,6 @@ begin // read custom properties...not implemented // read RI properties...not implemented end; - finally HeaderSize := PDbfHdr(Header)^.FullHdrSize; RecordSize := PDbfHdr(Header)^.RecordSize; @@ -1410,6 +1419,7 @@ var ldd, ldm, ldy, lth, ltm, lts: Integer; date: TDateTime; timeStamp: TTimeStamp; + asciiContents: boolean; {$ifdef SUPPORT_INT64} function GetInt64FromStrLength(Src: Pointer; Size: Integer; Default: Int64): Int64; @@ -1486,6 +1496,7 @@ begin FieldOffset := AFieldDef.Offset; FieldSize := AFieldDef.Size; Src := PChar(Src) + FieldOffset; + asciiContents := false; // field types that are binary and of which the fieldsize should not be truncated case AFieldDef.NativeFieldType of '+', 'I': @@ -1495,7 +1506,7 @@ begin Result := PDWord(Src)^ <> 0; if Result and (Dst <> nil) then begin - PInteger(Dst)^ := SwapInt(PInteger(Src)^); + PDWord(Dst)^ := SwapInt(PDWord(Src)^); if Result then PInteger(Dst)^ := Integer(PDWord(Dst)^ xor $80000000); end; @@ -1564,7 +1575,27 @@ begin end; {$endif} end; + 'B': // foxpro double + begin + Result := true; + if Dst <> nil then + PDouble(Dst)^ := PDouble(Src)^; + end; + 'M': + begin + if FieldSize = 4 then + begin + Result := PInteger(Src)^ <> 0; + if Dst <> nil then + PInteger(Dst)^ := PInteger(Src)^; + end else + asciiContents := true; + end; else + asciiContents := true; + end; + if asciiContents then + begin // SetString(s, PChar(Src) + FieldOffset, FieldSize ); // s := {TrimStr(s)} TrimRight(s); // truncate spaces at end by shortening fieldsize @@ -1674,11 +1705,13 @@ const var FieldSize,FieldPrec: Integer; TempFieldDef: TDbfFieldDef; - Len, IntValue: Integer; + Len: Integer; + IntValue: dword; year, month, day: Word; hour, minute, sec, msec: Word; date: TDateTime; timeStamp: TTimeStamp; + asciiContents: boolean; procedure LoadDateFromSrc; begin @@ -1714,6 +1747,7 @@ begin // copy field data to record buffer Dst := PChar(Dst) + TempFieldDef.Offset; + asciiContents := false; case TempFieldDef.NativeFieldType of '+', 'I': begin @@ -1722,13 +1756,13 @@ begin if Src = nil then IntValue := 0 else - IntValue := Integer(PDWord(Src)^ xor $80000000); - PInteger(Dst)^ := SwapInt(IntValue); + IntValue := PDWord(Src)^ xor $80000000; + PDWord(Dst)^ := SwapInt(IntValue); end else begin if Src = nil then - PInteger(Dst)^ := 0 + PDWord(Dst)^ := 0 else - PInteger(Dst)^ := PInteger(Src)^; + PDWord(Dst)^ := PDWord(Src)^; end; end; 'O': @@ -1790,7 +1824,29 @@ begin // TODO: data is little endian {$endif} end; + 'B': + begin + if Src = nil then + PDouble(Dst)^ := 0 + else + PDouble(Dst)^ := PDouble(Src)^; + end; + 'M': + begin + if FieldSize = 4 then + begin + if Src = nil then + PInteger(Dst)^ := 0 + else + PInteger(Dst)^ := PInteger(Src)^; + end else + asciiContents := true; + end; else + asciiContents := true; + end; + if asciiContents then + begin if Src = nil then begin FillChar(Dst^, FieldSize, ' '); @@ -1848,36 +1904,48 @@ begin end; end; -procedure TDbfFile.InitRecord(DestBuf: PChar); +procedure TDbfFile.InitDefaultBuffer; var + lRecordSize: integer; TempFieldDef: TDbfFieldDef; I: Integer; begin + lRecordSize := PDbfHdr(Header)^.RecordSize; // clear buffer (assume all string, fix specific fields later) - FillChar(DestBuf^, RecordSize,' '); + // note: Self.RecordSize is used for reading fielddefs too + GetMem(FDefaultBuffer, lRecordSize+1); + FillChar(FDefaultBuffer^, lRecordSize, ' '); // set nullflags field so that all fields are null if FNullField <> nil then - FillChar(PChar(DestBuf+FNullField.Offset)^, FNullField.Size, $FF); - + FillChar(PChar(FDefaultBuffer+FNullField.Offset)^, FNullField.Size, $FF); + // check binary and default fields for I := 0 to FFieldDefs.Count-1 do begin TempFieldDef := FFieldDefs.Items[I]; - // binary field? - if TempFieldDef.NativeFieldType in ['I', 'O', '@', '+', '0', 'Y'] then - FillChar(PChar(DestBuf+TempFieldDef.Offset)^, TempFieldDef.Size, 0); + // binary field? (foxpro memo fields are binary, but dbase not) + if (TempFieldDef.NativeFieldType in ['I', 'O', '@', '+', '0', 'Y']) + or ((TempFieldDef.NativeFieldType = 'M') and (TempFieldDef.Size = 4)) then + FillChar(PChar(FDefaultBuffer+TempFieldDef.Offset)^, TempFieldDef.Size, 0); // copy default value? if TempFieldDef.HasDefault then begin - Move(TempFieldDef.DefaultBuf[0], DestBuf[TempFieldDef.Offset], TempFieldDef.Size); + Move(TempFieldDef.DefaultBuf[0], FDefaultBuffer[TempFieldDef.Offset], TempFieldDef.Size); // clear the null flag, this field has a value if FNullField <> nil then - UpdateNullField(DestBuf, TempFieldDef, unClear); + UpdateNullField(FDefaultBuffer, TempFieldDef, unClear); end; end; end; +procedure TDbfFile.InitRecord(DestBuf: PChar); +begin + if FDefaultBuffer = nil then + InitDefaultBuffer; + Move(FDefaultBuffer^, DestBuf^, RecordSize); +end; + procedure TDbfFile.ApplyAutoIncToBuffer(DestBuf: PChar); var TempFieldDef: TDbfFieldDef; diff --git a/fcl/db/dbase/dbf_fields.pas b/fcl/db/dbase/dbf_fields.pas index eb3a99f281..12a554218f 100644 --- a/fcl/db/dbase/dbf_fields.pas +++ b/fcl/db/dbase/dbf_fields.pas @@ -178,7 +178,8 @@ begin FieldDef := AddFieldDef; FieldDef.FieldName := Name; FieldDef.FieldType := DataType; - FieldDef.Size := size; + if Size <> 0 then + FieldDef.Size := Size; FieldDef.Required := Required; end; @@ -257,7 +258,7 @@ begin // convert VCL fieldtypes to native DBF fieldtypes VCLToNative; // for integer / float fields try fill in size/precision - SetDefaultSize; + CheckSizePrecision; // VCL does not have default value support AllocBuffers; FHasDefault := false; @@ -363,7 +364,11 @@ begin end; 'D' : FFieldType := ftDate; 'M' : FFieldType := ftMemo; - 'B' : FFieldType := ftBlob; + 'B' : + if DbfVersion = xFoxPro then + FFieldType := ftFloat + else + FFieldType := ftBlob; 'G' : FFieldType := ftDBaseOle; 'Y' : if DbfGlobals.CurrencyAsBCD then @@ -387,7 +392,9 @@ begin FNativeFieldType := '@' else if DbfVersion = xFoxPro then - FNativeFieldType := 'T'; + FNativeFieldType := 'T' + else + FNativeFieldType := 'D'; {$ifdef SUPPORT_FIELDTYPES_V4} ftFixedChar, ftWideString, @@ -466,8 +473,16 @@ begin case FNativeFieldType of 'C': begin - if FSize < 0 then FSize := 0; - if FSize >= 65534 then FSize := 65534; + if FSize < 0 then + FSize := 0; + if DbfVersion = xFoxPro then + begin + if FSize >= $FFFF then + FSize := $FFFF; + end else begin + if FSize >= $FF then + FSize := $FF; + end; FPrecision := 0; end; 'L': @@ -490,7 +505,10 @@ begin end; 'M','G','B': begin - FSize := 10; + if DbfVersion = xFoxPro then + FSize := 4 + else + FSize := 10; FPrecision := 0; end; '+','I': diff --git a/fcl/db/dbase/dbf_idxfile.pas b/fcl/db/dbase/dbf_idxfile.pas index 872d248baf..873757432b 100644 --- a/fcl/db/dbase/dbf_idxfile.pas +++ b/fcl/db/dbase/dbf_idxfile.pas @@ -3063,6 +3063,9 @@ begin end else begin 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); @@ -3086,8 +3089,6 @@ begin // now set userkey to key to insert FUserKey := @TempBuffer[0]; InsertCurrent; - // check range, disabled by delete/insert - ResyncRange(true); end; end; end; diff --git a/fcl/db/dbase/dbf_memo.pas b/fcl/db/dbase/dbf_memo.pas index 84ae6eb5e2..32bbc73d8a 100644 --- a/fcl/db/dbase/dbf_memo.pas +++ b/fcl/db/dbase/dbf_memo.pas @@ -104,7 +104,7 @@ type PDbtHdr = ^rDbtHdr; rDbtHdr = record - NextBlock : Longint; + NextBlock : dword; Dummy : array [4..7] of Byte; DbfFile : array [0..7] of Byte; // 8..15 bVer : Byte; // 16 @@ -115,7 +115,7 @@ type PFptHdr = ^rFptHdr; rFptHdr = record - NextBlock : Longint; + NextBlock : dword; Dummy : array [4..5] of Byte; BlockLen : Word; // 20..21 Dummy3 : array [8..511] of Byte; @@ -183,15 +183,12 @@ begin RecordSize := GetBlockLen; // checking for right blocksize not needed for foxpro? - if FDbfVersion <> xFoxPro then + // mod 128 <> 0 <-> and 0x7F <> 0 + if (RecordSize = 0) and ((FDbfVersion = xFoxPro) or ((RecordSize and $7F) <> 0)) then begin - // mod 128 <> 0 <-> and 0x7F <> 0 - if (RecordSize = 0) or ((RecordSize and $7F) <> 0) then - begin - SetBlockLen(512); - RecordSize := 512; - WriteHeader; - end; + SetBlockLen(512); + RecordSize := 512; + WriteHeader; end; // get memory for temporary buffer @@ -234,11 +231,15 @@ begin if (BlockNo<=0) or (RecordSize=0) then exit; // read first block - if ReadRecord(BlockNo, @FBuffer[0]) = 0 then + numBytes := ReadRecord(BlockNo, @FBuffer[0]); + if numBytes = 0 then begin // EOF reached? exit; - end; + end else + if numBytes < RecordSize then + FillChar(FBuffer[RecordSize-numBytes], numBytes, #0); + bytesLeft := GetMemoSize; // bytesLeft <> -1 -> memo size is known (FoxPro, dBase4) // bytesLeft = -1 -> memo size unknown (dBase3) @@ -455,7 +456,7 @@ end; function TFoxProMemoFile.GetBlockLen: Integer; begin - Result := Swap(PFptHdr(Header)^.BlockLen); + Result := SwapWord(PFptHdr(Header)^.BlockLen); end; function TFoxProMemoFile.GetMemoSize: Integer; @@ -470,12 +471,12 @@ end; procedure TFoxProMemoFile.SetNextFreeBlock(BlockNo: Integer); begin - PFptHdr(Header)^.NextBlock := SwapInt(BlockNo); + PFptHdr(Header)^.NextBlock := SwapInt(dword(BlockNo)); end; procedure TFoxProMemoFile.SetBlockLen(BlockLen: Integer); begin - PFptHdr(Header)^.BlockLen := Swap(BlockLen); + PFptHdr(Header)^.BlockLen := SwapWord(dword(BlockLen)); end; // ------------------------------------------------------------------ diff --git a/fcl/db/dbase/dbf_parser.pas b/fcl/db/dbase/dbf_parser.pas index 26fb273573..5bfeeee4e2 100644 --- a/fcl/db/dbase/dbf_parser.pas +++ b/fcl/db/dbase/dbf_parser.pas @@ -233,8 +233,6 @@ type TRawStringFieldVar = class(TStringFieldVar) public - constructor Create(UseFieldDef: TDbfFieldDef; ADbfFile: TDbfFile); - procedure Refresh(Buffer: PChar); override; end; @@ -253,8 +251,6 @@ type function GetFieldVal: Pointer; override; function GetFieldType: TExpressionType; override; public - constructor Create(UseFieldDef: TDbfFieldDef; ADbfFile: TDbfFile); - procedure Refresh(Buffer: PChar); override; end; @@ -265,8 +261,6 @@ type function GetFieldVal: Pointer; override; function GetFieldType: TExpressionType; override; public - constructor Create(UseFieldDef: TDbfFieldDef; ADbfFile: TDbfFile); - procedure Refresh(Buffer: PChar); override; end; @@ -278,8 +272,6 @@ type function GetFieldVal: Pointer; override; function GetFieldType: TExpressionType; override; public - constructor Create(UseFieldDef: TDbfFieldDef; ADbfFile: TDbfFile); - procedure Refresh(Buffer: PChar); override; end; {$endif} @@ -291,8 +283,16 @@ type protected function GetFieldVal: Pointer; override; public - constructor Create(UseFieldDef: TDbfFieldDef; ADbfFile: TDbfFile); + procedure Refresh(Buffer: PChar); override; + end; + TBooleanFieldVar = class(TFieldVar) + private + FFieldVal: boolean; + function GetFieldType: TExpressionType; override; + protected + function GetFieldVal: Pointer; override; + public procedure Refresh(Buffer: PChar); override; end; @@ -319,11 +319,6 @@ begin end; //--TRawStringFieldVar---------------------------------------------------------- -constructor TRawStringFieldVar.Create(UseFieldDef: TDbfFieldDef; ADbfFile: TDbfFile); -begin - inherited; -end; - procedure TRawStringFieldVar.Refresh(Buffer: PChar); begin FFieldVal := Buffer + FieldDef.Offset; @@ -359,11 +354,6 @@ begin end; //--TFloatFieldVar----------------------------------------------------------- -constructor TFloatFieldVar.Create(UseFieldDef: TDbfFieldDef; ADbfFile: TDbfFile); -begin - inherited; -end; - function TFloatFieldVar.GetFieldVal: Pointer; begin Result := @FFieldVal; @@ -382,11 +372,6 @@ begin end; //--TIntegerFieldVar---------------------------------------------------------- -constructor TIntegerFieldVar.Create(UseFieldDef: TDbfFieldDef; ADbfFile: TDbfFile); -begin - inherited; -end; - function TIntegerFieldVar.GetFieldVal: Pointer; begin Result := @FFieldVal; @@ -406,11 +391,6 @@ end; {$ifdef SUPPORT_INT64} //--TLargeIntFieldVar---------------------------------------------------------- -constructor TLargeIntFieldVar.Create(UseFieldDef: TDbfFieldDef; ADbfFile: TDbfFile); -begin - inherited; -end; - function TLargeIntFieldVar.GetFieldVal: Pointer; begin Result := @FFieldVal; @@ -430,11 +410,6 @@ end; {$endif} //--TDateTimeFieldVar--------------------------------------------------------- -constructor TDateTimeFieldVar.Create(UseFieldDef: TDbfFieldDef; ADbfFile: TDbfFile); -begin - inherited; -end; - function TDateTimeFieldVar.GetFieldVal: Pointer; begin Result := @FFieldVal; @@ -451,6 +426,27 @@ begin FFieldVal.DateTime := 0.0; end; +//--TBooleanFieldVar--------------------------------------------------------- +function TBooleanFieldVar.GetFieldVal: Pointer; +begin + Result := @FFieldVal; +end; + +function TBooleanFieldVar.GetFieldType: TExpressionType; +begin + Result := etBoolean; +end; + +procedure TBooleanFieldVar.Refresh(Buffer: PChar); +var + lFieldVal: word; +begin + if FDbfFile.GetFieldDataFromDef(FieldDef, ftBoolean, Buffer, @lFieldVal) then + FFieldVal := lFieldVal <> 0 + else + FFieldVal := false; +end; + //--Expression functions----------------------------------------------------- procedure FuncFloatToStr(Param: PExpressionRec); @@ -1428,7 +1424,7 @@ begin // define field in parser case FieldInfo.FieldType of - ftString, ftBoolean: + ftString: begin if RawStringFields then begin @@ -1441,6 +1437,11 @@ begin DefineStringVariable(VarName, TempFieldVar.FieldVal); end; end; + ftBoolean: + begin + TempFieldVar := TBooleanFieldVar.Create(FieldInfo, TDbfFile(FDbfFile)); + DefineBooleanVariable(VarName, TempFieldVar.FieldVal); + end; ftFloat: begin TempFieldVar := TFloatFieldVar.Create(FieldInfo, TDbfFile(FDbfFile)); diff --git a/fcl/db/dbase/dbf_pgcfile.pas b/fcl/db/dbase/dbf_pgcfile.pas index da577fee2f..63a0bbbebe 100644 --- a/fcl/db/dbase/dbf_pgcfile.pas +++ b/fcl/db/dbase/dbf_pgcfile.pas @@ -42,7 +42,7 @@ type procedure SetRecordSize(NewValue: Integer); override; procedure SetCacheSize(NewSize: Integer); public - constructor Create(AFileName: string); + constructor Create; destructor Destroy; override; procedure CloseFile; override; @@ -60,7 +60,7 @@ implementation {$ifdef USE_CACHE} -constructor TCachedFile.Create(AFileName: string); +constructor TCachedFile.Create; begin inherited; diff --git a/fcl/db/dbase/history.txt b/fcl/db/dbase/history.txt index 64304f6630..279e568aa5 100644 --- a/fcl/db/dbase/history.txt +++ b/fcl/db/dbase/history.txt @@ -32,6 +32,45 @@ BUGS & WARNINGS +------------------------ +V6.4.7 + +- fixed: 64bit compatibility +- fixed: Field.FieldNo is relative to number of FieldDefs, may be larger +- added: function Max for Delphi 3, needed by dbf_avl unit +- added: BCB3 package files (thx to pzelotti) +- fixed: add special case for copying from source TDbf in CopyFrom to retain + more precise field types +- fixed: TDbf.CopyFrom to keep Fields and FieldDefs seperate +- fixed: TDbfFieldDefs.Add to ignore size when it is zero +- added: TDbf.Lookup and as such, lookup fields, should work now +- added: defines for delphi 2006 and 2007 +- fixed: some range checking errors when swapping data +- added: packages for delphi 2005 and 2006, c++ 2006 (from stan and others) +- fixed: modifying records with active range +- added: packages for kylix 3, fix casing (from jvargas) + + +------------------------ +V6.4.6 + +- fixed: FPC 2.0.1 implements "backward-compatible" fielddata + for datetime fields in particular (from alexandrov) +- fixed: only allow >255 field length for creating foxpro files; prevents + range check error (rep by miguel) +- fixed: memo read: check number of bytes read, clear rest for safety +- added: support for foxpro double, fieldtype 'B' +- fixed: foxpro memo pageno is binary 4 byte integer, not ascii +- added: default values are buffered, better/faster record insert +- added: support for long character fields compiletime definable + (USE_LONG_CHAR_FIELDS) +- fixed: added boolean field support in expressions (note: breaks existing) +- fixed: compilation with USE_CACHE directive +- fixed: add my own SwapWord function, because Swap seems buggy in fpc +- fixed: VCL fieldtype ftDateTime was not translated to any native type + for non dBase VII and non FoxPro (hint by paul van helden) + + ------------------------ V6.4.5