Commit 8b3a5337 authored by Frank Rademakers's avatar Frank Rademakers
Browse files

With support for Visual Foxpro AutoInc, and the option to change or ignore it.

parent d23b4b0e
Pipeline #584878075 failed
......@@ -163,7 +163,6 @@ TDbfMasterLink = class(TDataLink)
//====================================================================
TDbf = class(TDataSet)
private
FDbfFile: TDbfFile;
FCursor: TVirtualCursor;
FOpenMode: TDbfOpenMode;
FStorage: TDbfStorage;
......@@ -200,6 +199,7 @@ TDbf = class(TDataSet)
FDateTimeHandling: TDateTimeHandling;
FTranslationMode: TDbfTranslationMode;
FIndexDefs: TDbfIndexDefs;
FUseAutoInc: Boolean;
FBeforeAutoCreate: TBeforeAutoCreateEvent;
FOnTranslate: TTranslateEvent;
FOnLanguageWarning: TLanguageWarningEvent;
......@@ -217,6 +217,7 @@ TDbf = class(TDataSet)
function GetPhysicalRecordCount: Integer;
function GetKeySize: Integer;
function GetMasterFields: string;
function GetNextAutoInc: Cardinal;
function FieldDefsStored: Boolean;
procedure SetBackLink(NewBackLink: String);
......@@ -230,6 +231,8 @@ TDbf = class(TDataSet)
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 @@ TDbf = class(TDataSet)
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 @@ TDbf = class(TDataSet)
// 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 @@ TDbf = class(TDataSet)
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 @@ constructor TDbf.Create(AOwner: TComponent); {override;}
FTableLevel := 4;
FIndexName := EmptyStr;
FilePath := EmptyStr;
FUseAutoInc := True;
FTempBuffer := nil;
FFilterBuffer := nil;
FIndexFile := nil;
......@@ -2719,6 +2729,19 @@ procedure TDbf.SetPhysicalRecNo(const NewRecNo: Integer);
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 @@ function TDbf.GetMasterFields: string;
Result := FMasterLink.FieldNames;
end;
function TDbf.GetNextAutoInc: Cardinal;
begin
Result := DbfFile.NextAutoInc;
end;
procedure TDbf.SetMasterFields(const Value: string);
begin
FMasterLink.FieldNames := Value;
......
......@@ -104,6 +104,8 @@ TDbfFile = class(TPagedFile)
// 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 @@ TDbfFile = class(TPagedFile)
// 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 @@ TDbfFile = class(TPagedFile)
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 @@ procedure TDbfFile.FinishCreate(AFieldDefs: TDbfFieldDefs; MemoSize: Integer);
//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 @@ procedure TDbfFile.FinishCreate(AFieldDefs: TDbfFieldDefs; MemoSize: Integer);
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 @@ procedure TDbfFile.ConstructFieldDefs;
TempFieldDef: TDbfFieldDef;
lSize,lPrec,I, lColumnCount: Integer;
lAutoInc: Cardinal;
lAutoIncStep: Byte;
dataPtr: PChar;
lNativeFieldType: Char;
lFieldName: string;
......@@ -1077,6 +1187,9 @@ procedure TDbfFile.ConstructFieldDefs;
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 @@ procedure TDbfFile.ConstructFieldDefs;
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 @@ procedure TDbfFile.ConstructFieldDefs;
Size := lSize;
Precision := lPrec;
AutoInc := lAutoInc;
AutoIncStep := lAutoIncStep;
NativeFieldType := lNativeFieldType;
IsSystemField := lIsVFPSystemField;
if lIsVFPVarLength then
......@@ -2392,7 +2507,7 @@ procedure TDbfFile.ApplyAutoIncToBuffer(DestBuf: TRecordBuffer);
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 @@ procedure TDbfFile.ApplyAutoIncToBuffer(DestBuf: TRecordBuffer);
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;
......
......@@ -467,7 +467,17 @@ procedure TDbfFieldDef.VCLToNative;
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 :
......
......@@ -79,6 +79,7 @@ TPagedFile = class(TObject)
FBufferMaxSize: Integer;
FBufferModified: Boolean;
FWriteError: Boolean;
FUseAutoInc: Boolean;
protected
procedure SetHeaderOffset(NewValue: Integer); virtual;
procedure SetRecordSize(NewValue: Integer); virtual;
......@@ -160,6 +161,7 @@ TPagedFile = class(TObject)
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
......
......@@ -22,6 +22,7 @@
FieldPropType_Default = $04;
FieldPropType_Constraint = $06;
FieldDescIII_AutoIncOffset = 19;
FieldDescVII_AutoIncOffset = 42;
//====================================================================
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment