mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-20 19:09:23 +02:00
* 64-bit patches from Neli and Andrew
git-svn-id: trunk@2315 -
This commit is contained in:
marco
parent
2ef0f67ebb
commit
46ff92bb60
@ -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
|
||||
|
||||
@ -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 \
|
||||
|
||||
@ -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
|
||||
|
||||
@ -2,6 +2,11 @@ unit dbf_avl;
|
||||
|
||||
interface
|
||||
|
||||
{$I dbf_common.inc}
|
||||
|
||||
uses
|
||||
Dbf_Common;
|
||||
|
||||
type
|
||||
TBal = -1..1;
|
||||
|
||||
|
||||
@ -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}
|
||||
|
||||
@ -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}
|
||||
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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':
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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;
|
||||
|
||||
// ------------------------------------------------------------------
|
||||
|
||||
@ -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));
|
||||
|
||||
@ -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;
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user