From b5eb207a7dbdfe435b3d60649b2806a93e847311 Mon Sep 17 00:00:00 2001 From: Frank Rademakers Date: Mon, 11 Jul 2022 15:57:30 +0000 Subject: [PATCH] Additional Visual Foxpro functionality for TDbf. AutoInc fields work and can... (cherry picked from commit 9d4cdc9383ceeac758aa1a305b185d595f468fdb) --- packages/fcl-db/src/dbase/dbf.pas | 30 ++++- packages/fcl-db/src/dbase/dbf_dbffile.pas | 139 ++++++++++++++++++++-- packages/fcl-db/src/dbase/dbf_fields.pas | 12 +- packages/fcl-db/src/dbase/dbf_pgfile.pas | 2 + packages/fcl-db/src/dbase/dbf_struct.inc | 1 + 5 files changed, 174 insertions(+), 10 deletions(-) diff --git a/packages/fcl-db/src/dbase/dbf.pas b/packages/fcl-db/src/dbase/dbf.pas index ce3b0986ad..2ffb633b1e 100644 --- a/packages/fcl-db/src/dbase/dbf.pas +++ b/packages/fcl-db/src/dbase/dbf.pas @@ -163,7 +163,6 @@ type //==================================================================== TDbf = class(TDataSet) private - FDbfFile: TDbfFile; FCursor: TVirtualCursor; FOpenMode: TDbfOpenMode; FStorage: TDbfStorage; @@ -200,6 +199,7 @@ type FDateTimeHandling: TDateTimeHandling; FTranslationMode: TDbfTranslationMode; FIndexDefs: TDbfIndexDefs; + FUseAutoInc: Boolean; FBeforeAutoCreate: TBeforeAutoCreateEvent; FOnTranslate: TTranslateEvent; FOnLanguageWarning: TLanguageWarningEvent; @@ -217,6 +217,7 @@ type function GetPhysicalRecordCount: Integer; function GetKeySize: Integer; function GetMasterFields: string; + function GetNextAutoInc: Cardinal; function FieldDefsStored: Boolean; procedure SetBackLink(NewBackLink: String); @@ -230,6 +231,8 @@ type procedure SetMasterFields(const Value: string); procedure SetTableLevel(const NewLevel: Integer); procedure SetPhysicalRecNo(const NewRecNo: Integer); + procedure SetNextAutoInc(ThisNextAutoInc: Cardinal); + procedure SetUseAutoInc(ThisUseAutoInc: Boolean); procedure MasterChanged(Sender: TObject); procedure MasterDisabled(Sender: TObject); @@ -246,6 +249,8 @@ type procedure SetRangeBuffer(LowRange: PChar; HighRange: PChar); protected + FDbfFile: TDbfFile; + { abstract methods } function AllocRecordBuffer: TRecordBuffer; override; {virtual abstract} procedure ClearCalcFields(Buffer: TRecordBuffer); override; @@ -428,6 +433,8 @@ type // Storage for memo file - if any - when using memory storage property UserMemoStream: TStream read FUserMemoStream write FUserMemoStream; property DisableResyncOnPost: Boolean read FDisableResyncOnPost write FDisableResyncOnPost; + // The value stored in the file. + property NextAutoInc: Cardinal read GetNextAutoInc write SetNextAutoInc; published property DateTimeHandling: TDateTimeHandling read FDateTimeHandling write FDateTimeHandling default dtBDETimeStamp; @@ -448,6 +455,8 @@ type property TableName: string read FTableName write SetTableName; property TableLevel: Integer read FTableLevel write SetTableLevel; property Version: string read GetVersion write SetVersion stored false; + // Turn this off to overwrite. + property UseAutoInc: Boolean read FUseAutoInc write SetUseAutoInc; property BeforeAutoCreate: TBeforeAutoCreateEvent read FBeforeAutoCreate write FBeforeAutoCreate; property OnCompareRecord: TNotifyEvent read FOnCompareRecord write FOnCompareRecord; property OnLanguageWarning: TLanguageWarningEvent read FOnLanguageWarning write FOnLanguageWarning; @@ -682,6 +691,7 @@ begin FTableLevel := 4; FIndexName := EmptyStr; FilePath := EmptyStr; + FUseAutoInc := True; FTempBuffer := nil; FFilterBuffer := nil; FIndexFile := nil; @@ -2719,6 +2729,19 @@ begin DoAfterScroll; end; +procedure TDbf.SetNextAutoInc(ThisNextAutoInc: Cardinal); +begin + DbfFile.NextAutoInc := ThisNextAutoInc; +end; + +procedure TDbf.SetUseAutoInc(ThisUseAutoInc: Boolean); +begin + if FUseAutoInc = ThisUseAutoInc then Exit; + + FUseAutoInc := ThisUseAutoInc; + DbfFile.UseAutoInc := FUseAutoInc; +end; + function TDbf.GetDbfFieldDefs: TDbfFieldDefs; begin if FDbfFile <> nil then @@ -3001,6 +3024,11 @@ begin Result := FMasterLink.FieldNames; end; +function TDbf.GetNextAutoInc: Cardinal; +begin + Result := DbfFile.NextAutoInc; +end; + procedure TDbf.SetMasterFields(const Value: string); begin FMasterLink.FieldNames := Value; diff --git a/packages/fcl-db/src/dbase/dbf_dbffile.pas b/packages/fcl-db/src/dbase/dbf_dbffile.pas index 66f22f9334..571fbc4440 100644 --- a/packages/fcl-db/src/dbase/dbf_dbffile.pas +++ b/packages/fcl-db/src/dbase/dbf_dbffile.pas @@ -104,6 +104,8 @@ type // Updates _NULLFLAGS field with null or varlength flag for field procedure UpdateNullField(Buffer: Pointer; AFieldDef: TDbfFieldDef; Action: TUpdateNullField; WhichField: TNullFieldFlag); procedure WriteLockInfo(Buffer: TRecordBuffer); + function GetNextAutoInc: Cardinal; + procedure SetNextAutoInc(ThisNextAutoInc: Cardinal); public constructor Create; @@ -131,7 +133,7 @@ type // Write dbf header as well as EOF marker at end of file if necessary procedure WriteHeader; override; // Writes autoinc value to record buffer and updates autoinc value in field header - procedure ApplyAutoIncToBuffer(DestBuf: TRecordBuffer); + procedure ApplyAutoIncToBuffer(DestBuf: TRecordBuffer); virtual; procedure FastPackTable; procedure RestructureTable(DbfFieldDefs: TDbfFieldDefs; Pack: Boolean); procedure Rename(DestFileName: string; NewIndexFileNames: TStrings; DeleteFiles: boolean); @@ -180,6 +182,8 @@ type property CopyDateTimeAsString: Boolean read FCopyDateTimeAsString write FCopyDateTimeAsString; property DateTimeHandling: TDateTimeHandling read FDateTimeHandling write FDateTimeHandling; + property NextAutoInc: Cardinal read GetNextAutoInc write SetNextAutoInc; + property OnIndexMissing: TDbfIndexMissingEvent read FOnIndexMissing write FOnIndexMissing; property OnLocaleError: TDbfLocaleErrorEvent read FOnLocaleError write FOnLocaleError; end; @@ -842,7 +846,7 @@ begin //AutoInc only support in Visual Foxpro; another upgrade //Note: .AutoIncrementNext is really a cardinal (see the definition) - lFieldDescIII.AutoIncrementNext:=SwapIntLE(lFieldDef.AutoInc); + PCardinal(@lFieldDescIII.AutoIncrementNext)^:=SwapIntLE(lFieldDef.AutoInc); lFieldDescIII.AutoIncrementStep:=lFieldDef.AutoIncStep; // Set autoincrement flag using AutoIncStep as a marker if (lFieldDef.AutoIncStep<>0) then @@ -952,6 +956,111 @@ begin end; end; +function TDbfFile.GetNextAutoInc: Cardinal; +var + TempFieldDef: TDbfFieldDef; + I, NextVal, lAutoIncOffset: Cardinal; +begin + Result := 0; + + if FAutoIncPresent then + begin + // if shared, reread header to find new autoinc values + if NeedLocks then + begin + // lock header so nobody else can use this value + LockPage(0, true); + end; + + // find autoinc fields + for I := 0 to FFieldDefs.Count-1 do + begin + TempFieldDef := FFieldDefs.Items[I]; + if (DbfVersion=xBaseVII) and + (TempFieldDef.NativeFieldType = '+') then + begin + // read current auto inc, from header or field, depending on sharing + lAutoIncOffset := sizeof(rDbfHdr) + sizeof(rEndFixedHdrVII) + + FieldDescVII_AutoIncOffset + I * sizeof(rFieldDescVII); + if NeedLocks then + begin + ReadBlock(@NextVal, 4, lAutoIncOffset); + NextVal := SwapIntLE(NextVal); + end else + NextVal := TempFieldDef.AutoInc; + // store to buffer, positive = high bit on, so flip it + Result := NextVal; + end + else //No DBaseVII + if (DbfVersion=xVisualFoxPro) and (TempFieldDef.NativeFieldType = 'I') and + (TempFieldDef.AutoIncStep<>0) then + begin + // read current auto inc from field header + lAutoIncOffset := SizeOf(rDbfHdr) + FieldDescIII_AutoIncOffset + + SizeOf(rFieldDescIII) * I; + if NeedLocks then + begin + ReadBlock(@NextVal, 4, lAutoIncOffset); + NextVal := SwapIntLE(NextVal); + end else + NextVal := TempFieldDef.AutoInc; + Result := NextVal; + end; + end; + + // release lock if locked + if NeedLocks then + UnlockPage(0); + end; +end; + +procedure TDbfFile.SetNextAutoInc(ThisNextAutoInc: Cardinal); +var + TempFieldDef: TDbfFieldDef; + I, NextVal, lAutoIncOffset: Cardinal; +begin + if FAutoIncPresent then + begin + // if shared, reread header to find new autoinc values + if NeedLocks then + begin + // lock header so nobody else can use this value + LockPage(0, true); + end; + + // find autoinc fields + for I := 0 to FFieldDefs.Count-1 do + begin + TempFieldDef := FFieldDefs.Items[I]; + if (DbfVersion=xBaseVII) and + (TempFieldDef.NativeFieldType = '+') then + begin + // read current auto inc, from header or field, depending on sharing + lAutoIncOffset := sizeof(rDbfHdr) + sizeof(rEndFixedHdrVII) + + FieldDescVII_AutoIncOffset + I * sizeof(rFieldDescVII); + // write new value to header buffer + PCardinal(FHeader+lAutoIncOffset)^ := SwapIntLE(ThisNextAutoInc); + end + else //No DBaseVII + if (DbfVersion=xVisualFoxPro) and (TempFieldDef.NativeFieldType = 'I') and + (TempFieldDef.AutoIncStep<>0) then + begin + // read current auto inc from field header + lAutoIncOffset := SizeOf(rDbfHdr) + FieldDescIII_AutoIncOffset + + SizeOf(rFieldDescIII) * I; + PCardinal(FHeader+lAutoIncOffset)^ := SwapIntLE(ThisNextAutoInc); + end; + end; + + // write modified header (new autoinc values) to file + WriteHeader; + + // release lock if locked + if NeedLocks then + UnlockPage(0); + end; +end; + function TDbfFile.HasBlob: Boolean; var I: Integer; @@ -1027,6 +1136,7 @@ var TempFieldDef: TDbfFieldDef; lSize,lPrec,I, lColumnCount: Integer; lAutoInc: Cardinal; + lAutoIncStep: Byte; dataPtr: PChar; lNativeFieldType: Char; lFieldName: string; @@ -1077,6 +1187,9 @@ begin try // Specs say there has to be at least one field, so use repeat: repeat + // clear autoinc params + lAutoInc := 0; + lAutoIncStep := 0; // version field info? if FDbfVersion = xBaseVII then begin @@ -1098,8 +1211,9 @@ begin if (FDBFVersion=xVisualFoxPro) and ((lFieldDescIII.VisualFoxProFlags and $0C)<>0) then begin // We do not test for an I field - we could implement our own N autoincrement this way... - lAutoInc:=lFieldDescIII.AutoIncrementNext; - FAutoIncPresent:=true; + lAutoInc := PCardinal(@lFieldDescIII.AutoIncrementNext)^; + lAutoIncStep := lFieldDescIII.AutoIncrementStep; + FAutoIncPresent := True; end; // Only Visual FoxPro supports null fields, if the nullable field flag is on @@ -1138,6 +1252,7 @@ begin Size := lSize; Precision := lPrec; AutoInc := lAutoInc; + AutoIncStep := lAutoIncStep; NativeFieldType := lNativeFieldType; IsSystemField := lIsVFPSystemField; if lIsVFPVarLength then @@ -2392,7 +2507,7 @@ var TempFieldDef: TDbfFieldDef; I, NextVal, lAutoIncOffset: {LongWord} Cardinal; {Delphi 3 does not know LongWord?} begin - if FAutoIncPresent then + if FAutoIncPresent and FUseAutoInc then begin // if shared, reread header to find new autoinc values if NeedLocks then @@ -2426,16 +2541,24 @@ begin PCardinal(FHeader+lAutoIncOffset)^ := SwapIntLE(NextVal); end else //No DBaseVII - if (DbfVersion=xVisualFoxPro) and + if (DbfVersion=xVisualFoxPro) and (TempFieldDef.NativeFieldType = 'I') and (TempFieldDef.AutoIncStep<>0) then begin // read current auto inc from field header - NextVal:=TempFieldDef.AutoInc; //todo: is this correct - PCardinal(DestBuf+TempFieldDef.Offset)^ := SwapIntBE(NextVal); //todo: is swapintbe correct? + lAutoIncOffset := SizeOf(rDbfHdr) + FieldDescIII_AutoIncOffset + + SizeOf(rFieldDescIII) * I; + if NeedLocks then + begin + ReadBlock(@NextVal, 4, lAutoIncOffset); + NextVal := SwapIntLE(NextVal); + end else + NextVal := TempFieldDef.AutoInc; + PCardinal(DestBuf+TempFieldDef.Offset)^ := SwapIntLE(NextVal); // Increase with step size NextVal:=NextVal+TempFieldDef.AutoIncStep; // write new value back TempFieldDef.AutoInc:=NextVal; + PCardinal(FHeader+lAutoIncOffset)^ := SwapIntLE(NextVal); end; end; diff --git a/packages/fcl-db/src/dbase/dbf_fields.pas b/packages/fcl-db/src/dbase/dbf_fields.pas index 33e7e69383..0e078b3178 100644 --- a/packages/fcl-db/src/dbase/dbf_fields.pas +++ b/packages/fcl-db/src/dbase/dbf_fields.pas @@ -467,7 +467,17 @@ begin case FFieldType of ftAutoInc : if DbfVersion=xVisualFoxPro then - FNativeFieldType := 'I' + begin + FNativeFieldType := 'I'; + // set some default autoinc start value and step + // without it field will be considered a simple integer field + // (not sure if this is the right place for that) + if (FAutoInc = 0) and (FAllocSize = 0) then + begin + FAutoInc := 1; + FAutoIncStep := 1; + end; + end else FNativeFieldType := '+'; //Apparently xbaseV/7+ only; not (Visual) Foxpro ftDateTime : diff --git a/packages/fcl-db/src/dbase/dbf_pgfile.pas b/packages/fcl-db/src/dbase/dbf_pgfile.pas index 8e166bff7b..ac7baf6290 100644 --- a/packages/fcl-db/src/dbase/dbf_pgfile.pas +++ b/packages/fcl-db/src/dbase/dbf_pgfile.pas @@ -79,6 +79,7 @@ type FBufferMaxSize: Integer; FBufferModified: Boolean; FWriteError: Boolean; + FUseAutoInc: Boolean; protected procedure SetHeaderOffset(NewValue: Integer); virtual; procedure SetRecordSize(NewValue: Integer); virtual; @@ -160,6 +161,7 @@ type property Stream: TStream read FStream write SetStream; property BufferAhead: Boolean read FBufferAhead write SetBufferAhead; property WriteError: Boolean read FWriteError; + property UseAutoInc: Boolean read FUseAutoInc write FUseAutoInc; end; implementation diff --git a/packages/fcl-db/src/dbase/dbf_struct.inc b/packages/fcl-db/src/dbase/dbf_struct.inc index 60b473ab0f..6288a2ca45 100644 --- a/packages/fcl-db/src/dbase/dbf_struct.inc +++ b/packages/fcl-db/src/dbase/dbf_struct.inc @@ -22,6 +22,7 @@ const FieldPropType_Default = $04; FieldPropType_Constraint = $06; + FieldDescIII_AutoIncOffset = 19; FieldDescVII_AutoIncOffset = 42; //====================================================================