mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-09-14 07:49:21 +02:00
Merged revisions 3358 via svnmerge from
svn+ssh://svn.freepascal.org/FPC/svn/fpc/trunk ........ r3358 | micha | 2006-04-29 16:34:43 +0200 (za, 29 apr 2006) | 1 line update tdbf to release 6.4.8 ........ git-svn-id: branches/fixes_2_0@3359 -
This commit is contained in:
micha
parent
a6f2ad347d
commit
52c37eb680
@ -163,6 +163,9 @@ type
|
||||
FFilterBuffer: PChar;
|
||||
FTempBuffer: PChar;
|
||||
FEditingRecNo: Integer;
|
||||
{$ifdef SUPPORT_VARIANTS}
|
||||
FLocateRecNo: Integer;
|
||||
{$endif}
|
||||
FLanguageID: Byte;
|
||||
FTableLevel: Integer;
|
||||
FExclusive: Boolean;
|
||||
@ -212,7 +215,6 @@ type
|
||||
procedure MasterChanged(Sender: TObject);
|
||||
procedure MasterDisabled(Sender: TObject);
|
||||
procedure DetermineTranslationMode;
|
||||
procedure CheckMasterRange;
|
||||
procedure UpdateRange;
|
||||
procedure SetShowDeleted(Value: Boolean);
|
||||
procedure GetFieldDefsFromDbfFieldDefs;
|
||||
@ -274,6 +276,8 @@ type
|
||||
procedure SetIndexFieldNames(const Value: string); {virtual;}
|
||||
|
||||
{$ifdef SUPPORT_VARIANTS}
|
||||
function LocateRecordLinear(const KeyFields: String; const KeyValues: Variant; Options: TLocateOptions): Boolean;
|
||||
function LocateRecordIndex(const KeyFields: String; const KeyValues: Variant; Options: TLocateOptions): Boolean;
|
||||
function LocateRecord(const KeyFields: String; const KeyValues: Variant; Options: TLocateOptions): Boolean;
|
||||
{$endif}
|
||||
|
||||
@ -318,6 +322,7 @@ type
|
||||
procedure RegenerateIndexes;
|
||||
|
||||
procedure CancelRange;
|
||||
procedure CheckMasterRange;
|
||||
{$ifdef SUPPORT_VARIANTS}
|
||||
function SearchKey(Key: Variant; SearchType: TSearchKeyType): Boolean;
|
||||
procedure SetRange(LowRange: Variant; HighRange: Variant);
|
||||
@ -387,7 +392,7 @@ type
|
||||
property FilePathFull: string read FAbsolutePath write SetFilePath stored false;
|
||||
property Indexes: TDbfIndexDefs read FIndexDefs write SetDbfIndexDefs stored false;
|
||||
property IndexDefs: TDbfIndexDefs read FIndexDefs write SetDbfIndexDefs;
|
||||
property IndexFieldNames: string read GetIndexFieldNames write SetIndexFieldNames;
|
||||
property IndexFieldNames: string read GetIndexFieldNames write SetIndexFieldNames stored false;
|
||||
property IndexName: string read GetIndexName write SetIndexName;
|
||||
property MasterFields: string read GetMasterFields write SetMasterFields;
|
||||
property MasterSource: TDataSource read GetDataSource write SetDataSource;
|
||||
@ -460,7 +465,7 @@ uses
|
||||
Types,
|
||||
dbf_wtil,
|
||||
{$endif}
|
||||
{$ifdef DELPHI_6}
|
||||
{$ifdef SUPPORT_SEPARATE_VARIANTS_UNIT}
|
||||
Variants,
|
||||
{$endif}
|
||||
dbf_idxcur,
|
||||
@ -706,24 +711,11 @@ begin
|
||||
if Field.FieldNo>0 then
|
||||
begin
|
||||
Result := FDbfFile.GetFieldData(Field.FieldNo-1, Field.DataType, Src, Buffer);
|
||||
end else begin { calculated fields.... }
|
||||
end else begin { weird calculated fields voodoo (from dbtables).... }
|
||||
Inc(PChar(Src), Field.Offset + GetRecordSize);
|
||||
// Result := Boolean(PChar(Buffer)[0]);
|
||||
Result := true;
|
||||
if {Result and (Src <> nil) and } (Buffer <> nil) then
|
||||
begin
|
||||
// A ftBoolean was 1 byte in Delphi 3
|
||||
// it is now 2 byte in Delphi 5
|
||||
// not sure about delphi 4.
|
||||
{$ifdef DELPHI_5}
|
||||
Move(Src^, Buffer^, Field.DataSize);
|
||||
{$else}
|
||||
if Field.DataType = ftBoolean then
|
||||
Move(Src^, Buffer^, 1)
|
||||
else
|
||||
Move(Src^, Buffer^, Field.DataSize);
|
||||
{$endif}
|
||||
end;
|
||||
Result := Boolean(Src[0]);
|
||||
if Result and (Buffer <> nil) then
|
||||
Move(Src[1], Buffer^, Field.DataSize);
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -822,6 +814,11 @@ begin
|
||||
|
||||
if (Result = grOK) and acceptable then
|
||||
begin
|
||||
pRecord^.BookmarkData.PhysicalRecNo := FCursor.PhysicalRecNo;
|
||||
pRecord^.BookmarkFlag := bfCurrent;
|
||||
pRecord^.SequentialRecNo := FCursor.SequentialRecNo;
|
||||
GetCalcFields(Buffer);
|
||||
|
||||
if Filtered or FFindRecordFilter then
|
||||
begin
|
||||
FFilterBuffer := Buffer;
|
||||
@ -835,15 +832,8 @@ begin
|
||||
Result := grError;
|
||||
until (Result <> grOK) or acceptable;
|
||||
|
||||
if (Result = grOK) and not FFindRecordFilter then
|
||||
begin
|
||||
pRecord^.BookmarkData.PhysicalRecNo := FCursor.PhysicalRecNo;
|
||||
pRecord^.BookmarkFlag := bfCurrent;
|
||||
pRecord^.SequentialRecNo := FCursor.SequentialRecNo;
|
||||
GetCalcFields(Buffer);
|
||||
end else begin
|
||||
if Result <> grOK then
|
||||
pRecord^.BookmarkData.PhysicalRecNo := -1;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TDbf.GetRecordSize: Word; {override virtual abstract from TDataset}
|
||||
@ -1554,13 +1544,18 @@ begin
|
||||
lSrcField := DataSet.Fields[I];
|
||||
with lFieldDefs.AddFieldDef do
|
||||
begin
|
||||
FieldName := lSrcField.Name;
|
||||
if Length(lSrcField.Name) > 0 then
|
||||
FieldName := lSrcField.Name
|
||||
else
|
||||
FieldName := lSrcField.FieldName;
|
||||
FieldType := lSrcField.DataType;
|
||||
Required := lSrcField.Required;
|
||||
Size := lSrcField.Size;
|
||||
if (0 <= lSrcField.FieldNo)
|
||||
and (lSrcField.FieldNo < lPhysFieldDefs.Count) then
|
||||
Precision := lPhysFieldDefs.Items[lSrcField.FieldNo].Precision;
|
||||
if (1 <= lSrcField.FieldNo)
|
||||
and (lSrcField.FieldNo <= lPhysFieldDefs.Count) then
|
||||
begin
|
||||
Size := lPhysFieldDefs.Items[lSrcField.FieldNo-1].Size;
|
||||
Precision := lPhysFieldDefs.Items[lSrcField.FieldNo-1].Precision;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -1684,17 +1679,20 @@ begin
|
||||
|
||||
DoBeforeScroll;
|
||||
saveRecNo := FCursor.SequentialRecNo;
|
||||
FLocateRecNo := -1;
|
||||
Result := LocateRecord(KeyFields, KeyValues, Options);
|
||||
CursorPosChanged;
|
||||
if Result then
|
||||
begin
|
||||
if FLocateRecNo <> -1 then
|
||||
FCursor.PhysicalRecNo := FLocateRecNo;
|
||||
Resync([]);
|
||||
DoAfterScroll;
|
||||
end else
|
||||
FCursor.SequentialRecNo := saveRecNo;
|
||||
end;
|
||||
|
||||
function TDbf.LocateRecord(const KeyFields: String; const KeyValues: Variant;
|
||||
function TDbf.LocateRecordLinear(const KeyFields: String; const KeyValues: Variant;
|
||||
Options: TLocateOptions): Boolean;
|
||||
var
|
||||
lstKeys : TList;
|
||||
@ -1703,7 +1701,6 @@ var
|
||||
bMatchedData : Boolean;
|
||||
bVarIsArray : Boolean;
|
||||
varCompare : Variant;
|
||||
doLinSearch : Boolean;
|
||||
|
||||
function CompareValues: Boolean;
|
||||
var
|
||||
@ -1740,96 +1737,138 @@ var
|
||||
end;
|
||||
|
||||
var
|
||||
searchFlag: TSearchKeyType;
|
||||
lPhysRecNo, matchRes: Integer;
|
||||
SaveState: TDataSetState;
|
||||
lTempBuffer: array [0..100] of Char;
|
||||
|
||||
lPhysRecNo: integer;
|
||||
begin
|
||||
Result := false;
|
||||
doLinSearch := true;
|
||||
// index active?
|
||||
if FCursor is TIndexCursor then
|
||||
begin
|
||||
// matches field to search on?
|
||||
if TIndexCursor(FCursor).IndexFile.Expression = KeyFields then
|
||||
bVarIsArray := false;
|
||||
lstKeys := TList.Create;
|
||||
FFilterBuffer := TempBuffer;
|
||||
SaveState := SetTempState(dsFilter);
|
||||
try
|
||||
GetFieldList(lstKeys, KeyFields);
|
||||
if VarArrayDimCount(KeyValues) = 0 then
|
||||
bMatchedData := lstKeys.Count = 1
|
||||
else if VarArrayDimCount (KeyValues) = 1 then
|
||||
begin
|
||||
// can do index search
|
||||
doLinSearch := false;
|
||||
if loPartialKey in Options then
|
||||
searchFlag := stGreaterEqual
|
||||
else
|
||||
searchFlag := stEqual;
|
||||
TIndexCursor(FCursor).VariantToBuffer(KeyValues, @lTempBuffer[0]);
|
||||
Result := FIndexFile.SearchKey(@lTempBuffer[0], searchFlag);
|
||||
bMatchedData := VarArrayHighBound (KeyValues,1) + 1 = lstKeys.Count;
|
||||
bVarIsArray := true;
|
||||
end else
|
||||
bMatchedData := false;
|
||||
if bMatchedData then
|
||||
begin
|
||||
FCursor.First;
|
||||
while not Result and FCursor.Next do
|
||||
begin
|
||||
lPhysRecNo := FCursor.PhysicalRecNo;
|
||||
if (lPhysRecNo = 0) or not FDbfFile.IsRecordPresent(lPhysRecNo) then
|
||||
break;
|
||||
|
||||
FDbfFile.ReadRecord(lPhysRecNo, @PDbfRecord(FFilterBuffer)^.DeletedFlag);
|
||||
Result := FShowDeleted or (PDbfRecord(FFilterBuffer)^.DeletedFlag <> '*');
|
||||
if Result and Filtered then
|
||||
DoFilterRecord(Result);
|
||||
|
||||
iIndex := 0;
|
||||
while Result and (iIndex < lstKeys.Count) Do
|
||||
begin
|
||||
Field := TField (lstKeys [iIndex]);
|
||||
if bVarIsArray then
|
||||
varCompare := KeyValues [iIndex]
|
||||
else
|
||||
varCompare := KeyValues;
|
||||
Result := CompareValues;
|
||||
Inc(iIndex);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
finally
|
||||
lstKeys.Free;
|
||||
RestoreState(SaveState);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TDbf.LocateRecordIndex(const KeyFields: String; const KeyValues: Variant;
|
||||
Options: TLocateOptions): Boolean;
|
||||
var
|
||||
searchFlag: TSearchKeyType;
|
||||
matchRes: Integer;
|
||||
lTempBuffer: array [0..100] of Char;
|
||||
begin
|
||||
if loPartialKey in Options then
|
||||
searchFlag := stGreaterEqual
|
||||
else
|
||||
searchFlag := stEqual;
|
||||
TIndexCursor(FCursor).VariantToBuffer(KeyValues, @lTempBuffer[0]);
|
||||
Result := FIndexFile.SearchKey(@lTempBuffer[0], searchFlag);
|
||||
if Result then
|
||||
begin
|
||||
Result := GetRecord(TempBuffer, gmCurrent, false) = grOK;
|
||||
if not Result then
|
||||
begin
|
||||
Result := GetRecord(TempBuffer, gmNext, false) = grOK;
|
||||
if Result then
|
||||
begin
|
||||
Result := GetRecord(TempBuffer, gmCurrent, false) = grOK;
|
||||
if not Result then
|
||||
begin
|
||||
Result := GetRecord(TempBuffer, gmNext, false) = grOK;
|
||||
if Result then
|
||||
begin
|
||||
matchRes := TIndexCursor(FCursor).IndexFile.MatchKey(@lTempBuffer[0]);
|
||||
if loPartialKey in Options then
|
||||
Result := matchRes <= 0
|
||||
else
|
||||
Result := matchRes = 0;
|
||||
end;
|
||||
end;
|
||||
FFilterBuffer := TempBuffer;
|
||||
matchRes := TIndexCursor(FCursor).IndexFile.MatchKey(@lTempBuffer[0]);
|
||||
if loPartialKey in Options then
|
||||
Result := matchRes <= 0
|
||||
else
|
||||
Result := matchRes = 0;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
if doLinSearch then
|
||||
begin
|
||||
bVarIsArray := false;
|
||||
lstKeys := TList.Create;
|
||||
FFilterBuffer := TempBuffer;
|
||||
SaveState := SetTempState(dsFilter);
|
||||
try
|
||||
GetFieldList(lstKeys, KeyFields);
|
||||
if VarArrayDimCount(KeyValues) = 0 then
|
||||
bMatchedData := lstKeys.Count = 1
|
||||
else if VarArrayDimCount (KeyValues) = 1 then
|
||||
end;
|
||||
end;
|
||||
|
||||
function TDbf.LocateRecord(const KeyFields: String; const KeyValues: Variant;
|
||||
Options: TLocateOptions): Boolean;
|
||||
var
|
||||
lCursor, lSaveCursor: TVirtualCursor;
|
||||
lSaveIndexName, lIndexName: string;
|
||||
lIndexDef: TDbfIndexDef;
|
||||
lIndexFile, lSaveIndexFile: TIndexFile;
|
||||
begin
|
||||
lCursor := nil;
|
||||
lSaveCursor := nil;
|
||||
lIndexFile := nil;
|
||||
lSaveIndexFile := FIndexFile;
|
||||
if (FCursor is TIndexCursor)
|
||||
and (TIndexCursor(FCursor).IndexFile.Expression = KeyFields) then
|
||||
begin
|
||||
lCursor := FCursor;
|
||||
end else begin
|
||||
lIndexDef := FIndexDefs.GetIndexByField(KeyFields);
|
||||
if lIndexDef <> nil then
|
||||
begin
|
||||
lIndexName := ParseIndexName(lIndexDef.IndexFile);
|
||||
lIndexFile := FDbfFile.GetIndexByName(lIndexName);
|
||||
if lIndexFile <> nil then
|
||||
begin
|
||||
bMatchedData := VarArrayHighBound (KeyValues,1) + 1 = lstKeys.Count;
|
||||
bVarIsArray := true;
|
||||
end else
|
||||
bMatchedData := false;
|
||||
if bMatchedData then
|
||||
begin
|
||||
FCursor.First;
|
||||
while not Result and FCursor.Next do
|
||||
begin
|
||||
lPhysRecNo := FCursor.PhysicalRecNo;
|
||||
if (lPhysRecNo = 0) or not FDbfFile.IsRecordPresent(lPhysRecNo) then
|
||||
break;
|
||||
|
||||
FDbfFile.ReadRecord(lPhysRecNo, @PDbfRecord(FFilterBuffer)^.DeletedFlag);
|
||||
Result := FShowDeleted or (PDbfRecord(FFilterBuffer)^.DeletedFlag <> '*');
|
||||
if Result and Filtered then
|
||||
DoFilterRecord(Result);
|
||||
|
||||
iIndex := 0;
|
||||
while Result and (iIndex < lstKeys.Count) Do
|
||||
begin
|
||||
Field := TField (lstKeys [iIndex]);
|
||||
if bVarIsArray then
|
||||
varCompare := KeyValues [iIndex]
|
||||
else
|
||||
varCompare := KeyValues;
|
||||
Result := CompareValues;
|
||||
Inc(iIndex);
|
||||
end;
|
||||
end;
|
||||
lSaveCursor := FCursor;
|
||||
lCursor := TIndexCursor.Create(lIndexFile);
|
||||
lSaveIndexName := lIndexFile.IndexName;
|
||||
lIndexFile.IndexName := lIndexName;
|
||||
FIndexFile := lIndexFile;
|
||||
end;
|
||||
finally
|
||||
lstKeys.Free;
|
||||
RestoreState(SaveState);
|
||||
end;
|
||||
end;
|
||||
if lCursor <> nil then
|
||||
begin
|
||||
FCursor := lCursor;
|
||||
Result := LocateRecordIndex(KeyFields, KeyValues, Options);
|
||||
if lSaveCursor <> nil then
|
||||
begin
|
||||
FCursor.Free;
|
||||
FCursor := lSaveCursor;
|
||||
end;
|
||||
if lIndexFile <> nil then
|
||||
begin
|
||||
FLocateRecNo := FIndexFile.PhysicalRecNo;
|
||||
lIndexFile.IndexName := lSaveIndexName;
|
||||
FIndexFile := lSaveIndexFile;
|
||||
end;
|
||||
end else
|
||||
Result := LocateRecordLinear(KeyFields, KeyValues, Options);
|
||||
end;
|
||||
|
||||
{$endif}
|
||||
@ -2030,26 +2069,18 @@ end;
|
||||
|
||||
procedure TDbf.SetFieldData(Field: TField; Buffer: Pointer); {override virtual abstract from TDataset}
|
||||
var
|
||||
pRecord: pDbfRecord;
|
||||
Dst: Pointer;
|
||||
Dst: PChar;
|
||||
begin
|
||||
if (Field.FieldNo >= 0) then
|
||||
begin
|
||||
pRecord := pDbfRecord(ActiveBuffer);
|
||||
dst := @pRecord^.DeletedFlag;
|
||||
Dst := @PDbfRecord(ActiveBuffer)^.DeletedFlag;
|
||||
FDbfFile.SetFieldData(Field.FieldNo - 1,Field.DataType,Buffer,Dst);
|
||||
end else begin { ***** fkCalculated, fkLookup ***** }
|
||||
pRecord := pDbfRecord(CalcBuffer);
|
||||
Dst := @pRecord^.DeletedFlag;
|
||||
Dst := @PDbfRecord(CalcBuffer)^.DeletedFlag;
|
||||
Inc(PChar(Dst), RecordSize + Field.Offset);
|
||||
// Boolean(dst^) := LongBool(Buffer);
|
||||
// if Boolean(dst^) then begin
|
||||
// Inc(Integer(dst), 1);
|
||||
Boolean(Dst[0]) := Buffer <> nil;
|
||||
if Buffer <> nil then
|
||||
Move(Buffer^, Dst^, Field.DataSize)
|
||||
else
|
||||
FillChar(Dst^, Field.DataSize, #0);
|
||||
// end;
|
||||
Move(Buffer^, Dst[1], Field.DataSize)
|
||||
end; { end of ***** fkCalculated, fkLookup ***** }
|
||||
if not (State in [dsCalcFields, dsFilter, dsNewValue]) then begin
|
||||
DataEvent(deFieldChange, PtrInt(Field));
|
||||
@ -2667,7 +2698,7 @@ function TDbf.SearchKeyPChar(Key: PChar; SearchType: TSearchKeyType): Boolean;
|
||||
var
|
||||
StringBuf: array [0..100] of Char;
|
||||
begin
|
||||
if FIndexFile = nil then
|
||||
if FCursor = nil then
|
||||
begin
|
||||
Result := false;
|
||||
exit;
|
||||
|
||||
@ -190,6 +190,7 @@
|
||||
{$ifdef DELPHI_6}
|
||||
|
||||
{$define SUPPORT_PATHDELIM}
|
||||
{$define SUPPORT_SEPARATE_VARIANTS_UNIT}
|
||||
|
||||
{$endif}
|
||||
{$endif}
|
||||
@ -226,6 +227,8 @@
|
||||
{$define SUPPORT_UINT32_CARDINAL}
|
||||
{$define SUPPORT_REINTRODUCE}
|
||||
{$define SUPPORT_MATH_UNIT}
|
||||
{$define SUPPORT_VARIANTS}
|
||||
{$define SUPPORT_SEPARATE_VARIANTS_UNIT}
|
||||
|
||||
// FPC 2.0.x improvements
|
||||
{$ifdef VER2}
|
||||
|
||||
@ -22,6 +22,8 @@ const
|
||||
|
||||
TDBF_TABLELEVEL_FOXPRO = 25;
|
||||
|
||||
JulianDateDelta = 1721425; { number of days between 1.1.4714 BC and "0" }
|
||||
|
||||
type
|
||||
EDbfError = class (EDatabaseError);
|
||||
EDbfWriteError = class (EDbfError);
|
||||
|
||||
@ -1146,9 +1146,8 @@ var
|
||||
TempDstDef, TempSrcDef: TDbfFieldDef;
|
||||
OldIndexFiles: TStrings;
|
||||
IndexName, NewBaseName: string;
|
||||
I, lRecNo, lFieldNo, lFieldSize, lBlobRecNo, lWRecNo, srcOffset, dstOffset: Integer;
|
||||
I, lRecNo, lFieldNo, lFieldSize, lBlobPageNo, lWRecNo, srcOffset, dstOffset: Integer;
|
||||
pBuff, pDestBuff: PChar;
|
||||
pBlobRecNoBuff: array[1..11] of Char;
|
||||
RestructFieldInfo: PRestructFieldInfo;
|
||||
BlobStream: TMemoryStream;
|
||||
begin
|
||||
@ -1303,19 +1302,18 @@ begin
|
||||
if TempDstDef.IsBlob and ((DbfFieldDefs = nil) or (TempDstDef.CopyFrom >= 0)) then
|
||||
begin
|
||||
// get current blob blockno
|
||||
GetFieldData(lFieldNo, ftString, pBuff, @pBlobRecNoBuff[1]);
|
||||
lBlobRecNo := StrToIntDef(pBlobRecNoBuff, -1);
|
||||
GetFieldData(lFieldNo, ftInteger, pBuff, @lBlobPageNo);
|
||||
// valid blockno read?
|
||||
if lBlobRecNo >= 0 then
|
||||
if lBlobPageNo > 0 then
|
||||
begin
|
||||
BlobStream.Clear;
|
||||
FMemoFile.ReadMemo(lBlobRecNo, BlobStream);
|
||||
FMemoFile.ReadMemo(lBlobPageNo, BlobStream);
|
||||
BlobStream.Position := 0;
|
||||
// always append
|
||||
DestDbfFile.FMemoFile.WriteMemo(lBlobRecNo, 0, BlobStream);
|
||||
DestDbfFile.FMemoFile.WriteMemo(lBlobPageNo, 0, BlobStream);
|
||||
end;
|
||||
// write new blockno
|
||||
DestDbfFile.SetFieldData(lFieldNo, ftInteger, @lBlobRecNo, pDestBuff);
|
||||
DestDbfFile.SetFieldData(lFieldNo, ftInteger, @lBlobPageNo, pDestBuff);
|
||||
end else if (DbfFieldDefs <> nil) and (TempDstDef.CopyFrom >= 0) then
|
||||
begin
|
||||
// copy content of field
|
||||
@ -1497,6 +1495,7 @@ begin
|
||||
FieldSize := AFieldDef.Size;
|
||||
Src := PChar(Src) + FieldOffset;
|
||||
asciiContents := false;
|
||||
Result := true;
|
||||
// field types that are binary and of which the fieldsize should not be truncated
|
||||
case AFieldDef.NativeFieldType of
|
||||
'+', 'I':
|
||||
@ -1549,7 +1548,7 @@ begin
|
||||
Result := (PInteger(Src)^ <> 0) or (PInteger(PChar(Src)+4)^ <> 0);
|
||||
if Result and (Dst <> nil) then
|
||||
begin
|
||||
timeStamp.Date := PInteger(Src)^ - 1721425;
|
||||
timeStamp.Date := PInteger(Src)^ - JulianDateDelta;
|
||||
timeStamp.Time := PInteger(PChar(Src)+4)^;
|
||||
date := TimeStampToDateTime(timeStamp);
|
||||
SaveDateToDst;
|
||||
@ -1803,7 +1802,7 @@ begin
|
||||
end else begin
|
||||
LoadDateFromSrc;
|
||||
timeStamp := DateTimeToTimeStamp(date);
|
||||
PInteger(Dst)^ := timeStamp.Date + 1721425;
|
||||
PInteger(Dst)^ := timeStamp.Date + JulianDateDelta;
|
||||
PInteger(PChar(Dst)+4)^ := timeStamp.Time;
|
||||
end;
|
||||
end;
|
||||
@ -2129,42 +2128,47 @@ begin
|
||||
// always uppercase index expression
|
||||
IndexField := AnsiUpperCase(IndexField);
|
||||
try
|
||||
// create index if asked
|
||||
lIndexFile.CreateIndex(IndexField, IndexName, Options);
|
||||
// add all records
|
||||
PackIndex(lIndexFile, IndexName);
|
||||
// if we wanted to open index readonly, but we created it, then reopen
|
||||
if Mode = pfReadOnly then
|
||||
begin
|
||||
lIndexFile.CloseFile;
|
||||
lIndexFile.Mode := pfReadOnly;
|
||||
lIndexFile.OpenFile;
|
||||
end;
|
||||
// if mdx file just created, write changes to dbf header
|
||||
// set MDX flag to true
|
||||
PDbfHdr(Header)^.MDXFlag := 1;
|
||||
WriteHeader;
|
||||
except
|
||||
// :-( need to undo 'damage'....
|
||||
// remove index from list(s) if just added
|
||||
if addedIndexFile >= 0 then
|
||||
FIndexFiles.Delete(addedIndexFile);
|
||||
if addedIndexName >= 0 then
|
||||
FIndexNames.Delete(addedIndexName);
|
||||
// delete index file itself
|
||||
lIndexFile.DeleteIndex(IndexName);
|
||||
// if no file created, do not destroy!
|
||||
if addedIndexFile >= 0 then
|
||||
begin
|
||||
lIndexFile.Close;
|
||||
Sysutils.DeleteFile(lIndexFileName);
|
||||
if FMdxFile = lIndexFile then
|
||||
FMdxFile := nil;
|
||||
lIndexFile.Free;
|
||||
try
|
||||
// create index if asked
|
||||
lIndexFile.CreateIndex(IndexField, IndexName, Options);
|
||||
// add all records
|
||||
PackIndex(lIndexFile, IndexName);
|
||||
// if we wanted to open index readonly, but we created it, then reopen
|
||||
if Mode = pfReadOnly then
|
||||
begin
|
||||
lIndexFile.CloseFile;
|
||||
lIndexFile.Mode := pfReadOnly;
|
||||
lIndexFile.OpenFile;
|
||||
end;
|
||||
// if mdx file just created, write changes to dbf header
|
||||
// set MDX flag to true
|
||||
PDbfHdr(Header)^.MDXFlag := 1;
|
||||
WriteHeader;
|
||||
except
|
||||
on EDbfError do
|
||||
begin
|
||||
// :-( need to undo 'damage'....
|
||||
// remove index from list(s) if just added
|
||||
if addedIndexFile >= 0 then
|
||||
FIndexFiles.Delete(addedIndexFile);
|
||||
if addedIndexName >= 0 then
|
||||
FIndexNames.Delete(addedIndexName);
|
||||
// if no file created, do not destroy!
|
||||
if addedIndexFile >= 0 then
|
||||
begin
|
||||
lIndexFile.Close;
|
||||
Sysutils.DeleteFile(lIndexFileName);
|
||||
if FMdxFile = lIndexFile then
|
||||
FMdxFile := nil;
|
||||
lIndexFile.Free;
|
||||
end;
|
||||
raise;
|
||||
end;
|
||||
end;
|
||||
finally
|
||||
// return to previous mode
|
||||
if TempMode <> pfNone then EndExclusive;
|
||||
end;
|
||||
// return to previous mode
|
||||
if TempMode <> pfNone then EndExclusive;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
@ -2203,24 +2207,35 @@ begin
|
||||
if lIndexFile.CacheSize < 16384 * 1024 then
|
||||
lIndexFile.CacheSize := 16384 * 1024;
|
||||
{$endif}
|
||||
while cur <= last do
|
||||
begin
|
||||
ReadRecord(cur, FPrevBuffer);
|
||||
lIndexFile.Insert(cur, FPrevBuffer);
|
||||
inc(cur);
|
||||
try
|
||||
try
|
||||
while cur <= last do
|
||||
begin
|
||||
ReadRecord(cur, FPrevBuffer);
|
||||
lIndexFile.Insert(cur, FPrevBuffer);
|
||||
inc(cur);
|
||||
end;
|
||||
except
|
||||
on E: EDbfError do
|
||||
begin
|
||||
lIndexFile.DeleteIndex(lIndexFile.IndexName);
|
||||
raise;
|
||||
end;
|
||||
end;
|
||||
finally
|
||||
// restore previous mode
|
||||
{$ifdef USE_CACHE}
|
||||
BufferAhead := false;
|
||||
lIndexFile.BufferAhead := true;
|
||||
{$endif}
|
||||
lIndexFile.Flush;
|
||||
{$ifdef USE_CACHE}
|
||||
lIndexFile.BufferAhead := false;
|
||||
lIndexFile.CacheSize := prevCache;
|
||||
{$endif}
|
||||
lIndexFile.UpdateMode := prevMode;
|
||||
lIndexFile.IndexName := prevIndex;
|
||||
end;
|
||||
// restore previous mode
|
||||
{$ifdef USE_CACHE}
|
||||
BufferAhead := false;
|
||||
lIndexFile.BufferAhead := true;
|
||||
{$endif}
|
||||
lIndexFile.Flush;
|
||||
{$ifdef USE_CACHE}
|
||||
lIndexFile.BufferAhead := false;
|
||||
lIndexFile.CacheSize := prevCache;
|
||||
{$endif}
|
||||
lIndexFile.UpdateMode := prevMode;
|
||||
lIndexFile.IndexName := prevIndex;
|
||||
end;
|
||||
|
||||
procedure TDbfFile.RepageIndex(AIndexFile: string);
|
||||
@ -2690,8 +2705,11 @@ begin
|
||||
{$ifdef WIN32}
|
||||
FUserNameLen := MAX_COMPUTERNAME_LENGTH+1;
|
||||
SetLength(FUserName, FUserNameLen);
|
||||
// Windows.GetUserName(@FUserName[0], FUserNameLen);
|
||||
Windows.GetComputerName(PChar(FUserName), FUserNameLen);
|
||||
Windows.GetComputerName(PChar(FUserName),
|
||||
{$ifdef DELPHI_3}Windows.DWORD({$endif}
|
||||
FUserNameLen
|
||||
{$ifdef DELPHI_3}){$endif}
|
||||
);
|
||||
SetLength(FUserName, FUserNameLen);
|
||||
{$else}
|
||||
{$ifdef FPC}
|
||||
|
||||
@ -258,7 +258,10 @@ begin
|
||||
// convert VCL fieldtypes to native DBF fieldtypes
|
||||
VCLToNative;
|
||||
// for integer / float fields try fill in size/precision
|
||||
CheckSizePrecision;
|
||||
if FSize = 0 then
|
||||
SetDefaultSize
|
||||
else
|
||||
CheckSizePrecision;
|
||||
// VCL does not have default value support
|
||||
AllocBuffers;
|
||||
FHasDefault := false;
|
||||
@ -430,7 +433,7 @@ begin
|
||||
ftFloat:
|
||||
begin
|
||||
FSize := 18;
|
||||
FPrecision := 9;
|
||||
FPrecision := 8;
|
||||
end;
|
||||
ftCurrency, ftBCD:
|
||||
begin
|
||||
|
||||
@ -2916,6 +2916,9 @@ end;
|
||||
|
||||
procedure TIndexFile.InsertKey(Buffer: PChar);
|
||||
begin
|
||||
// ignore deleted records
|
||||
if (FModifyMode = mmNormal) and (FUniqueMode = iuDistinct) and (Buffer^ = '*') then
|
||||
exit;
|
||||
// check proper index and modifiability
|
||||
if FCanEdit and (PIndexHdr(FIndexHeader)^.KeyLen <> 0) then
|
||||
begin
|
||||
|
||||
@ -208,6 +208,7 @@ type
|
||||
FFieldDef: TDbfFieldDef;
|
||||
FDbfFile: TDbfFile;
|
||||
FFieldName: string;
|
||||
FExprWord: TExprWord;
|
||||
protected
|
||||
function GetFieldVal: Pointer; virtual; abstract;
|
||||
function GetFieldType: TExpressionType; virtual; abstract;
|
||||
@ -857,7 +858,7 @@ begin
|
||||
if Args[1][arg1len-1] = '*' then
|
||||
begin
|
||||
arg0len := StrLen(Args[0]);
|
||||
match := arg1len >= arg0len - 1;
|
||||
match := arg0len >= arg1len - 1;
|
||||
if match then
|
||||
match := AnsiStrLIComp(Args[0], Args[1], arg1len-1) = 0;
|
||||
end else begin
|
||||
@ -923,7 +924,7 @@ begin
|
||||
if Args[1][arg1len-1] = '*' then
|
||||
begin
|
||||
arg0len := StrLen(Args[0]);
|
||||
match := arg1len >= arg0len - 1;
|
||||
match := arg0len >= arg1len - 1;
|
||||
if match then
|
||||
match := AnsiStrLComp(Args[0], Args[1], arg1len-1) = 0;
|
||||
end else begin
|
||||
@ -1355,8 +1356,6 @@ begin
|
||||
// clear and regenerate functions
|
||||
FCaseInsensitive := NewInsensitive;
|
||||
FillExpressList;
|
||||
if Length(Expression) > 0 then
|
||||
ParseExpression(Expression);
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -1367,8 +1366,6 @@ begin
|
||||
// refill function list
|
||||
FPartialMatch := NewPartialMatch;
|
||||
FillExpressList;
|
||||
if Length(Expression) > 0 then
|
||||
ParseExpression(Expression);
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -1384,7 +1381,11 @@ begin
|
||||
end;
|
||||
|
||||
procedure TDbfParser.FillExpressList;
|
||||
var
|
||||
lExpression: string;
|
||||
begin
|
||||
lExpression := FCurrentExpression;
|
||||
ClearExpressions;
|
||||
FWordsList.FreeAll;
|
||||
FWordsList.AddList(DbfWordsGeneralList, 0, DbfWordsGeneralList.Count - 1);
|
||||
if FCaseInsensitive then
|
||||
@ -1405,6 +1406,8 @@ begin
|
||||
FWordsList.AddList(DbfWordsSensNoPartialList, 0, DbfWordsSensNoPartialList.Count - 1);
|
||||
end;
|
||||
end;
|
||||
if Length(lExpression) > 0 then
|
||||
ParseExpression(lExpression);
|
||||
end;
|
||||
|
||||
function TDbfParser.GetVariableInfo(VarName: string): TDbfFieldDef;
|
||||
@ -1430,46 +1433,39 @@ begin
|
||||
begin
|
||||
{ raw string fields have fixed length, not null-terminated }
|
||||
TempFieldVar := TRawStringFieldVar.Create(FieldInfo, TDbfFile(FDbfFile));
|
||||
DefineStringVariableFixedLen(VarName, TempFieldVar.FieldVal, FieldInfo.Size);
|
||||
TempFieldVar.FExprWord := DefineStringVariableFixedLen(VarName, TempFieldVar.FieldVal, FieldInfo.Size);
|
||||
end else begin
|
||||
{ ansi string field function translates and null-terminates field value }
|
||||
TempFieldVar := TAnsiStringFieldVar.Create(FieldInfo, TDbfFile(FDbfFile));
|
||||
DefineStringVariable(VarName, TempFieldVar.FieldVal);
|
||||
TempFieldVar.FExprWord := DefineStringVariable(VarName, TempFieldVar.FieldVal);
|
||||
end;
|
||||
end;
|
||||
ftBoolean:
|
||||
begin
|
||||
TempFieldVar := TBooleanFieldVar.Create(FieldInfo, TDbfFile(FDbfFile));
|
||||
DefineBooleanVariable(VarName, TempFieldVar.FieldVal);
|
||||
TempFieldVar.FExprWord := DefineBooleanVariable(VarName, TempFieldVar.FieldVal);
|
||||
end;
|
||||
ftFloat:
|
||||
begin
|
||||
TempFieldVar := TFloatFieldVar.Create(FieldInfo, TDbfFile(FDbfFile));
|
||||
DefineFloatVariable(VarName, TempFieldVar.FieldVal);
|
||||
TempFieldVar.FExprWord := DefineFloatVariable(VarName, TempFieldVar.FieldVal);
|
||||
end;
|
||||
ftAutoInc, ftInteger, ftSmallInt:
|
||||
begin
|
||||
TempFieldVar := TIntegerFieldVar.Create(FieldInfo, TDbfFile(FDbfFile));
|
||||
DefineIntegerVariable(VarName, TempFieldVar.FieldVal);
|
||||
TempFieldVar.FExprWord := DefineIntegerVariable(VarName, TempFieldVar.FieldVal);
|
||||
end;
|
||||
{
|
||||
ftSmallInt:
|
||||
begin
|
||||
TempFieldVar := TSmallIntFieldVar.Create(FieldInfo, TDbfFile(FDbfFile));
|
||||
DefineSmallIntVariable(VarName, TempFieldVar.FieldVal);
|
||||
end;
|
||||
}
|
||||
{$ifdef SUPPORT_INT64}
|
||||
ftLargeInt:
|
||||
begin
|
||||
TempFieldVar := TLargeIntFieldVar.Create(FieldInfo, TDbfFile(FDbfFile));
|
||||
DefineLargeIntVariable(VarName, TempFieldVar.FieldVal);
|
||||
TempFieldVar.FExprWord := DefineLargeIntVariable(VarName, TempFieldVar.FieldVal);
|
||||
end;
|
||||
{$endif}
|
||||
ftDate, ftDateTime:
|
||||
begin
|
||||
TempFieldVar := TDateTimeFieldVar.Create(FieldInfo, TDbfFile(FDbfFile));
|
||||
DefineDateTimeVariable(VarName, TempFieldVar.FieldVal);
|
||||
TempFieldVar.FExprWord := DefineDateTimeVariable(VarName, TempFieldVar.FieldVal);
|
||||
end;
|
||||
else
|
||||
raise EDbfError.CreateFmt(STRING_INDEX_BASED_ON_INVALID_FIELD, [VarName]);
|
||||
@ -1497,7 +1493,7 @@ begin
|
||||
for I := 0 to FFieldVarList.Count - 1 do
|
||||
begin
|
||||
// replacing with nil = undefining variable
|
||||
ReplaceFunction(TFieldVar(FFieldVarList.Objects[I]).FieldName, nil);
|
||||
FWordsList.DoFree(TFieldVar(FFieldVarList.Objects[I]).FExprWord);
|
||||
TFieldVar(FFieldVarList.Objects[I]).Free;
|
||||
end;
|
||||
FFieldVarList.Clear;
|
||||
@ -1509,7 +1505,7 @@ end;
|
||||
|
||||
procedure TDbfParser.ParseExpression(AExpression: string);
|
||||
var
|
||||
TempBuffer: array[0..4000] of Char;
|
||||
TempBuffer: pchar;
|
||||
begin
|
||||
// clear any current expression
|
||||
ClearExpressions;
|
||||
@ -1525,8 +1521,13 @@ begin
|
||||
if ResultType = etString then
|
||||
begin
|
||||
// make empty record
|
||||
TDbfFile(FDbfFile).InitRecord(@TempBuffer[0]);
|
||||
FResultLen := StrLen(ExtractFromBuffer(@TempBuffer[0]));
|
||||
GetMem(TempBuffer, TDbfFile(FDbfFile).RecordSize);
|
||||
try
|
||||
TDbfFile(FDbfFile).InitRecord(TempBuffer);
|
||||
FResultLen := StrLen(ExtractFromBuffer(TempBuffer));
|
||||
finally
|
||||
FreeMem(TempBuffer);
|
||||
end;
|
||||
end;
|
||||
end else begin
|
||||
// simple field, create field variable for it
|
||||
|
||||
@ -58,7 +58,6 @@ type
|
||||
|
||||
procedure CompileExpression(AnExpression: string);
|
||||
procedure EvaluateCurrent;
|
||||
procedure ReplaceExprWord(OldExprWord, NewExprWord: TExprWord); virtual;
|
||||
procedure DisposeList(ARec: PExpressionRec);
|
||||
procedure DisposeTree(ExprRec: PExpressionRec);
|
||||
function CurrentExpression: string; virtual; abstract;
|
||||
@ -73,20 +72,18 @@ type
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
|
||||
procedure AddReplaceExprWord(AExprWord: TExprWord);
|
||||
procedure DefineFloatVariable(AVarName: string; AValue: PDouble);
|
||||
procedure DefineIntegerVariable(AVarName: string; AValue: PInteger);
|
||||
function DefineFloatVariable(AVarName: string; AValue: PDouble): TExprWord;
|
||||
function DefineIntegerVariable(AVarName: string; AValue: PInteger): TExprWord;
|
||||
// procedure DefineSmallIntVariable(AVarName: string; AValue: PSmallInt);
|
||||
{$ifdef SUPPORT_INT64}
|
||||
procedure DefineLargeIntVariable(AVarName: string; AValue: PLargeInt);
|
||||
function DefineLargeIntVariable(AVarName: string; AValue: PLargeInt): TExprWord;
|
||||
{$endif}
|
||||
procedure DefineDateTimeVariable(AVarName: string; AValue: PDateTimeRec);
|
||||
procedure DefineBooleanVariable(AVarName: string; AValue: PBoolean);
|
||||
procedure DefineStringVariable(AVarName: string; AValue: PPChar);
|
||||
procedure DefineStringVariableFixedLen(AVarName: string; AValue: PPChar; ALength: Integer);
|
||||
procedure DefineFunction(AFunctName, AShortName, ADescription, ATypeSpec: string;
|
||||
AMinFunctionArg: Integer; AResultType: TExpressionType; AFuncAddress: TExprFunc);
|
||||
procedure ReplaceFunction(OldName: string; AFunction: TObject);
|
||||
function DefineDateTimeVariable(AVarName: string; AValue: PDateTimeRec): TExprWord;
|
||||
function DefineBooleanVariable(AVarName: string; AValue: PBoolean): TExprWord;
|
||||
function DefineStringVariable(AVarName: string; AValue: PPChar): TExprWord;
|
||||
function DefineStringVariableFixedLen(AVarName: string; AValue: PPChar; ALength: Integer): TExprWord;
|
||||
function DefineFunction(AFunctName, AShortName, ADescription, ATypeSpec: string;
|
||||
AMinFunctionArg: Integer; AResultType: TExpressionType; AFuncAddress: TExprFunc): TExprWord;
|
||||
procedure Evaluate(AnExpression: string);
|
||||
function AddExpression(AnExpression: string): Integer;
|
||||
procedure ClearExpressions; virtual;
|
||||
@ -897,56 +894,56 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCustomExpressionParser.DefineFunction(AFunctName, AShortName, ADescription, ATypeSpec: string;
|
||||
AMinFunctionArg: Integer; AResultType: TExpressionType; AFuncAddress: TExprFunc);
|
||||
function TCustomExpressionParser.DefineFunction(AFunctName, AShortName, ADescription, ATypeSpec: string;
|
||||
AMinFunctionArg: Integer; AResultType: TExpressionType; AFuncAddress: TExprFunc): TExprWord;
|
||||
begin
|
||||
AddReplaceExprWord(TFunction.Create(AFunctName, AShortName, ATypeSpec, AMinFunctionArg, AResultType, AFuncAddress, ADescription));
|
||||
Result := TFunction.Create(AFunctName, AShortName, ATypeSpec, AMinFunctionArg, AResultType, AFuncAddress, ADescription);
|
||||
FWordsList.Add(Result);
|
||||
end;
|
||||
|
||||
procedure TCustomExpressionParser.DefineIntegerVariable(AVarName: string; AValue: PInteger);
|
||||
function TCustomExpressionParser.DefineIntegerVariable(AVarName: string; AValue: PInteger): TExprWord;
|
||||
begin
|
||||
AddReplaceExprWord(TIntegerVariable.Create(AVarName, AValue));
|
||||
Result := TIntegerVariable.Create(AVarName, AValue);
|
||||
FWordsList.Add(Result);
|
||||
end;
|
||||
|
||||
{
|
||||
procedure TCustomExpressionParser.DefineSmallIntVariable(AVarName: string; AValue: PSmallInt);
|
||||
begin
|
||||
AddReplaceExprWord(TSmallIntVariable.Create(AVarName, AValue));
|
||||
end;
|
||||
}
|
||||
|
||||
{$ifdef SUPPORT_INT64}
|
||||
|
||||
procedure TCustomExpressionParser.DefineLargeIntVariable(AVarName: string; AValue: PLargeInt);
|
||||
function TCustomExpressionParser.DefineLargeIntVariable(AVarName: string; AValue: PLargeInt): TExprWord;
|
||||
begin
|
||||
AddReplaceExprWord(TLargeIntVariable.Create(AVarName, AValue));
|
||||
Result := TLargeIntVariable.Create(AVarName, AValue);
|
||||
FWordsList.Add(Result);
|
||||
end;
|
||||
|
||||
{$endif}
|
||||
|
||||
procedure TCustomExpressionParser.DefineDateTimeVariable(AVarName: string; AValue: PDateTimeRec);
|
||||
function TCustomExpressionParser.DefineDateTimeVariable(AVarName: string; AValue: PDateTimeRec): TExprWord;
|
||||
begin
|
||||
AddReplaceExprWord(TDateTimeVariable.Create(AVarName, AValue));
|
||||
Result := TDateTimeVariable.Create(AVarName, AValue);
|
||||
FWordsList.Add(Result);
|
||||
end;
|
||||
|
||||
procedure TCustomExpressionParser.DefineBooleanVariable(AVarName: string; AValue: PBoolean);
|
||||
function TCustomExpressionParser.DefineBooleanVariable(AVarName: string; AValue: PBoolean): TExprWord;
|
||||
begin
|
||||
AddReplaceExprWord(TBooleanVariable.Create(AVarName, AValue));
|
||||
Result := TBooleanVariable.Create(AVarName, AValue);
|
||||
FWordsList.Add(Result);
|
||||
end;
|
||||
|
||||
procedure TCustomExpressionParser.DefineFloatVariable(AVarName: string; AValue: PDouble);
|
||||
function TCustomExpressionParser.DefineFloatVariable(AVarName: string; AValue: PDouble): TExprWord;
|
||||
begin
|
||||
AddReplaceExprWord(TFloatVariable.Create(AVarName, AValue));
|
||||
Result := TFloatVariable.Create(AVarName, AValue);
|
||||
FWordsList.Add(Result);
|
||||
end;
|
||||
|
||||
procedure TCustomExpressionParser.DefineStringVariable(AVarName: string; AValue: PPChar);
|
||||
function TCustomExpressionParser.DefineStringVariable(AVarName: string; AValue: PPChar): TExprWord;
|
||||
begin
|
||||
DefineStringVariableFixedLen(AVarName, AValue, -1);
|
||||
Result := DefineStringVariableFixedLen(AVarName, AValue, -1);
|
||||
end;
|
||||
|
||||
procedure TCustomExpressionParser.DefineStringVariableFixedLen(AVarName: string; AValue: PPChar; ALength: Integer);
|
||||
function TCustomExpressionParser.DefineStringVariableFixedLen(AVarName: string; AValue: PPChar; ALength: Integer): TExprWord;
|
||||
begin
|
||||
AddReplaceExprWord(TStringVariable.Create(AVarName, AValue, ALength));
|
||||
Result := TStringVariable.Create(AVarName, AValue, ALength);
|
||||
FWordsList.Add(Result);
|
||||
end;
|
||||
|
||||
{
|
||||
@ -977,32 +974,6 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCustomExpressionParser.ReplaceExprWord(OldExprWord, NewExprWord: TExprWord);
|
||||
var
|
||||
J: Integer;
|
||||
Rec: PExpressionRec;
|
||||
p, pnew: pointer;
|
||||
begin
|
||||
if OldExprWord.MaxFunctionArg <> NewExprWord.MaxFunctionArg then
|
||||
raise Exception.Create('Cannot replace variable/function MaxFunctionArg doesn''t match');
|
||||
|
||||
p := OldExprWord.AsPointer;
|
||||
pnew := NewExprWord.AsPointer;
|
||||
Rec := FCurrentRec;
|
||||
repeat
|
||||
if (Rec^.ExprWord = OldExprWord) then
|
||||
begin
|
||||
Rec^.ExprWord := NewExprWord;
|
||||
Rec^.Oper := NewExprWord.ExprFunc;
|
||||
end;
|
||||
if p <> nil then
|
||||
for J := 0 to Rec^.ExprWord.MaxFunctionArg - 1 do
|
||||
if Rec^.Args[J] = p then
|
||||
Rec^.Args[J] := pnew;
|
||||
Rec := Rec^.Next;
|
||||
until Rec = nil;
|
||||
end;
|
||||
|
||||
function TCustomExpressionParser.MakeRec: PExpressionRec;
|
||||
var
|
||||
I: Integer;
|
||||
@ -1044,26 +1015,6 @@ begin
|
||||
//CurrentIndex := Result;
|
||||
end;
|
||||
|
||||
procedure TCustomExpressionParser.ReplaceFunction(OldName: string; AFunction:
|
||||
TObject);
|
||||
var
|
||||
I: Integer;
|
||||
begin
|
||||
// clearing only allowed when expression is not present
|
||||
if (AFunction = nil) and (FCurrentRec <> nil) then
|
||||
raise Exception.Create('Cannot undefine function/variable while expression present');
|
||||
|
||||
if FWordsList.Search(PChar(OldName), I) then
|
||||
begin
|
||||
// if no function specified, then no need to replace!
|
||||
if AFunction <> nil then
|
||||
ReplaceExprWord(TExprWord(FWordsList.Items[I]), TExprWord(AFunction));
|
||||
FWordsList.AtFree(I);
|
||||
end;
|
||||
if AFunction <> nil then
|
||||
FWordsList.Add(AFunction);
|
||||
end;
|
||||
|
||||
procedure TCustomExpressionParser.ClearExpressions;
|
||||
begin
|
||||
DisposeList(FCurrentRec);
|
||||
@ -1071,20 +1022,6 @@ begin
|
||||
FLastRec := nil;
|
||||
end;
|
||||
|
||||
procedure TCustomExpressionParser.AddReplaceExprWord(AExprWord: TExprWord);
|
||||
var
|
||||
IOldVar: Integer;
|
||||
begin
|
||||
if FWordsList.Search(PChar(AExprWord.Name), IOldVar) then
|
||||
begin
|
||||
ReplaceExprWord(TExprWord(FWordsList.Items[IOldVar]), AExprWord);
|
||||
FWordsList.AtFree(IOldVar);
|
||||
FWordsList.Add(AExprWord);
|
||||
end
|
||||
else
|
||||
FWordsList.Add(AExprWord);
|
||||
end;
|
||||
|
||||
function TCustomExpressionParser.GetFunctionDescription(AFunction: string):
|
||||
string;
|
||||
var
|
||||
|
||||
@ -36,6 +36,19 @@ BUGS & WARNINGS
|
||||
V6.4.8
|
||||
|
||||
- remove duplicate names, may cause ambiguity
|
||||
- allow duplicate names in function list for expressions
|
||||
- remember exprword reference for every field variable so we can remove it
|
||||
- prevent possible buffer overrun when parsing expression (thx leexgone)
|
||||
- fix some memory references in the parser
|
||||
- add ability for locate/lookup to use alternate index than current one
|
||||
- fix tdbf.copyfrom fieldname copy and fieldno index for size/precision
|
||||
- make TDbf.CheckMasterRange public so master/detail can be synced manually
|
||||
when for example .DisableControls is active
|
||||
- allow calc/lookup fields to work in filters
|
||||
- fix loosing blobs when packing table (rep by cllerici)
|
||||
- support variants for freepascal
|
||||
- fix (filter) parser string partial matching for "A*" strings
|
||||
- make distinct index creation more robust
|
||||
|
||||
|
||||
------------------------
|
||||
|
||||
Loading…
Reference in New Issue
Block a user