From b3ef974403409cbb1b391c25a55deb30b76ccd5f Mon Sep 17 00:00:00 2001 From: micha Date: Sun, 17 Dec 2006 14:55:56 +0000 Subject: [PATCH] * update tdbf to tdbf svn git-svn-id: trunk@5622 - --- fcl/db/dbase/dbf.pas | 145 ++++++++------ fcl/db/dbase/dbf_common.inc | 7 +- fcl/db/dbase/dbf_common.pas | 72 ++----- fcl/db/dbase/dbf_dbffile.pas | 117 +++++++----- fcl/db/dbase/dbf_fields.pas | 20 +- fcl/db/dbase/dbf_idxcur.pas | 8 +- fcl/db/dbase/dbf_idxfile.pas | 214 +++++++-------------- fcl/db/dbase/dbf_lang.pas | 2 +- fcl/db/dbase/dbf_memo.pas | 2 +- fcl/db/dbase/dbf_parser.pas | 356 +++++++++-------------------------- fcl/db/dbase/dbf_pgfile.pas | 4 +- fcl/db/dbase/dbf_prscore.pas | 217 ++++++++++++++------- fcl/db/dbase/dbf_prsdef.pas | 47 +++-- fcl/db/dbase/dbf_prssupp.pas | 131 ++++++++----- fcl/db/dbase/dbf_wtil.pas | 4 +- fcl/db/dbase/history.txt | 22 ++- 16 files changed, 636 insertions(+), 732 deletions(-) diff --git a/fcl/db/dbase/dbf.pas b/fcl/db/dbase/dbf.pas index 44363f5db8..e2fe6ced81 100644 --- a/fcl/db/dbase/dbf.pas +++ b/fcl/db/dbase/dbf.pas @@ -117,6 +117,7 @@ type FParser: TDbfParser; FFieldNames: string; FValidExpression: Boolean; + FKeyTranslation: boolean; FOnMasterChange: TNotifyEvent; FOnMasterDisable: TNotifyEvent; @@ -134,6 +135,7 @@ type destructor Destroy; override; property FieldNames: string read FFieldNames write SetFieldNames; + property KeyTranslation: boolean read FKeyTranslation; property ValidExpression: Boolean read FValidExpression write FValidExpression; property FieldsVal: PChar read GetFieldsVal; property Parser: TDbfParser read FParser; @@ -256,7 +258,7 @@ type function IsCursorOpen: Boolean; override; {virtual abstract} procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override; {virtual abstract} procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override; {virtual abstract} - procedure SetFieldData(Field: TField; Buffer: Pointer); override; {virtual abstract} + procedure SetFieldData(Field: TField; Buffer: Pointer); overload; override; {virtual abstract} { virtual methods (mostly optionnal) } function GetDataSource: TDataSource; {$ifndef VER1_0}override;{$endif} @@ -286,7 +288,7 @@ type destructor Destroy; override; { abstract methods } - function GetFieldData(Field: TField; Buffer: Pointer): Boolean; override; {virtual abstract} + function GetFieldData(Field: TField; Buffer: Pointer): Boolean; overload; override; {virtual abstract} { virtual methods (mostly optionnal) } procedure Resync(Mode: TResyncMode); override; function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; override; {virtual} @@ -296,10 +298,10 @@ type procedure Translate(Src, Dest: PChar; ToOem: Boolean); override; {virtual} {$endif} -{$ifdef SUPPORT_BACKWARD_FIELDDATA} - function GetFieldData(Field: TField; Buffer: Pointer; NativeFormat: Boolean): Boolean; overload; override; - procedure SetFieldData(Field: TField; Buffer: Pointer; NativeFormat: Boolean); overload; override; -{$endif} + function GetFieldData(Field: TField; Buffer: Pointer; NativeFormat: Boolean): Boolean; overload; + {$ifdef SUPPORT_BACKWARD_FIELDDATA} override; {$endif} + procedure SetFieldData(Field: TField; Buffer: Pointer; NativeFormat: Boolean); overload; + {$ifdef SUPPORT_BACKWARD_FIELDDATA} override; {$endif} function CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Integer; override; procedure CheckDbfFieldDefs(ADbfFieldDefs: TDbfFieldDefs); @@ -323,12 +325,16 @@ type procedure CancelRange; procedure CheckMasterRange; {$ifdef SUPPORT_VARIANTS} - function SearchKey(Key: Variant; SearchType: TSearchKeyType): Boolean; - procedure SetRange(LowRange: Variant; HighRange: Variant); + function SearchKey(Key: Variant; SearchType: TSearchKeyType; KeyIsANSI: boolean + {$ifdef SUPPORT_DEFAULT_PARAMS}= false{$endif}): Boolean; + procedure SetRange(LowRange: Variant; HighRange: Variant; KeyIsANSI: boolean + {$ifdef SUPPORT_DEFAULT_PARAMS}= false{$endif}); {$endif} function PrepareKey(Buffer: Pointer; BufferType: TExpressionType): PChar; - function SearchKeyPChar(Key: PChar; SearchType: TSearchKeyType): Boolean; - procedure SetRangePChar(LowRange: PChar; HighRange: PChar); + function SearchKeyPChar(Key: PChar; SearchType: TSearchKeyType; KeyIsANSI: boolean + {$ifdef SUPPORT_DEFAULT_PARAMS}= false{$endif}): Boolean; + procedure SetRangePChar(LowRange: PChar; HighRange: PChar; KeyIsANSI: boolean + {$ifdef SUPPORT_DEFAULT_PARAMS}= false{$endif}); function GetCurrentBuffer: PChar; procedure ExtractKey(KeyBuffer: PChar); procedure UpdateIndexDefs; override; @@ -353,7 +359,7 @@ type {$ifdef SUPPORT_VARIANTS} function Lookup(const KeyFields: string; const KeyValues: Variant; const ResultFields: string): Variant; override; - function Locate(const KeyFields: string; const KeyValues: Variant; Options: TLocateOptions): Boolean; {$ifndef FPC}override;{$endif} + function Locate(const KeyFields: string; const KeyValues: Variant; Options: TLocateOptions): Boolean; override; {$endif} function IsDeleted: Boolean; @@ -453,7 +459,7 @@ uses {$ifndef FPC} DBConsts, {$endif} -{$ifdef WIN32} +{$ifdef WINDOWS} Windows, {$else} {$ifdef KYLIX} @@ -551,7 +557,7 @@ begin Translate(true); Dbf.FDbfFile.MemoFile.WriteMemo(FMemoRecNo, FReadSize, Self); Dbf.FDbfFile.SetFieldData(FBlobField.FieldNo-1, ftInteger, @FMemoRecNo, - @pDbfRecord(TDbf(FBlobField.DataSet).ActiveBuffer)^.DeletedFlag); + @pDbfRecord(TDbf(FBlobField.DataSet).ActiveBuffer)^.DeletedFlag, false); FDirty := false; end; end; @@ -693,6 +699,18 @@ begin end; function TDbf.GetFieldData(Field: TField; Buffer: Pointer): Boolean; {override virtual abstract from TDataset} +begin + Result := GetFieldData(Field, Buffer, true); +end; + +// we don't want converted data formats, we want native :-) +// it makes coding easier in TDbfFile.GetFieldData +// ftCurrency: +// Delphi 3,4: BCD array +// ftBCD: +// ftDateTime is more difficult though + +function TDbf.GetFieldData(Field: TField; Buffer: Pointer; NativeFormat: Boolean): Boolean; {overload; override;} var Src: PChar; begin @@ -705,7 +723,7 @@ begin if Field.FieldNo>0 then begin - Result := FDbfFile.GetFieldData(Field.FieldNo-1, Field.DataType, Src, Buffer); + Result := FDbfFile.GetFieldData(Field.FieldNo-1, Field.DataType, Src, Buffer, NativeFormat); end else begin { weird calculated fields voodoo (from dbtables).... } Inc(PChar(Src), Field.Offset + GetRecordSize); Result := Boolean(Src[0]); @@ -714,29 +732,26 @@ begin end; end; -{$ifdef SUPPORT_BACKWARD_FIELDDATA} - -// we don't want converted data formats, we want native :-) -// it makes coding easier in TDbfFile.GetFieldData -// ftCurrency: -// Delphi 3,4: BCD array -// ftBCD: -// ftDateTime is more difficult though - -function TDbf.GetFieldData(Field: TField; Buffer: Pointer; NativeFormat: Boolean): Boolean; {overload; override;} -begin - // pretend nativeformat is true - Result := inherited GetFieldData(Field, Buffer, True); -end; - procedure TDbf.SetFieldData(Field: TField; Buffer: Pointer; NativeFormat: Boolean); {overload; override;} +var + Dst: PChar; begin - // pretend nativeformat is true - inherited SetFieldData(Field, Buffer, True); + if (Field.FieldNo >= 0) then + begin + Dst := @PDbfRecord(ActiveBuffer)^.DeletedFlag; + FDbfFile.SetFieldData(Field.FieldNo - 1, Field.DataType, Buffer, Dst, NativeFormat); + end else begin { ***** fkCalculated, fkLookup ***** } + Dst := @PDbfRecord(CalcBuffer)^.DeletedFlag; + Inc(PChar(Dst), RecordSize + Field.Offset); + Boolean(Dst[0]) := Buffer <> nil; + if Buffer <> nil then + Move(Buffer^, Dst[1], Field.DataSize) + end; { end of ***** fkCalculated, fkLookup ***** } + if not (State in [dsCalcFields, dsFilter, dsNewValue]) then begin + DataEvent(deFieldChange, PtrInt(Field)); + end; end; -{$endif} - procedure TDbf.DoFilterRecord(var Acceptable: Boolean); begin // check filtertext @@ -1792,7 +1807,8 @@ begin searchFlag := stGreaterEqual else searchFlag := stEqual; - TIndexCursor(FCursor).VariantToBuffer(KeyValues, @lTempBuffer[0]); + if TIndexCursor(FCursor).VariantToBuffer(KeyValues, @lTempBuffer[0]) = etString then + Translate(@lTempBuffer[0], @lTempBuffer[0], true); Result := FIndexFile.SearchKey(@lTempBuffer[0], searchFlag); if Result then begin @@ -1918,7 +1934,7 @@ begin FBlobStreams^[MemoFieldNo] := TDbfBlobStream.Create(Field); lBlob := FBlobStreams^[MemoFieldNo].AddReference; // update pageno of blob <-> location where to read/write in memofile - if FDbfFile.GetFieldData(Field.FieldNo-1, ftInteger, GetCurrentBuffer, @MemoPageNo) then + if FDbfFile.GetFieldData(Field.FieldNo-1, ftInteger, GetCurrentBuffer, @MemoPageNo, false) then begin // read blob? different blob? if (Mode = bmRead) or (Mode = bmReadWrite) then @@ -2061,23 +2077,8 @@ begin end; procedure TDbf.SetFieldData(Field: TField; Buffer: Pointer); {override virtual abstract from TDataset} -var - Dst: PChar; begin - if (Field.FieldNo >= 0) then - begin - Dst := @PDbfRecord(ActiveBuffer)^.DeletedFlag; - FDbfFile.SetFieldData(Field.FieldNo - 1,Field.DataType,Buffer,Dst); - end else begin { ***** fkCalculated, fkLookup ***** } - Dst := @PDbfRecord(CalcBuffer)^.DeletedFlag; - Inc(PChar(Dst), RecordSize + Field.Offset); - Boolean(Dst[0]) := Buffer <> nil; - if Buffer <> nil then - Move(Buffer^, Dst[1], Field.DataSize) - end; { end of ***** fkCalculated, fkLookup ***** } - if not (State in [dsCalcFields, dsFilter, dsNewValue]) then begin - DataEvent(deFieldChange, PtrInt(Field)); - end; + SetFieldData(Field, Buffer, true); end; // this function counts real number of records: skip deleted records, filter, etc. @@ -2181,7 +2182,7 @@ begin if (FParser = nil) and (FDbfFile <> nil) then begin FParser := TDbfParser.Create(FDbfFile); - // we need translated (to ANSI) strings + // we need truncated, translated (to ANSI) strings FParser.RawStringFields := false; end; // have a parser now? @@ -2616,7 +2617,7 @@ end; {$ifdef SUPPORT_VARIANTS} -procedure TDbf.SetRange(LowRange: Variant; HighRange: Variant); +procedure TDbf.SetRange(LowRange: Variant; HighRange: Variant; KeyIsANSI: boolean); var LowBuf, HighBuf: array[0..100] of Char; begin @@ -2624,14 +2625,16 @@ begin exit; // convert variants to index key type - TIndexCursor(FCursor).VariantToBuffer(LowRange, @LowBuf[0]); - TIndexCursor(FCursor).VariantToBuffer(HighRange, @HighBuf[0]); + if (TIndexCursor(FCursor).VariantToBuffer(LowRange, @LowBuf[0]) = etString) and KeyIsANSI then + Translate(@LowBuf[0], @LowBuf[0], true); + if (TIndexCursor(FCursor).VariantToBuffer(HighRange, @HighBuf[0]) = etString) and KeyIsANSI then + Translate(@HighBuf[0], @HighBuf[0], true); SetRangeBuffer(@LowBuf[0], @HighBuf[0]); end; {$endif} -procedure TDbf.SetRangePChar(LowRange: PChar; HighRange: PChar); +procedure TDbf.SetRangePChar(LowRange: PChar; HighRange: PChar; KeyIsANSI: boolean); var LowBuf, HighBuf: array [0..100] of Char; LowPtr, HighPtr: PChar; @@ -2640,6 +2643,13 @@ begin exit; // convert to pchars + if KeyIsANSI then + begin + Translate(LowRange, @LowBuf[0], true); + Translate(HighRange, @HighBuf[0], true); + LowRange := @LowBuf[0]; + HighRange := @HighBuf[0]; + end; LowPtr := TIndexCursor(FCursor).CheckUserKey(LowRange, @LowBuf[0]); HighPtr := TIndexCursor(FCursor).CheckUserKey(HighRange, @HighBuf[0]); SetRangeBuffer(LowPtr, HighPtr); @@ -2663,7 +2673,7 @@ end; {$ifdef SUPPORT_VARIANTS} -function TDbf.SearchKey(Key: Variant; SearchType: TSearchKeyType): Boolean; +function TDbf.SearchKey(Key: Variant; SearchType: TSearchKeyType; KeyIsANSI: boolean): Boolean; var TempBuffer: array [0..100] of Char; begin @@ -2674,7 +2684,8 @@ begin end; // FIndexFile <> nil -> FCursor as TIndexCursor <> nil - TIndexCursor(FCursor).VariantToBuffer(Key, @TempBuffer[0]); + if (TIndexCursor(FCursor).VariantToBuffer(Key, @TempBuffer[0]) = etString) and KeyIsANSI then + Translate(@TempBuffer[0], @TempBuffer[0], true); Result := SearchKeyBuffer(@TempBuffer[0], SearchType); end; @@ -2691,7 +2702,7 @@ begin Result := TIndexCursor(FCursor).IndexFile.PrepareKey(Buffer, BufferType); end; -function TDbf.SearchKeyPChar(Key: PChar; SearchType: TSearchKeyType): Boolean; +function TDbf.SearchKeyPChar(Key: PChar; SearchType: TSearchKeyType; KeyIsANSI: boolean): Boolean; var StringBuf: array [0..100] of Char; begin @@ -2701,6 +2712,11 @@ begin exit; end; + if KeyIsANSI then + begin + Translate(Key, @StringBuf[0], true); + Key := @StringBuf[0]; + end; Result := SearchKeyBuffer(TIndexCursor(FCursor).CheckUserKey(Key, @StringBuf[0]), SearchType); end; @@ -2759,8 +2775,15 @@ end; procedure TDbf.UpdateRange; var fieldsVal: PChar; + tempBuffer: array[0..300] of char; begin fieldsVal := FMasterLink.FieldsVal; + if FMasterLink.KeyTranslation then + begin + FMasterLink.DataSet.Translate(fieldsVal, @tempBuffer[0], false); + fieldsVal := @tempBuffer[0]; + Translate(fieldsVal, fieldsVal, true); + end; fieldsVal := TIndexCursor(FCursor).IndexFile.PrepareKey(fieldsVal, FMasterLink.Parser.ResultType); SetRangeBuffer(fieldsVal, fieldsVal); end; @@ -2905,8 +2928,10 @@ begin if Active and (FFieldNames <> EmptyStr) then begin FValidExpression := false; - FParser.DbfFile := TDbf(DataSet).DbfFile; + FParser.DbfFile := (DataSet as TDbf).DbfFile; FParser.ParseExpression(FFieldNames); + FKeyTranslation := TDbfFile(FParser.DbfFile).UseCodePage <> + FDetailDataSet.DbfFile.UseCodePage; FValidExpression := true; end else begin FParser.ClearExpressions; diff --git a/fcl/db/dbase/dbf_common.inc b/fcl/db/dbase/dbf_common.inc index 9db39c08c9..704917cea9 100644 --- a/fcl/db/dbase/dbf_common.inc +++ b/fcl/db/dbase/dbf_common.inc @@ -163,6 +163,7 @@ {$ifdef DELPHI_3} {$define SUPPORT_VARIANTS} + {$define WINDOWS} {$ifdef DELPHI_4} @@ -182,7 +183,6 @@ {$ifdef DELPHI_5} {$define SUPPORT_BACKWARD_FIELDDATA} - {$define SUPPORT_NEW_FIELDDATA} {$define SUPPORT_INITDEFSFROMFIELDS} {$define SUPPORT_DEF_DELETE} {$define SUPPORT_FREEANDNIL} @@ -217,7 +217,6 @@ {$define SUPPORT_INT64} {$define SUPPORT_DEFAULT_PARAMS} {$define SUPPORT_NEW_TRANSLATE} - {$define SUPPORT_NEW_FIELDDATA} {$define SUPPORT_FIELDDEF_TPERSISTENT} {$define SUPPORT_FIELDTYPES_V4} {$define SUPPORT_UINT32_CARDINAL} @@ -246,10 +245,10 @@ {$endif} //---------------------------------------------------------- -//--- Conclude supported features in non-Win32 platforms --- +//--- Conclude supported features in non-Windows platforms --- //---------------------------------------------------------- -{$ifndef WIN32} +{$ifndef WINDOWS} {$define SUPPORT_PATHDELIM} {$define SUPPORT_INCLUDETRAILPATHDELIM} diff --git a/fcl/db/dbase/dbf_common.pas b/fcl/db/dbase/dbf_common.pas index cc2381f665..744aa97b95 100644 --- a/fcl/db/dbase/dbf_common.pas +++ b/fcl/db/dbase/dbf_common.pas @@ -4,14 +4,16 @@ interface {$I dbf_common.inc} -{$ifndef FPC_LITTLE_ENDIAN} +{$ifdef FPC} + {$ifndef FPC_LITTLE_ENDIAN} {$message error TDbf is not compatible with non little-endian CPUs. Please contact the author.} + {$endif} {$endif} uses SysUtils, Classes, DB -{$ifndef WIN32} +{$ifndef WINDOWS} , Types, dbf_wtil {$ifdef KYLIX} , Libc @@ -22,8 +24,8 @@ uses const TDBF_MAJOR_VERSION = 6; - TDBF_MINOR_VERSION = 49; - TDBF_SUB_MINOR_VERSION = 0; + TDBF_MINOR_VERSION = 9; + TDBF_SUB_MINOR_VERSION = 1; TDBF_TABLELEVEL_FOXPRO = 25; @@ -51,11 +53,6 @@ type PCardinal = ^Cardinal; PDouble = ^Double; PString = ^String; - PDateTimeRec = ^TDateTimeRec; - -{$ifdef SUPPORT_INT64} - PLargeInt = ^Int64; -{$endif} {$ifdef DELPHI_3} dword = cardinal; @@ -73,7 +70,7 @@ procedure FreeMemAndNil(var P: Pointer); {$ifndef SUPPORT_PATHDELIM} const -{$ifdef WIN32} +{$ifdef WINDOWS} PathDelim = '\'; {$else} PathDelim = '/'; @@ -91,10 +88,6 @@ function GetCompleteFileName(const Base, FileName: string): string; function IsFullFilePath(const Path: string): Boolean; // full means not relative function DateTimeToBDETimeStamp(aDT: TDateTime): double; function BDETimeStampToDateTime(aBT: double): TDateTime; -{$ifdef SUPPORT_INT64} -function GetStrFromInt64(Val: Int64; const Dst: PChar): Integer; -procedure GetStrFromInt64_Width(Val: Int64; const Width: Integer; const Dst: PChar; const PadChar: Char); -{$endif} procedure FindNextName(BaseName: string; var OutName: string; var Modifier: Integer); {$ifdef USE_CACHE} function GetFreeMemory: Integer; @@ -122,7 +115,7 @@ function Max(x, y: integer): integer; implementation -{$ifdef WIN32} +{$ifdef WINDOWS} uses Windows; {$endif} @@ -148,7 +141,7 @@ end; function IsFullFilePath(const Path: string): Boolean; // full means not relative begin -{$ifdef WIN32} +{$ifdef WINDOWS} Result := Length(Path) > 1; if Result then // check for 'x:' or '\\' at start of path @@ -174,49 +167,6 @@ begin result := lpath; end; -{$ifdef SUPPORT_INT64} - -procedure GetStrFromInt64_Width(Val: Int64; const Width: Integer; const Dst: PChar; const PadChar: Char); -var - Temp: array[0..19] of Char; - I, J: Integer; - NegSign: boolean; -begin - {$I getstrfromint.inc} -end; - -{$endif} - -{$ifdef SUPPORT_INT64} - -function GetStrFromInt64(Val: Int64; const Dst: PChar): Integer; -var - Temp: array[0..19] of Char; - I, J: Integer; -begin - Val := Abs(Val); - // we'll have to store characters backwards first - I := 0; - J := 0; - repeat - Temp[I] := Chr((Val mod 10) + Ord('0')); - Val := Val div 10; - Inc(I); - until Val = 0; - - // remember number of digits - Result := I; - // copy value, remember: stored backwards - repeat - Dst[J] := Temp[I-1]; - inc(J); - dec(I); - until I = 0; - // done! -end; - -{$endif} - function DateTimeToBDETimeStamp(aDT: TDateTime): double; var aTS: TTimeStamp; @@ -229,7 +179,7 @@ function BDETimeStampToDateTime(aBT: double): TDateTime; var aTS: TTimeStamp; begin - aTS := MSecsToTimeStamp(aBT); + aTS := MSecsToTimeStamp(Round(aBT)); Result := TimeStampToDateTime(aTS); end; @@ -279,7 +229,7 @@ end; function IncludeTrailingPathDelimiter(const Path: string): string; begin -{$ifdef WIN32} +{$ifdef WINDOWS} Result := IncludeTrailingBackslash(Path); {$else} Result := IncludeTrailingSlash(Path); diff --git a/fcl/db/dbase/dbf_dbffile.pas b/fcl/db/dbase/dbf_dbffile.pas index 55650ab1b2..ba0fd18781 100644 --- a/fcl/db/dbase/dbf_dbffile.pas +++ b/fcl/db/dbase/dbf_dbffile.pas @@ -6,10 +6,7 @@ interface uses Classes, SysUtils, -{$ifdef SUPPORT_MATH_UNIT} - Math, -{$endif} -{$ifdef WIN32} +{$ifdef WINDOWS} Windows, {$else} {$ifdef KYLIX} @@ -107,9 +104,11 @@ type procedure RestructureTable(DbfFieldDefs: TDbfFieldDefs; Pack: Boolean); procedure Rename(DestFileName: string; NewIndexFileNames: TStrings; DeleteFiles: boolean); function GetFieldInfo(FieldName: string): TDbfFieldDef; - function GetFieldData(Column: Integer; DataType: TFieldType; Src,Dst: Pointer): Boolean; - function GetFieldDataFromDef(AFieldDef: TDbfFieldDef; DataType: TFieldType; Src, Dst: Pointer): Boolean; - procedure SetFieldData(Column: Integer; DataType: TFieldType; Src,Dst: Pointer); + function GetFieldData(Column: Integer; DataType: TFieldType; Src,Dst: Pointer; + NativeFormat: boolean): Boolean; + function GetFieldDataFromDef(AFieldDef: TDbfFieldDef; DataType: TFieldType; + Src, Dst: Pointer; NativeFormat: boolean): Boolean; + procedure SetFieldData(Column: Integer; DataType: TFieldType; Src,Dst: Pointer; NativeFormat: boolean); procedure InitRecord(DestBuf: PChar); procedure PackIndex(lIndexFile: TIndexFile; AIndexName: string); procedure RegenerateIndexes; @@ -190,14 +189,17 @@ var implementation uses -{$ifndef WIN32} +{$ifndef WINDOWS} {$ifndef FPC} RTLConsts, {$else} BaseUnix, {$endif} {$endif} - dbf_str, dbf_lang, dbf_prssupp; +{$ifdef SUPPORT_MATH_UNIT} + Math, +{$endif} + dbf_str, dbf_lang, dbf_prssupp, dbf_prsdef; const sDBF_DEC_SEP = '.'; @@ -1288,7 +1290,7 @@ begin if TempDstDef.IsBlob and ((DbfFieldDefs = nil) or (TempDstDef.CopyFrom >= 0)) then begin // get current blob blockno - GetFieldData(lFieldNo, ftInteger, pBuff, @lBlobPageNo); + GetFieldData(lFieldNo, ftInteger, pBuff, @lBlobPageNo, false); // valid blockno read? if lBlobPageNo > 0 then begin @@ -1299,7 +1301,7 @@ begin DestDbfFile.FMemoFile.WriteMemo(lBlobPageNo, 0, BlobStream); end; // write new blockno - DestDbfFile.SetFieldData(lFieldNo, ftInteger, @lBlobPageNo, pDestBuff); + DestDbfFile.SetFieldData(lFieldNo, ftInteger, @lBlobPageNo, pDestBuff, false); end else if (DbfFieldDefs <> nil) and (TempDstDef.CopyFrom >= 0) then begin // copy content of field @@ -1387,16 +1389,18 @@ begin end; // NOTE: Dst may be nil! -function TDbfFile.GetFieldData(Column: Integer; DataType: TFieldType; Src, Dst: Pointer): Boolean; +function TDbfFile.GetFieldData(Column: Integer; DataType: TFieldType; + Src, Dst: Pointer; NativeFormat: boolean): Boolean; var TempFieldDef: TDbfFieldDef; begin TempFieldDef := TDbfFieldDef(FFieldDefs.Items[Column]); - Result := GetFieldDataFromDef(TempFieldDef, DataType, Src, Dst); + Result := GetFieldDataFromDef(TempFieldDef, DataType, Src, Dst, NativeFormat); end; // NOTE: Dst may be nil! -function TDbfFile.GetFieldDataFromDef(AFieldDef: TDbfFieldDef; DataType: TFieldType; Src, Dst: Pointer): Boolean; +function TDbfFile.GetFieldDataFromDef(AFieldDef: TDbfFieldDef; DataType: TFieldType; + Src, Dst: Pointer; NativeFormat: boolean): Boolean; var FieldOffset, FieldSize: Integer; // s: string; @@ -1444,20 +1448,21 @@ var procedure SaveDateToDst; begin -{$ifdef SUPPORT_NEW_FIELDDATA} - // Delphi 5 requests a TDateTime - PDateTime(Dst)^ := date; -{$else} - // Delphi 3 and 4 request a TDateTimeRec - // date is TTimeStamp.date - // datetime = msecs == BDE timestamp as we implemented it - if DataType = ftDateTime then + if not NativeFormat then begin - PDateTimeRec(Dst)^.DateTime := date; + // Delphi 5 requests a TDateTime + PDateTime(Dst)^ := date; end else begin - PLongInt(Dst)^ := DateTimeToTimeStamp(date).Date; + // Delphi 3 and 4 request a TDateTimeRec + // date is TTimeStamp.date + // datetime = msecs == BDE timestamp as we implemented it + if DataType = ftDateTime then + begin + PDateTimeRec(Dst)^.DateTime := date; + end else begin + PLongInt(Dst)^ := DateTimeToTimeStamp(date).Date; + end; end; -{$endif} end; begin @@ -1562,9 +1567,13 @@ begin end; 'B': // foxpro double begin - Result := true; - if Dst <> nil then - PDouble(Dst)^ := PDouble(Src)^; + if FDbfVersion = xFoxPro then + begin + Result := true; + if Dst <> nil then + PDouble(Dst)^ := PDouble(Src)^; + end else + asciiContents := true; end; 'M': begin @@ -1683,7 +1692,8 @@ begin end; end; -procedure TDbfFile.SetFieldData(Column: Integer; DataType: TFieldType; Src, Dst: Pointer); +procedure TDbfFile.SetFieldData(Column: Integer; DataType: TFieldType; + Src, Dst: Pointer; NativeFormat: boolean); const IsBlobFieldToPadChar: array[Boolean] of Char = (#32, '0'); SrcNilToUpdateNullField: array[boolean] of TUpdateNullField = (unClear, unSet); @@ -1700,22 +1710,23 @@ var procedure LoadDateFromSrc; begin -{$ifdef SUPPORT_NEW_FIELDDATA} - // Delphi 5 passes a TDateTime - date := PDateTime(Src)^; -{$else} - // Delphi 3 and 4 pass a TDateTimeRec with a time stamp - // date = integer - // datetime = msecs == BDETimeStampToDateTime as we implemented it - if DataType = ftDateTime then + if not NativeFormat then begin - date := PDouble(Src)^; + // Delphi 5, new format, passes a TDateTime + date := PDateTime(Src)^; end else begin - timeStamp.Time := 0; - timeStamp.Date := PLongInt(Src)^; - date := TimeStampToDateTime(timeStamp); + // Delphi 3 and 4, old "native" format, pass a TDateTimeRec with a time stamp + // date = integer + // datetime = msecs == BDETimeStampToDateTime as we implemented it + if DataType = ftDateTime then + begin + date := PDouble(Src)^; + end else begin + timeStamp.Time := 0; + timeStamp.Date := PLongInt(Src)^; + date := TimeStampToDateTime(timeStamp); + end; end; -{$endif} end; begin @@ -1811,10 +1822,14 @@ begin end; 'B': begin - if Src = nil then - PDouble(Dst)^ := 0 - else - PDouble(Dst)^ := PDouble(Src)^; + if DbfVersion = xFoxPro then + begin + if Src = nil then + PDouble(Dst)^ := 0 + else + PDouble(Dst)^ := PDouble(Src)^; + end else + asciiContents := true; end; 'M': begin @@ -2025,6 +2040,7 @@ var lIndexFile: TIndexFile; lIndexFileName: string; createMdxFile: Boolean; + tempExclusive: boolean; addedIndexFile: Integer; addedIndexName: Integer; begin @@ -2110,7 +2126,8 @@ begin if CreateIndex then begin // try get exclusive mode - if IsSharedAccess then TryExclusive; + tempExclusive := IsSharedAccess; + if tempExclusive then TryExclusive; // always uppercase index expression IndexField := AnsiUpperCase(IndexField); try @@ -2153,7 +2170,7 @@ begin end; finally // return to previous mode - if TempMode <> pfNone then EndExclusive; + if tempExclusive then EndExclusive; end; end; end; @@ -2682,13 +2699,13 @@ end; procedure TDbfGlobals.InitUserName; {$ifdef FPC} -{$ifndef WIN32} +{$ifndef WINDOWS} var TempName: UTSName; {$endif} {$endif} begin -{$ifdef WIN32} +{$ifdef WINDOWS} FUserNameLen := MAX_COMPUTERNAME_LENGTH+1; SetLength(FUserName, FUserNameLen); Windows.GetComputerName(PChar(FUserName), diff --git a/fcl/db/dbase/dbf_fields.pas b/fcl/db/dbase/dbf_fields.pas index b991ad8674..2ed4b7752c 100644 --- a/fcl/db/dbase/dbf_fields.pas +++ b/fcl/db/dbase/dbf_fields.pas @@ -332,7 +332,9 @@ begin case FNativeFieldType of // OH 2000-11-15 dBase7 support. // Add the new fieldtypes - '+' : FFieldType := ftAutoInc; + '+' : + if DbfVersion = xBaseVII then + FFieldType := ftAutoInc; 'I' : FFieldType := ftInteger; 'O' : FFieldType := ftFloat; '@', 'T': @@ -501,11 +503,21 @@ begin FSize := 8; FPrecision := 0; end; - 'M','G','B': + 'B': + begin + if DbfVersion <> xFoxPro then + begin + FSize := 10; + FPrecision := 0; + end; + end; + 'M','G': begin if DbfVersion = xFoxPro then - FSize := 4 - else + begin + if (FSize <> 4) and (FSize <> 10) then + FSize := 4; + end else FSize := 10; FPrecision := 0; end; diff --git a/fcl/db/dbase/dbf_idxcur.pas b/fcl/db/dbase/dbf_idxcur.pas index 8a16bb8cd2..7b7906ef1a 100644 --- a/fcl/db/dbase/dbf_idxcur.pas +++ b/fcl/db/dbase/dbf_idxcur.pas @@ -40,7 +40,7 @@ type procedure Update(RecNo: Integer; PrevBuffer, NewBuffer: PChar); {$ifdef SUPPORT_VARIANTS} - procedure VariantToBuffer(Key: Variant; ABuffer: PChar); + function VariantToBuffer(Key: Variant; ABuffer: PChar): TExpressionType; {$endif} function CheckUserKey(Key: PChar; StringBuf: PChar): PChar; @@ -128,7 +128,7 @@ end; {$ifdef SUPPORT_VARIANTS} -procedure TIndexCursor.VariantToBuffer(Key: Variant; ABuffer: PChar); +function TIndexCursor.VariantToBuffer(Key: Variant; ABuffer: PChar): TExpressionType; // assumes ABuffer is large enough ie. at least max key size var currLen: Integer; @@ -140,12 +140,14 @@ begin begin // make copy of userbcd to buffer Move(TIndexFile(PagedFile).PrepareKey(ABuffer, etFloat)[0], ABuffer[0], 11); - end + end; + Result := etInteger; end else begin StrPLCopy(ABuffer, Key, TIndexFile(PagedFile).KeyLen); // we have null-terminated string, pad with spaces if string too short currLen := StrLen(ABuffer); FillChar(ABuffer[currLen], TIndexFile(PagedFile).KeyLen-currLen, ' '); + Result := etString; end; end; diff --git a/fcl/db/dbase/dbf_idxfile.pas b/fcl/db/dbase/dbf_idxfile.pas index 6583c8aabf..6a67c5ab5f 100644 --- a/fcl/db/dbase/dbf_idxfile.pas +++ b/fcl/db/dbase/dbf_idxfile.pas @@ -5,7 +5,7 @@ interface {$I dbf_common.inc} uses -{$ifdef WIN32} +{$ifdef WINDOWS} Windows, {$else} {$ifdef KYLIX} @@ -23,6 +23,7 @@ uses dbf_parser, dbf_prsdef, dbf_cursor, + dbf_collate, dbf_common; {$ifdef _DEBUG} @@ -46,7 +47,6 @@ type TIndexModifyMode = (mmNormal, mmDeleteRecall); TDbfLocaleErrorEvent = procedure(var Error: TLocaleError; var Solution: TLocaleSolution) of object; - TDbfCompareKeyEvent = function(Key: PChar): Integer of object; TDbfCompareKeysEvent = function(Key1, Key2: PChar): Integer of object; PDouble = ^Double; @@ -77,6 +77,14 @@ type property Options: TIndexOptions read FOptions write FOptions; end; + TDbfIndexParser = class(TDbfParser) + protected + FResultLen: Integer; + + procedure ValidateExpression(AExpression: string); override; + public + property ResultLen: Integer read FResultLen; + end; //=========================================================================== TIndexFile = class; TIndexPageClass = class of TIndexPage; @@ -216,14 +224,14 @@ type {$endif} protected FIndexName: string; - FParsers: array[0..MaxIndexes-1] of TDbfParser; + FParsers: array[0..MaxIndexes-1] of TDbfIndexParser; FIndexHeaders: array[0..MaxIndexes-1] of Pointer; FIndexHeaderModified: array[0..MaxIndexes-1] of Boolean; FIndexHeader: Pointer; FIndexVersion: TXBaseVersion; FRoots: array[0..MaxIndexes-1] of TIndexPage; FLeaves: array[0..MaxIndexes-1] of TIndexPage; - FCurrentParser: TDbfParser; + FCurrentParser: TDbfIndexParser; FRoot: TIndexPage; FLeaf: TIndexPage; FMdxTag: TIndexTag; @@ -254,10 +262,8 @@ type FUserNumeric: Double; FForceClose: Boolean; FForceReadOnly: Boolean; - FLocaleID: LCID; - FLocaleCP: Integer; FCodePage: Integer; - FCompareKey: TDbfCompareKeyEvent; + FCollation: PCollationTable; FCompareKeys: TDbfCompareKeysEvent; FOnLocaleError: TDbfLocaleErrorEvent; @@ -291,10 +297,6 @@ type function WalkPrev: boolean; function WalkNext: boolean; - procedure TranslateToANSI(Src, Dest: PChar); - function CompareKeyNumericNDX(Key: PChar): Integer; - function CompareKeyNumericMDX(Key: PChar): Integer; - function CompareKeyString(Key: PChar): Integer; function CompareKeysNumericNDX(Key1, Key2: PChar): Integer; function CompareKeysNumericMDX(Key1, Key2: PChar): Integer; function CompareKeysString(Key1, Key2: PChar): Integer; @@ -313,9 +315,6 @@ type procedure SetPhysicalRecNo(RecNo: Integer); procedure SetUpdateMode(NewMode: TIndexUpdateMode); procedure SetIndexName(const AIndexName: string); - procedure SetLocaleID(const NewID: LCID); - - property InternalLocaleID: LCID read FLocaleID write SetLocaleID; public constructor Create(ADbfFile: Pointer); @@ -387,7 +386,6 @@ type property ForceClose: Boolean read FForceClose; property ForceReadOnly: Boolean read FForceReadOnly; - property LocaleID: LCID read FLocaleID; property CodePage: Integer read FCodePage write FCodePage; property OnLocaleError: TDbfLocaleErrorEvent read FOnLocaleError write FOnLocaleError; @@ -1684,6 +1682,31 @@ begin PMdx7Tag(Tag)^.KeyType := NewType; end; +{ TDbfIndexParser } + +procedure TDbfIndexParser.ValidateExpression(AExpression: string); +var + TempBuffer: pchar; +begin + FResultLen := inherited ResultLen; + + if FResultLen = -1 then + begin + // make empty record + GetMem(TempBuffer, TDbfFile(DbfFile).RecordSize); + try + TDbfFile(DbfFile).InitRecord(TempBuffer); + FResultLen := StrLen(ExtractFromBuffer(TempBuffer)); + finally + FreeMem(TempBuffer); + end; + end; + + // check if expression not too long + if FResultLen > 100 then + raise EDbfError.CreateFmt(STRING_INDEX_EXPRESSION_TOO_LONG, [AExpression, FResultLen]); +end; + //============================================================================== //============ TIndexFile //============================================================================== @@ -1804,7 +1827,7 @@ begin FIndexHeaders[0] := Header; FIndexHeader := Header; // create default root - FParsers[0] := TDbfParser.Create(FDbfFile); + FParsers[0] := TDbfIndexParser.Create(FDbfFile); FRoots[0] := TNdxPage.Create(Self); FCurrentParser := FParsers[0]; FRoot := FRoots[0]; @@ -1812,7 +1835,7 @@ begin // parse index expression FCurrentParser.ParseExpression(PIndexHdr(FIndexHeader)^.KeyDesc); // set index locale - InternalLocaleID := LCID(lcidBinary); + FCollation := BINARY_COLLATION; end; // determine how to open file @@ -1832,27 +1855,27 @@ begin begin // if dbf is version 3, no language id, if no MDX language, use binary if PMdxHdr(Header)^.Language = 0 then - InternalLocaleID := lcidBinary + FCollation := BINARY_COLLATION else - InternalLocaleID := LangId_To_Locale[PMdxHdr(Header)^.Language]; + FCollation := GetCollationTable(PMdxHdr(Header)^.Language); end else begin // check if MDX - DBF language id's match if (PMdxHdr(Header)^.Language = 0) or (PMdxHdr(Header)^.Language = DbfLangId) then - InternalLocaleID := LangId_To_Locale[DbfLangId] + FCollation := GetCollationTable(DbfLangId) else localeError := leTableIndexMismatch; end; // don't overwrite previous error - if (FLocaleID = DbfLocale_NotFound) and (localeError = leNone) then + if (FCollation = UNKNOWN_COLLATION) and (localeError = leNone) then localeError := leUnknown; end else begin // dbase III always binary? - InternalLocaleID := lcidBinary; + FCollation := BINARY_COLLATION; end; // check if selected locale is available, binary is always available... - if (localeError <> leNone) and (FLocaleID <> LCID(lcidBinary)) then + if (localeError <> leNone) and (FCollation <> BINARY_COLLATION) then begin - if LCIDList.IndexOf(Pointer(FLocaleID)) < 0 then + if LCIDList.IndexOf(Pointer(FCollation)) < 0 then localeError := leNotAvailable; end; // check if locale error detected @@ -1868,8 +1891,8 @@ begin lsNotOpen: FForceClose := true; lsNoEdit: FForceReadOnly := true; else - // `trust' user knows correct locale - InternalLocaleID := LCID(localeSolution); + { lsBinary } + FCollation := BINARY_COLLATION; end; end; // now read info @@ -1997,9 +2020,9 @@ begin // use locale id of parent DbfLangId := GetDbfLanguageId; if DbfLangId = 0 then - InternalLocaleID := lcidBinary + FCollation := BINARY_COLLATION else - InternalLocaleID := LangID_To_Locale[DbfLangId]; + FCollation := GetCollationTable(DbfLangId); // write index headers prevSelIndex := FSelectedIndex; for pos := 0 to PMdxHdr(Header)^.TagsUsed - 1 do @@ -2093,12 +2116,12 @@ procedure TIndexFile.CreateIndex(FieldDesc, TagName: string; Options: TIndexOpti var tagNo: Integer; fieldType: Char; - TempParser: TDbfParser; + TempParser: TDbfIndexParser; begin // check if we have exclusive access to table TDbfFile(FDbfFile).CheckExclusiveAccess; // parse index expression; if it cannot be parsed, why bother making index? - TempParser := TDbfParser.Create(FDbfFile); + TempParser := TDbfIndexParser.Create(FDbfFile); try TempParser.ParseExpression(FieldDesc); // check if result type is correct @@ -2123,7 +2146,7 @@ begin // get memory for root if FRoots[tagNo] = nil then begin - FParsers[tagNo] := TDbfParser.Create(FDbfFile); + FParsers[tagNo] := TDbfIndexParser.Create(FDbfFile); FRoots[tagNo] := TMdxPage.Create(Self) end else begin FreeAndNil(FRoots[tagNo].FLowerPage); @@ -2283,7 +2306,7 @@ begin // create root if needed if FRoots[I] = nil then begin - FParsers[I] := TDbfParser.Create(FDbfFile); + FParsers[I] := TDbfIndexParser.Create(FDbfFile); FRoots[I] := TMdxPage.Create(Self); end; // check header integrity @@ -2324,7 +2347,7 @@ var I, found, numTags, moveItems: Integer; tempHeader: Pointer; tempRoot, tempLeaf: TIndexPage; - tempParser: TDbfParser; + tempParser: TDbfIndexParser; begin // check if we have exclusive access to table TDbfFile(FDbfFile).CheckExclusiveAccess; @@ -2913,6 +2936,8 @@ function TIndexFile.ExtractKeyFromBuffer(Buffer: PChar): PChar; begin // execute expression to get key Result := PrepareKey(FCurrentParser.ExtractFromBuffer(Buffer), FCurrentParser.ResultType); + if not FCurrentParser.RawStringFields then + TranslateString(GetACP, FCodePage, Result, Result, KeyLen); end; procedure TIndexFile.InsertKey(Buffer: PChar); @@ -2933,21 +2958,11 @@ end; procedure TIndexFile.InsertCurrent; // insert in current index // assumes: FUserKey is an OEM key -var - lSearchKey: array[0..100] of Char; - OemKey: PChar; begin // only insert if not recalling or mode = distinct // modify = mmDeleteRecall /\ unique <> distinct -> key already present if (FModifyMode <> mmDeleteRecall) or (FUniqueMode = iuDistinct) then begin - // translate OEM key to ANSI key for searching - OemKey := FUserKey; - if KeyType = 'C' then - begin - FUserKey := @lSearchKey[0]; - TranslateToANSI(OemKey, FUserKey); - end; // temporarily remove range to find correct location of key ResetRange; // find this record as closely as possible @@ -2955,8 +2970,6 @@ begin // if unique index, then don't insert key if already present if (FindKey(true) <> 0) or (FUniqueMode = iuNormal) then begin - // switch to oem key - FUserKey := OemKey; // if we found eof, write to pagebuffer FLeaf.GotoInsertEntry; // insert requested entry, we know there is an entry available @@ -3020,9 +3033,6 @@ end; procedure TIndexFile.DeleteCurrent; // deletes from current index -var - lSearchKey: array[0..100] of Char; - OemKey: PChar; begin // only delete if not delete record or mode = distinct // modify = mmDeleteRecall /\ unique = distinct -> key needs to be deleted from index @@ -3033,13 +3043,6 @@ begin // search correct entry to delete if FLeaf.PhysicalRecNo <> FUserRecNo then begin - // translate OEM key to ANSI key for searching - OemKey := FUserKey; - if KeyType = 'C' then - begin - FUserKey := @lSearchKey[0]; - TranslateToANSI(OemKey, FUserKey); - end; FindKey(false); end; // delete selected entry @@ -3085,7 +3088,7 @@ begin FUserKey := ExtractKeyFromBuffer(PrevBuffer); // compare to see if anything changed - if CompareKeys(@TempBuffer[0], FUserKey) <> 0 then + if CompareKey(@TempBuffer[0]) <> 0 then begin // first set userkey to key to delete // FUserKey = KeyFrom(PrevBuffer) @@ -3329,28 +3332,6 @@ begin FModifyMode := mmNormal; end; -procedure TIndexFile.SetLocaleID(const NewID: LCID); -{$ifdef WIN32} -var - InfoStr: array[0..7] of Char; -{$endif} -begin - FLocaleID := NewID; - if NewID = lcidBinary then - begin - // no conversion on binary sort order - FLocaleCP := FCodePage; - end else begin - // get default ansi codepage for comparestring -{$ifdef WIN32} - GetLocaleInfo(NewID, LOCALE_IDEFAULTANSICODEPAGE, InfoStr, 8); - FLocaleCP := StrToIntDef(InfoStr, GetACP); -{$else} - FLocaleCP := GetACP; -{$endif} - end; -end; - procedure TIndexFile.SetPhysicalRecNo(RecNo: Integer); begin // check if already at specified recno @@ -3364,9 +3345,6 @@ begin TDbfFile(FDbfFile).ReadRecord(RecNo, TDbfFile(FDbfFile).PrevBuffer); // extract key FUserKey := ExtractKeyFromBuffer(TDbfFile(FDbfFile).PrevBuffer); - // translate to a search key - if KeyType = 'C' then - TranslateToANSI(FUserKey, FUserKey); // find this key FUserRecNo := RecNo; FindKey(false); @@ -3490,9 +3468,6 @@ begin end else begin // read current key into buffer Move(FLeaf.Key^, FKeyBuffer, PIndexHdr(FIndexHeader)^.KeyLen); - // translate to searchable key - if KeyType = 'C' then - TranslateToANSI(FKeyBuffer, FKeyBuffer); recno := FLeaf.PhysicalRecNo; action := 2; end; @@ -3757,64 +3732,15 @@ begin end; function TIndexFile.CompareKeysString(Key1, Key2: PChar): Integer; -var - Key1T, Key2T: array [0..100] of Char; - FromCP, ToCP: Integer; begin - if FLocaleID = LCID(lcidBinary) then - begin - Result := StrLComp(Key1, Key2, KeyLen) - end else begin - FromCP := FCodePage; - ToCP := FLocaleCP; - TranslateString(FromCP, ToCP, Key1, Key1T, KeyLen); - TranslateString(FromCP, ToCP, Key2, Key2T, KeyLen); - Result := CompareString(FLocaleID, 0, Key1T, KeyLen, Key2T, KeyLen); - if Result > 0 then - Dec(Result, 2); - end + Result := DbfCompareString(FCollation, Key1, KeyLen, Key2, KeyLen); + if Result > 0 then + Dec(Result, 2); end; function TIndexFile.CompareKey(Key: PChar): Integer; begin - // call compare routine - Result := FCompareKey(Key); - - // if descending then reverse order - if FIsDescending then - Result := -Result; -end; - -function TIndexFile.CompareKeyNumericNDX(Key: PChar): Integer; -begin - Result := CompareKeysNumericNDX(FUserKey, Key); -end; - -function TIndexFile.CompareKeyNumericMDX(Key: PChar): Integer; -begin - Result := CompareKeysNumericMDX(FUserKey, Key); -end; - -procedure TIndexFile.TranslateToANSI(Src, Dest: PChar); -begin - { FromCP = FCodePage; } - { ToCP = FLocaleCP; } - TranslateString(FCodePage, FLocaleCP, Src, Dest, KeyLen); -end; - -function TIndexFile.CompareKeyString(Key: PChar): Integer; -var - KeyT: array [0..100] of Char; -begin - if FLocaleID = LCID(lcidBinary) then - begin - Result := StrLComp(FUserKey, Key, KeyLen) - end else begin - TranslateToANSI(Key, KeyT); - Result := CompareString(FLocaleID, 0, FUserKey, KeyLen, KeyT, KeyLen); - if Result > 0 then - Dec(Result, 2); - end + Result := CompareKeys(FUserKey, Key); end; function TIndexFile.IndexOf(const AIndexName: string): Integer; @@ -3900,18 +3826,12 @@ begin FUniqueMode := iuDistinct; // select key compare routine if PIndexHdr(FIndexHeader)^.KeyType = 'C' then - begin - FCompareKeys := CompareKeysString; - FCompareKey := CompareKeyString; - end else + FCompareKeys := CompareKeysString + else if FIndexVersion >= xBaseIV then - begin - FCompareKeys := CompareKeysNumericMDX; - FCompareKey := CompareKeyNumericMDX; - end else begin + FCompareKeys := CompareKeysNumericMDX + else FCompareKeys := CompareKeysNumericNDX; - FCompareKey := CompareKeyNumericNDX; - end; end; procedure TIndexFile.Flush; diff --git a/fcl/db/dbase/dbf_lang.pas b/fcl/db/dbase/dbf_lang.pas index d734049138..c0c98ffb27 100644 --- a/fcl/db/dbase/dbf_lang.pas +++ b/fcl/db/dbase/dbf_lang.pas @@ -5,7 +5,7 @@ unit dbf_lang; interface uses -{$ifdef WIN32} +{$ifdef WINDOWS} Windows; {$else} {$ifdef KYLIX} diff --git a/fcl/db/dbase/dbf_memo.pas b/fcl/db/dbase/dbf_memo.pas index 32bbc73d8a..6b2d9c9e31 100644 --- a/fcl/db/dbase/dbf_memo.pas +++ b/fcl/db/dbase/dbf_memo.pas @@ -238,7 +238,7 @@ begin exit; end else if numBytes < RecordSize then - FillChar(FBuffer[RecordSize-numBytes], numBytes, #0); + FillChar(FBuffer[numBytes], RecordSize-numBytes, #0); bytesLeft := GetMemoSize; // bytesLeft <> -1 -> memo size is known (FoxPro, dBase4) diff --git a/fcl/db/dbase/dbf_parser.pas b/fcl/db/dbase/dbf_parser.pas index 4bc96fe8cc..07012ff6b5 100644 --- a/fcl/db/dbase/dbf_parser.pas +++ b/fcl/db/dbase/dbf_parser.pas @@ -10,7 +10,7 @@ uses {$ifdef KYLIX} Libc, {$endif} -{$ifndef WIN32} +{$ifndef WINDOWS} dbf_wtil, {$endif} db, @@ -26,7 +26,6 @@ type private FDbfFile: Pointer; FFieldVarList: TStringList; - FResultLen: Integer; FIsExpression: Boolean; // expression or simple field? FFieldType: TExpressionType; FCaseInsensitive: Boolean; @@ -40,7 +39,9 @@ type procedure HandleUnknownVariable(VarName: string); override; function GetVariableInfo(VarName: string): TDbfFieldDef; function CurrentExpression: string; override; + procedure ValidateExpression(AExpression: string); virtual; function GetResultType: TExpressionType; override; + function GetResultLen: Integer; procedure SetCaseInsensitive(NewInsensitive: Boolean); procedure SetRawStringFields(NewRawFields: Boolean); @@ -56,21 +57,20 @@ type property DbfFile: Pointer read FDbfFile write FDbfFile; property Expression: string read FCurrentExpression; - property ResultLen: Integer read FResultLen; + property ResultLen: Integer read GetResultLen; property CaseInsensitive: Boolean read FCaseInsensitive write SetCaseInsensitive; property RawStringFields: Boolean read FRawStringFields write SetRawStringFields; property PartialMatch: boolean read FPartialMatch write SetPartialMatch; end; - implementation uses dbf, dbf_dbffile, dbf_str -{$ifdef WIN32} +{$ifdef WINDOWS} ,Windows {$endif} ; @@ -103,22 +103,18 @@ type TStringFieldVar = class(TFieldVar) protected FFieldVal: PChar; + FRawStringField: boolean; function GetFieldVal: Pointer; override; function GetFieldType: TExpressionType; override; - end; - - TRawStringFieldVar = class(TStringFieldVar) - public - procedure Refresh(Buffer: PChar); override; - end; - - TAnsiStringFieldVar = class(TStringFieldVar) + procedure SetRawStringField(NewRaw: boolean); public constructor Create(UseFieldDef: TDbfFieldDef; ADbfFile: TDbfFile); destructor Destroy; override; procedure Refresh(Buffer: PChar); override; + + property RawStringField: boolean read FRawStringField write SetRawStringField; end; TFloatFieldVar = class(TFieldVar) @@ -184,7 +180,20 @@ begin FFieldName := UseFieldDef.FieldName; end; -//--TStringFieldVar------------------------------------------------------------- +//--TStringFieldVar--------------------------------------------------------- +constructor TStringFieldVar.Create(UseFieldDef: TDbfFieldDef; ADbfFile: TDbfFile); +begin + inherited; +end; + +destructor TStringFieldVar.Destroy; +begin + if not FRawStringField then + FreeMem(FFieldVal); + + inherited; +end; + function TStringFieldVar.GetFieldVal: Pointer; begin Result := @FFieldVal; @@ -195,39 +204,37 @@ begin Result := etString; end; -//--TRawStringFieldVar---------------------------------------------------------- -procedure TRawStringFieldVar.Refresh(Buffer: PChar); -begin - FFieldVal := Buffer + FieldDef.Offset; -end; - -//--TAnsiStringFieldVar--------------------------------------------------------- -constructor TAnsiStringFieldVar.Create(UseFieldDef: TDbfFieldDef; ADbfFile: TDbfFile); -begin - inherited; - - GetMem(FFieldVal, UseFieldDef.Size+1); -end; - -destructor TAnsiStringFieldVar.Destroy; -begin - FreeMem(FFieldVal); - - inherited; -end; - -procedure TAnsiStringFieldVar.Refresh(Buffer: PChar); +procedure TStringFieldVar.Refresh(Buffer: PChar); var Len: Integer; + Src: PChar; begin // copy field data Len := FieldDef.Size; - Move(Buffer[FieldDef.Offset], FFieldVal[0], Len); + Src := Buffer+FieldDef.Offset; // trim right side spaces by null-termination - while (Len >= 1) and (FFieldVal[Len-1] = ' ') do Dec(Len); - FFieldVal[Len] := #0; - // translate to ANSI - TranslateString(DbfFile.UseCodePage, GetACP, FFieldVal, FFieldVal, Len); + if not FRawStringField then + begin + while (Len >= 1) and (Buffer[Len-1] = ' ') do Dec(Len); + FFieldVal[Len] := #0; + // translate to ANSI + TranslateString(DbfFile.UseCodePage, GetACP, Src, FFieldVal, Len); + end else + FFieldVal := Src; +end; + +procedure TStringFieldVar.SetRawStringField(NewRaw: boolean); +begin + if NewRaw = FRawStringField then exit; + FRawStringField := NewRaw; + if NewRaw then + begin + FExprWord.FixedLen := FieldDef.Size; + FreeMem(FFieldVal); + end else begin + FExprWord.FixedLen := -1; + GetMem(FFieldVal, FieldDef.Size*3+1); + end; end; //--TFloatFieldVar----------------------------------------------------------- @@ -244,7 +251,7 @@ end; procedure TFloatFieldVar.Refresh(Buffer: PChar); begin // database width is default 64-bit double - if not FDbfFile.GetFieldDataFromDef(FieldDef, FieldDef.FieldType, Buffer, @FFieldVal) then + if not FDbfFile.GetFieldDataFromDef(FieldDef, FieldDef.FieldType, Buffer, @FFieldVal, false) then FFieldVal := 0.0; end; @@ -262,7 +269,7 @@ end; procedure TIntegerFieldVar.Refresh(Buffer: PChar); begin FFieldVal := 0; - FDbfFile.GetFieldDataFromDef(FieldDef, FieldDef.FieldType, Buffer, @FFieldVal); + FDbfFile.GetFieldDataFromDef(FieldDef, FieldDef.FieldType, Buffer, @FFieldVal, false); end; {$ifdef SUPPORT_INT64} @@ -280,7 +287,7 @@ end; procedure TLargeIntFieldVar.Refresh(Buffer: PChar); begin - if not FDbfFile.GetFieldDataFromDef(FieldDef, FieldDef.FieldType, Buffer, @FFieldVal) then + if not FDbfFile.GetFieldDataFromDef(FieldDef, FieldDef.FieldType, Buffer, @FFieldVal, false) then FFieldVal := 0; end; @@ -299,7 +306,7 @@ end; procedure TDateTimeFieldVar.Refresh(Buffer: PChar); begin - if not FDbfFile.GetFieldDataFromDef(FieldDef, ftDateTime, Buffer, @FFieldVal) then + if not FDbfFile.GetFieldDataFromDef(FieldDef, ftDateTime, Buffer, @FFieldVal, false) then FFieldVal.DateTime := 0.0; end; @@ -318,21 +325,14 @@ procedure TBooleanFieldVar.Refresh(Buffer: PChar); var lFieldVal: word; begin - if FDbfFile.GetFieldDataFromDef(FieldDef, ftBoolean, Buffer, @lFieldVal) then + if FDbfFile.GetFieldDataFromDef(FieldDef, ftBoolean, Buffer, @lFieldVal, false) then FFieldVal := lFieldVal <> 0 else FFieldVal := false; end; - //--TDbfParser--------------------------------------------------------------- -(* -var - DbfWordsSensGeneralList, DbfWordsInsensGeneralList: TExpressList; - DbfWordsSensPartialList, DbfWordsInsensPartialList: TExpressList; - DbfWordsSensNoPartialList, DbfWordsInsensNoPartialList: TExpressList; - DbfWordsGeneralList: TExpressList; -*) + constructor TDbfParser.Create(ADbfFile: Pointer); begin FDbfFile := ADbfFile; @@ -358,6 +358,26 @@ begin Result := FFieldType; end; +function TDbfParser.GetResultLen: Integer; +begin + // set result len for fixed length expressions / fields + case ResultType of + etBoolean: Result := 1; + etInteger: Result := 4; + etFloat: Result := 8; + etDateTime: Result := 8; + etString: + begin + if not FIsExpression and (TStringFieldVar(FFieldVarList.Objects[0]).RawStringField) then + Result := TStringFieldVar(FFieldVarList.Objects[0]).FieldDef.Size + else + Result := -1; + end; + else + Result := -1; + end; +end; + procedure TDbfParser.SetCaseInsensitive(NewInsensitive: Boolean); begin if FCaseInsensitive <> NewInsensitive then @@ -379,13 +399,16 @@ begin end; procedure TDbfParser.SetRawStringFields(NewRawFields: Boolean); +var + I: integer; begin if FRawStringFields <> NewRawFields then begin // clear and regenerate functions, custom fields will be deleted too FRawStringFields := NewRawFields; - if Length(Expression) > 0 then - ParseExpression(Expression); + for I := 0 to FFieldVarList.Count - 1 do + if FFieldVarList.Objects[I] is TStringFieldVar then + TStringFieldVar(FFieldVarList.Objects[I]).RawStringField := NewRawFields; end; end; @@ -438,16 +461,9 @@ begin case FieldInfo.FieldType of ftString: begin - if RawStringFields then - begin - { raw string fields have fixed length, not null-terminated } - TempFieldVar := TRawStringFieldVar.Create(FieldInfo, TDbfFile(FDbfFile)); - 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)); - TempFieldVar.FExprWord := DefineStringVariable(VarName, TempFieldVar.FieldVal); - end; + TempFieldVar := TStringFieldVar.Create(FieldInfo, TDbfFile(FDbfFile)); + TempFieldVar.FExprWord := DefineStringVariable(VarName, TempFieldVar.FieldVal); + TStringFieldVar(TempFieldVar).RawStringField := FRawStringFields; end; ftBoolean: begin @@ -512,9 +528,11 @@ begin FCurrentExpression := EmptyStr; end; +procedure TDbfParser.ValidateExpression(AExpression: string); +begin +end; + procedure TDbfParser.ParseExpression(AExpression: string); -var - TempBuffer: pchar; begin // clear any current expression ClearExpressions; @@ -525,39 +543,13 @@ begin begin // parse requested CompileExpression(AExpression); - - // determine length of string length expressions - if ResultType = etString then - begin - // make empty record - 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 HandleUnknownVariable(AExpression); FFieldType := TFieldVar(FFieldVarList.Objects[0]).FieldType; - // set result len of variable length fields - if FFieldType = etString then - FResultLen := TFieldVar(FFieldVarList.Objects[0]).FieldDef.Size end; - // set result len for fixed length expressions / fields - case ResultType of - etBoolean: FResultLen := 1; - etInteger: FResultLen := 4; - etFloat: FResultLen := 8; - etDateTime: FResultLen := 8; - end; - - // check if expression not too long - if FResultLen > 100 then - raise EDbfError.CreateFmt(STRING_INDEX_EXPRESSION_TOO_LONG, [AExpression, FResultLen]); + ValidateExpression(AExpression); // if no errors, assign current expression FCurrentExpression := AExpression; @@ -585,180 +577,6 @@ begin Result := PPChar(Result)^; end; end; -(* -initialization - DbfWordsGeneralList := TExpressList.Create; - DbfWordsInsensGeneralList := TExpressList.Create; - DbfWordsInsensNoPartialList := TExpressList.Create; - DbfWordsInsensPartialList := TExpressList.Create; - DbfWordsSensGeneralList := TExpressList.Create; - DbfWordsSensNoPartialList := TExpressList.Create; - DbfWordsSensPartialList := TExpressList.Create; - - with DbfWordsGeneralList do - begin - // basic function functionality - Add(TLeftBracket.Create('(', nil)); - Add(TRightBracket.Create(')', nil)); - Add(TComma.Create(',', nil)); - - // operators - name, param types, result type, func addr, precedence - Add(TFunction.CreateOper('+', 'SS', etString, nil, 40)); - Add(TFunction.CreateOper('+', 'FF', etFloat, FuncAdd_F_FF, 40)); - Add(TFunction.CreateOper('+', 'FI', etFloat, FuncAdd_F_FI, 40)); - Add(TFunction.CreateOper('+', 'IF', etFloat, FuncAdd_F_IF, 40)); - Add(TFunction.CreateOper('+', 'II', etInteger, FuncAdd_F_II, 40)); -{$ifdef SUPPORT_INT64} - Add(TFunction.CreateOper('+', 'FL', etFloat, FuncAdd_F_FL, 40)); - Add(TFunction.CreateOper('+', 'IL', etLargeInt, FuncAdd_F_IL, 40)); - Add(TFunction.CreateOper('+', 'LF', etFloat, FuncAdd_F_LF, 40)); - Add(TFunction.CreateOper('+', 'LL', etLargeInt, FuncAdd_F_LI, 40)); - Add(TFunction.CreateOper('+', 'LI', etLargeInt, FuncAdd_F_LL, 40)); -{$endif} - Add(TFunction.CreateOper('-', 'FF', etFloat, FuncSub_F_FF, 40)); - Add(TFunction.CreateOper('-', 'FI', etFloat, FuncSub_F_FI, 40)); - Add(TFunction.CreateOper('-', 'IF', etFloat, FuncSub_F_IF, 40)); - Add(TFunction.CreateOper('-', 'II', etInteger, FuncSub_F_II, 40)); -{$ifdef SUPPORT_INT64} - Add(TFunction.CreateOper('-', 'FL', etFloat, FuncSub_F_FL, 40)); - Add(TFunction.CreateOper('-', 'IL', etLargeInt, FuncSub_F_IL, 40)); - Add(TFunction.CreateOper('-', 'LF', etFloat, FuncSub_F_LF, 40)); - Add(TFunction.CreateOper('-', 'LL', etLargeInt, FuncSub_F_LI, 40)); - Add(TFunction.CreateOper('-', 'LI', etLargeInt, FuncSub_F_LL, 40)); -{$endif} - Add(TFunction.CreateOper('*', 'FF', etFloat, FuncMul_F_FF, 40)); - Add(TFunction.CreateOper('*', 'FI', etFloat, FuncMul_F_FI, 40)); - Add(TFunction.CreateOper('*', 'IF', etFloat, FuncMul_F_IF, 40)); - Add(TFunction.CreateOper('*', 'II', etInteger, FuncMul_F_II, 40)); -{$ifdef SUPPORT_INT64} - Add(TFunction.CreateOper('*', 'FL', etFloat, FuncMul_F_FL, 40)); - Add(TFunction.CreateOper('*', 'IL', etLargeInt, FuncMul_F_IL, 40)); - Add(TFunction.CreateOper('*', 'LF', etFloat, FuncMul_F_LF, 40)); - Add(TFunction.CreateOper('*', 'LL', etLargeInt, FuncMul_F_LI, 40)); - Add(TFunction.CreateOper('*', 'LI', etLargeInt, FuncMul_F_LL, 40)); -{$endif} - Add(TFunction.CreateOper('/', 'FF', etFloat, FuncDiv_F_FF, 40)); - Add(TFunction.CreateOper('/', 'FI', etFloat, FuncDiv_F_FI, 40)); - Add(TFunction.CreateOper('/', 'IF', etFloat, FuncDiv_F_IF, 40)); - Add(TFunction.CreateOper('/', 'II', etInteger, FuncDiv_F_II, 40)); -{$ifdef SUPPORT_INT64} - Add(TFunction.CreateOper('/', 'FL', etFloat, FuncDiv_F_FL, 40)); - Add(TFunction.CreateOper('/', 'IL', etLargeInt, FuncDiv_F_IL, 40)); - Add(TFunction.CreateOper('/', 'LF', etFloat, FuncDiv_F_LF, 40)); - Add(TFunction.CreateOper('/', 'LL', etLargeInt, FuncDiv_F_LI, 40)); - Add(TFunction.CreateOper('/', 'LI', etLargeInt, FuncDiv_F_LL, 40)); -{$endif} - - Add(TFunction.CreateOper('=', 'FF', etBoolean, Func_FF_EQ , 80)); - Add(TFunction.CreateOper('<', 'FF', etBoolean, Func_FF_LT , 80)); - Add(TFunction.CreateOper('>', 'FF', etBoolean, Func_FF_GT , 80)); - Add(TFunction.CreateOper('<=','FF', etBoolean, Func_FF_LTE, 80)); - Add(TFunction.CreateOper('>=','FF', etBoolean, Func_FF_GTE, 80)); - Add(TFunction.CreateOper('<>','FF', etBoolean, Func_FF_NEQ, 80)); - Add(TFunction.CreateOper('=', 'FI', etBoolean, Func_FI_EQ , 80)); - Add(TFunction.CreateOper('<', 'FI', etBoolean, Func_FI_LT , 80)); - Add(TFunction.CreateOper('>', 'FI', etBoolean, Func_FI_GT , 80)); - Add(TFunction.CreateOper('<=','FI', etBoolean, Func_FI_LTE, 80)); - Add(TFunction.CreateOper('>=','FI', etBoolean, Func_FI_GTE, 80)); - Add(TFunction.CreateOper('<>','FI', etBoolean, Func_FI_NEQ, 80)); - Add(TFunction.CreateOper('=', 'II', etBoolean, Func_II_EQ , 80)); - Add(TFunction.CreateOper('<', 'II', etBoolean, Func_II_LT , 80)); - Add(TFunction.CreateOper('>', 'II', etBoolean, Func_II_GT , 80)); - Add(TFunction.CreateOper('<=','II', etBoolean, Func_II_LTE, 80)); - Add(TFunction.CreateOper('>=','II', etBoolean, Func_II_GTE, 80)); - Add(TFunction.CreateOper('<>','II', etBoolean, Func_II_NEQ, 80)); - Add(TFunction.CreateOper('=', 'IF', etBoolean, Func_IF_EQ , 80)); - Add(TFunction.CreateOper('<', 'IF', etBoolean, Func_IF_LT , 80)); - Add(TFunction.CreateOper('>', 'IF', etBoolean, Func_IF_GT , 80)); - Add(TFunction.CreateOper('<=','IF', etBoolean, Func_IF_LTE, 80)); - Add(TFunction.CreateOper('>=','IF', etBoolean, Func_IF_GTE, 80)); - Add(TFunction.CreateOper('<>','IF', etBoolean, Func_IF_NEQ, 80)); -{$ifdef SUPPORT_INT64} - Add(TFunction.CreateOper('=', 'LL', etBoolean, Func_LL_EQ , 80)); - Add(TFunction.CreateOper('<', 'LL', etBoolean, Func_LL_LT , 80)); - Add(TFunction.CreateOper('>', 'LL', etBoolean, Func_LL_GT , 80)); - Add(TFunction.CreateOper('<=','LL', etBoolean, Func_LL_LTE, 80)); - Add(TFunction.CreateOper('>=','LL', etBoolean, Func_LL_GTE, 80)); - Add(TFunction.CreateOper('<>','LL', etBoolean, Func_LL_NEQ, 80)); - Add(TFunction.CreateOper('=', 'LF', etBoolean, Func_LF_EQ , 80)); - Add(TFunction.CreateOper('<', 'LF', etBoolean, Func_LF_LT , 80)); - Add(TFunction.CreateOper('>', 'LF', etBoolean, Func_LF_GT , 80)); - Add(TFunction.CreateOper('<=','LF', etBoolean, Func_LF_LTE, 80)); - Add(TFunction.CreateOper('>=','LF', etBoolean, Func_LF_GTE, 80)); - Add(TFunction.CreateOper('<>','FI', etBoolean, Func_LF_NEQ, 80)); - Add(TFunction.CreateOper('=', 'LI', etBoolean, Func_LI_EQ , 80)); - Add(TFunction.CreateOper('<', 'LI', etBoolean, Func_LI_LT , 80)); - Add(TFunction.CreateOper('>', 'LI', etBoolean, Func_LI_GT , 80)); - Add(TFunction.CreateOper('<=','LI', etBoolean, Func_LI_LTE, 80)); - Add(TFunction.CreateOper('>=','LI', etBoolean, Func_LI_GTE, 80)); - Add(TFunction.CreateOper('<>','LI', etBoolean, Func_LI_NEQ, 80)); - Add(TFunction.CreateOper('=', 'FL', etBoolean, Func_FL_EQ , 80)); - Add(TFunction.CreateOper('<', 'FL', etBoolean, Func_FL_LT , 80)); - Add(TFunction.CreateOper('>', 'FL', etBoolean, Func_FL_GT , 80)); - Add(TFunction.CreateOper('<=','FL', etBoolean, Func_FL_LTE, 80)); - Add(TFunction.CreateOper('>=','FL', etBoolean, Func_FL_GTE, 80)); - Add(TFunction.CreateOper('<>','FL', etBoolean, Func_FL_NEQ, 80)); - Add(TFunction.CreateOper('=', 'IL', etBoolean, Func_IL_EQ , 80)); - Add(TFunction.CreateOper('<', 'IL', etBoolean, Func_IL_LT , 80)); - Add(TFunction.CreateOper('>', 'IL', etBoolean, Func_IL_GT , 80)); - Add(TFunction.CreateOper('<=','IL', etBoolean, Func_IL_LTE, 80)); - Add(TFunction.CreateOper('>=','IL', etBoolean, Func_IL_GTE, 80)); - Add(TFunction.CreateOper('<>','IL', etBoolean, Func_IL_NEQ, 80)); -{$endif} - - Add(TFunction.CreateOper('NOT', 'B', etBoolean, Func_NOT, 85)); - Add(TFunction.CreateOper('AND', 'BB', etBoolean, Func_AND, 90)); - Add(TFunction.CreateOper('OR', 'BB', etBoolean, Func_OR, 100)); - - // Functions - name, description, param types, min params, result type, Func addr - Add(TFunction.Create('STR', '', 'FII', 1, etString, FuncFloatToStr, '')); - Add(TFunction.Create('STR', '', 'III', 1, etString, FuncIntToStr, '')); - Add(TFunction.Create('DTOS', '', 'D', 1, etString, FuncDateToStr, '')); - Add(TFunction.Create('SUBSTR', 'SUBS', 'SII', 3, etString, FuncSubString, '')); - Add(TFunction.Create('UPPERCASE', 'UPPER', 'S', 1, etString, FuncUppercase, '')); - Add(TFunction.Create('LOWERCASE', 'LOWER', 'S', 1, etString, FuncLowercase, '')); - end; - - with DbfWordsInsensGeneralList do - begin - Add(TFunction.CreateOper('<', 'SS', etBoolean, FuncStrI_LT , 80)); - Add(TFunction.CreateOper('>', 'SS', etBoolean, FuncStrI_GT , 80)); - Add(TFunction.CreateOper('<=','SS', etBoolean, FuncStrI_LTE, 80)); - Add(TFunction.CreateOper('>=','SS', etBoolean, FuncStrI_GTE, 80)); - Add(TFunction.CreateOper('<>','SS', etBoolean, FuncStrI_NEQ, 80)); - end; - - with DbfWordsInsensNoPartialList do - Add(TFunction.CreateOper('=', 'SS', etBoolean, FuncStrI_EQ , 80)); - - with DbfWordsInsensPartialList do - Add(TFunction.CreateOper('=', 'SS', etBoolean, FuncStrIP_EQ, 80)); - - with DbfWordsSensGeneralList do - begin - Add(TFunction.CreateOper('<', 'SS', etBoolean, FuncStr_LT , 80)); - Add(TFunction.CreateOper('>', 'SS', etBoolean, FuncStr_GT , 80)); - Add(TFunction.CreateOper('<=','SS', etBoolean, FuncStr_LTE, 80)); - Add(TFunction.CreateOper('>=','SS', etBoolean, FuncStr_GTE, 80)); - Add(TFunction.CreateOper('<>','SS', etBoolean, FuncStr_NEQ, 80)); - end; - - with DbfWordsSensNoPartialList do - Add(TFunction.CreateOper('=', 'SS', etBoolean, FuncStr_EQ , 80)); - - with DbfWordsSensPartialList do - Add(TFunction.CreateOper('=', 'SS', etBoolean, FuncStrP_EQ , 80)); - -finalization - - DbfWordsGeneralList.Free; - DbfWordsInsensGeneralList.Free; - DbfWordsInsensNoPartialList.Free; - DbfWordsInsensPartialList.Free; - DbfWordsSensGeneralList.Free; - DbfWordsSensNoPartialList.Free; - DbfWordsSensPartialList.Free; -*) end. diff --git a/fcl/db/dbase/dbf_pgfile.pas b/fcl/db/dbase/dbf_pgfile.pas index d1fd705bf4..fab92cc72d 100644 --- a/fcl/db/dbase/dbf_pgfile.pas +++ b/fcl/db/dbase/dbf_pgfile.pas @@ -146,7 +146,7 @@ type implementation uses -{$ifdef WIN32} +{$ifdef WINDOWS} Windows, {$else} {$ifdef KYLIX} @@ -773,7 +773,7 @@ end; // BDE compatible lock offset found! const -{$ifdef WIN32} +{$ifdef WINDOWS} LockOffset = $EFFFFFFE; // BDE compatible FileLockSize = 2; {$else} diff --git a/fcl/db/dbase/dbf_prscore.pas b/fcl/db/dbase/dbf_prscore.pas index 9a80294ac8..dad27876d7 100644 --- a/fcl/db/dbase/dbf_prscore.pas +++ b/fcl/db/dbase/dbf_prscore.pas @@ -4,6 +4,18 @@ unit dbf_prscore; | TCustomExpressionParser | | - contains core expression parser +| +| This code is based on code from: +| +| Original author: Egbert van Nes +| With contributions of: John Bultena and Ralf Junker +| Homepage: http://www.slm.wau.nl/wkao/parseexpr.html +| +| see also: http://www.datalog.ro/delphi/parser.html +| (Renate Schaaf (schaaf at math.usu.edu), 1993 +| Alin Flaider (aflaidar at datalog.ro), 1996 +| Version 9-10: Stefan Hoffmeister, 1996-1997) +| |---------------------------------------------------------------} interface @@ -81,7 +93,6 @@ type 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); @@ -104,8 +115,9 @@ type //--Expression functions----------------------------------------------------- procedure FuncFloatToStr(Param: PExpressionRec); -procedure FuncIntToStr_Gen(Param: PExpressionRec; Val: Integer); +procedure FuncIntToStr_Gen(Param: PExpressionRec; Val: {$ifdef SUPPORT_INT64}Int64{$else}Integer{$endif}); procedure FuncIntToStr(Param: PExpressionRec); +procedure FuncInt64ToStr(Param: PExpressionRec); procedure FuncDateToStr(Param: PExpressionRec); procedure FuncSubString(Param: PExpressionRec); procedure FuncUppercase(Param: PExpressionRec); @@ -155,13 +167,11 @@ procedure FuncDiv_F_LF(Param: PExpressionRec); procedure FuncDiv_F_LI(Param: PExpressionRec); {$endif} procedure FuncStrI_EQ(Param: PExpressionRec); -procedure FuncStrIP_EQ(Param: PExpressionRec); procedure FuncStrI_NEQ(Param: PExpressionRec); procedure FuncStrI_LT(Param: PExpressionRec); procedure FuncStrI_GT(Param: PExpressionRec); procedure FuncStrI_LTE(Param: PExpressionRec); procedure FuncStrI_GTE(Param: PExpressionRec); -procedure FuncStrP_EQ(Param: PExpressionRec); procedure FuncStr_EQ(Param: PExpressionRec); procedure FuncStr_NEQ(Param: PExpressionRec); procedure FuncStr_LT(Param: PExpressionRec); @@ -236,6 +246,40 @@ var implementation +procedure LinkVariable(ExprRec: PExpressionRec); +begin + with ExprRec^ do + begin + if ExprWord.IsVariable then + begin + // copy pointer to variable + Args[0] := ExprWord.AsPointer; + // is this a fixed length string variable? + if ExprWord.FixedLen >= 0 then + begin + // store length as second parameter + Args[1] := PChar(ExprWord.LenAsPointer); + end; + end; + end; +end; + +procedure LinkVariables(ExprRec: PExpressionRec); +var + I: integer; +begin + with ExprRec^ do + begin + I := 0; + while (I < MaxArg) and (ArgList[I] <> nil) do + begin + LinkVariables(ArgList[I]); + Inc(I); + end; + end; + LinkVariable(ExprRec); +end; + { TCustomExpressionParser } constructor TCustomExpressionParser.Create; @@ -288,6 +332,7 @@ begin ExprTree := MakeTree(ExpColl, 0, ExpColl.Count - 1); FCurrentRec := nil; CheckArguments(ExprTree); + LinkVariables(ExprTree); if Optimize then RemoveConstants(ExprTree); // all constant expressions are evaluated and replaced by variables @@ -309,15 +354,44 @@ end; procedure TCustomExpressionParser.CheckArguments(ExprRec: PExpressionRec); var TempExprWord: TExprWord; - I, error: Integer; + I, error, firstFuncIndex, funcIndex: Integer; foundAltFunc: Boolean; -begin - with ExprRec^ do + + procedure FindAlternate; begin - repeat - I := 0; - error := 0; - foundAltFunc := false; + // see if we can find another function + if funcIndex < 0 then + begin + firstFuncIndex := FWordsList.IndexOf(ExprRec^.ExprWord); + funcIndex := firstFuncIndex; + end; + // check if not last function + if (0 <= funcIndex) and (funcIndex < FWordsList.Count - 1) then + begin + inc(funcIndex); + TempExprWord := TExprWord(FWordsList.Items[funcIndex]); + if FWordsList.Compare(FWordsList.KeyOf(ExprRec^.ExprWord), FWordsList.KeyOf(TempExprWord)) = 0 then + begin + ExprRec^.ExprWord := TempExprWord; + ExprRec^.Oper := ExprRec^.ExprWord.ExprFunc; + foundAltFunc := true; + end; + end; + end; + + procedure InternalCheckArguments; + begin + I := 0; + error := 0; + foundAltFunc := false; + with ExprRec^ do + begin + if WantsFunction <> (ExprWord.IsFunction and not ExprWord.IsOperator) then + begin + error := 4; + exit; + end; + while (I < ExprWord.MaxFunctionArg) and (ArgList[I] <> nil) and (error = 0) do begin // test subarguments first @@ -338,33 +412,38 @@ begin // test if too many parameters passed if (error = 0) and (I > ExprWord.MaxFunctionArg) then error := 3; - - // error occurred? - if error <> 0 then - begin - // see if we can find another function - I := FWordsList.IndexOf(ExprWord); - // check if not last function - if I < FWordsList.Count - 1 then - begin - TempExprWord := TExprWord(FWordsList.Items[I+1]); - if FWordsList.Compare(FWordsList.KeyOf(ExprWord), FWordsList.KeyOf(TempExprWord)) = 0 then - begin - ExprWord := TempExprWord; - Oper := ExprWord.ExprFunc; - foundAltFunc := true; - end; - end; - end; - until (error = 0) or not foundAltFunc; - - // fatal error? - case error of - 1: raise EParserException.Create('Function or operand has too few arguments'); - 2: raise EParserException.Create('Argument type mismatch'); - 3: raise EParserException.Create('Function or operand has too many arguments'); end; end; + +begin + funcIndex := -1; + repeat + InternalCheckArguments; + + // error occurred? + if error <> 0 then + FindAlternate; + until (error = 0) or not foundAltFunc; + + // maybe it's an undefined variable + if (error <> 0) and not ExprRec^.WantsFunction and (firstFuncIndex >= 0) then + begin + HandleUnknownVariable(ExprRec^.ExprWord.Name); + { must not add variable as first function in this set of duplicates, + otherwise following searches will not find it } + FWordsList.Exchange(firstFuncIndex, firstFuncIndex+1); + ExprRec^.ExprWord := TExprWord(FWordsList.Items[firstFuncIndex+1]); + ExprRec^.Oper := ExprRec^.ExprWord.ExprFunc; + InternalCheckArguments; + end; + + // fatal error? + case error of + 1: raise EParserException.Create('Function or operand has too few arguments'); + 2: raise EParserException.Create('Argument type mismatch'); + 3: raise EParserException.Create('Function or operand has too many arguments'); + 4: raise EParserException.Create('No function with this name, remove brackets for variable'); + end; end; function TCustomExpressionParser.ResultCanVary(ExprRec: PExpressionRec): @@ -377,7 +456,7 @@ begin Result := ExprWord.CanVary; if not Result then for I := 0 to ExprWord.MaxFunctionArg - 1 do - if ResultCanVary(ArgList[I]) then + if (ArgList[I] <> nil) and ResultCanVary(ArgList[I]) then begin Result := true; Exit; @@ -610,17 +689,6 @@ begin begin Result^.ExprWord := TExprWord(Expr.Items[FirstItem]); Result^.Oper := Result^.ExprWord.ExprFunc; - if Result^.ExprWord.IsVariable then - begin - // copy pointer to variable - Result^.Args[0] := Result^.ExprWord.AsPointer; - // is this a fixed length string variable? - if Result^.ExprWord.FixedLen >= 0 then - begin - // store length as second parameter - Result^.Args[1] := PChar(Result^.ExprWord.LenAsPointer); - end; - end; exit; end; @@ -664,6 +732,7 @@ begin // save function Result^.ExprWord := TExprWord(Expr.Items[FirstItem]); Result^.Oper := Result^.ExprWord.ExprFunc; + Result^.WantsFunction := true; // parse function arguments IEnd := FirstItem + 1; IStart := IEnd; @@ -979,9 +1048,8 @@ begin if (TExprWord(Items[I]).IsVariable) and ((I < Count - 1) and (TExprWord(Items[I + 1]).IsVariable)) then raise EParserException.Create('Missing operator between '''+TExprWord(Items[I]).Name+''' and '''+TExprWord(Items[I]).Name+''''); - if (TExprWord(Items[I]).ResultType = etLeftBracket) and ((I >= Count - 1) or - (TExprWord(Items[I + 1]).ResultType = etRightBracket)) then - raise EParserException.Create('Empty brackets ()'); + if (TExprWord(Items[I]).ResultType = etLeftBracket) and (I >= Count - 1) then + raise EParserException.Create('Missing closing bracket'); if (TExprWord(Items[I]).ResultType = etRightBracket) and ((I < Count - 1) and (TExprWord(Items[I + 1]).ResultType = etLeftBracket)) then raise EParserException.Create('Missing operator between )('); @@ -1070,12 +1138,7 @@ end; function TCustomExpressionParser.DefineStringVariable(AVarName: string; AValue: PPChar): TExprWord; begin - Result := DefineStringVariableFixedLen(AVarName, AValue, -1); -end; - -function TCustomExpressionParser.DefineStringVariableFixedLen(AVarName: string; AValue: PPChar; ALength: Integer): TExprWord; -begin - Result := TStringVariable.Create(AVarName, AValue, ALength); + Result := TStringVariable.Create(AVarName, AValue); FWordsList.Add(Result); end; @@ -1114,6 +1177,7 @@ begin New(Result); Result^.Oper := nil; Result^.AuxData := nil; + Result^.WantsFunction := false; for I := 0 to MaxArg - 1 do begin Result^.Args[I] := nil; @@ -1238,7 +1302,7 @@ begin end; end; -procedure FuncIntToStr_Gen(Param: PExpressionRec; Val: Integer); +procedure FuncIntToStr_Gen(Param: PExpressionRec; Val: {$ifdef SUPPORT_INT64}Int64{$else}Integer{$endif}); var width: Integer; begin @@ -1249,7 +1313,12 @@ begin begin // convert to string width := PInteger(Args[1])^; - GetStrFromInt_Width(Val, width, Res.MemoryPos^, #32); +{$ifdef SUPPORT_INT64} + GetStrFromInt64_Width +{$else} + GetStrFromInt_Width +{$endif} + (Val, width, Res.MemoryPos^, #32); // advance pointer Inc(Res.MemoryPos^, width); // need to add decimal? @@ -1267,7 +1336,13 @@ begin end; end else begin // convert to string - width := GetStrFromInt(Val, Res.MemoryPos^); + width := +{$ifdef SUPPORT_INT64} + GetStrFromInt64 +{$else} + GetStrFromInt +{$endif} + (Val, Res.MemoryPos^); // advance pointer Inc(Param^.Res.MemoryPos^, width); end; @@ -1281,6 +1356,15 @@ begin FuncIntToStr_Gen(Param, PInteger(Param^.Args[0])^); end; +{$ifdef SUPPORT_INT64} + +procedure FuncInt64ToStr(Param: PExpressionRec); +begin + FuncIntToStr_Gen(Param, PInt64(Param^.Args[0])^); +end; + +{$endif} + procedure FuncDateToStr(Param: PExpressionRec); var TempStr: string; @@ -1302,11 +1386,14 @@ begin begin srcLen := StrLen(Args[0]); index := PInteger(Args[1])^ - 1; - count := PInteger(Args[2])^; - if index + count <= srcLen then - Res.Append(Args[0]+index, count) - else - Res.MemoryPos^^ := #0; + if Args[2] <> nil then + begin + count := PInteger(Args[2])^; + if index + count > srcLen then + count := srcLen - index; + end else + count := srcLen - index; + Res.Append(Args[0]+index, count) end; end; diff --git a/fcl/db/dbase/dbf_prsdef.pas b/fcl/db/dbase/dbf_prsdef.pas index 623fe714d9..ec6700f027 100644 --- a/fcl/db/dbase/dbf_prsdef.pas +++ b/fcl/db/dbase/dbf_prsdef.pas @@ -25,6 +25,10 @@ type EParserException = class(Exception); PExpressionRec = ^TExpressionRec; PDynamicType = ^TDynamicType; + PDateTimeRec = ^TDateTimeRec; +{$ifdef SUPPORT_INT64} + PLargeInt = ^Int64; +{$endif} TExprWord = class; @@ -58,7 +62,8 @@ type Res: TDynamicType; ExprWord: TExprWord; AuxData: pointer; - ResetDest: Boolean; + ResetDest: boolean; + WantsFunction: boolean; Args: array[0..MaxArg-1] of PChar; ArgsPos: array[0..MaxArg-1] of PChar; ArgsSize: array[0..MaxArg-1] of Integer; @@ -107,6 +112,7 @@ type function GetDescription: string; virtual; function GetTypeSpec: string; virtual; function GetShortName: string; virtual; + procedure SetFixedLen(NewLen: integer); virtual; public constructor Create(AName: string; AExprFunc: TExprFunc); @@ -119,7 +125,7 @@ type property CanVary: Boolean read GetCanVary; property IsVariable: Boolean read GetIsVariable; property NeedsCopy: Boolean read GetNeedsCopy; - property FixedLen: Integer read GetFixedLen; + property FixedLen: Integer read GetFixedLen write SetFixedLen; property ResultType: TExpressionType read GetResultType; property MinFunctionArg: Integer read GetMinFunctionArg; property MaxFunctionArg: Integer read GetMaxFunctionArg; @@ -235,8 +241,9 @@ type FFixedLen: Integer; protected function GetFixedLen: Integer; override; + procedure SetFixedLen(NewLen: integer); override; public - constructor Create(AName: string; AValue: PPChar; AFixedLen: Integer); + constructor Create(AName: string; AValue: PPChar); function LenAsPointer: PInteger; override; function AsPointer: PChar; override; @@ -379,15 +386,16 @@ begin end; procedure _StringVariable(Param: PExpressionRec); +var + length: integer; begin with Param^ do - Res.Append(PPChar(Args[0])^, StrLen(PPChar(Args[0])^)); -end; - -procedure _StringVariableFixedLen(Param: PExpressionRec); -begin - with Param^ do - Res.Append(PPChar(Args[0])^, PInteger(Args[1])^); + begin + length := PInteger(Args[1])^; + if length = -1 then + length := StrLen(PPChar(Args[0])^); + Res.Append(PPChar(Args[0])^, length); + end; end; procedure _DateTimeVariable(Param: PExpressionRec); @@ -454,7 +462,6 @@ begin // fpc simply returns pointer to function, no '@' needed Result := (@FExprFunc = @_StringVariable) or (@FExprFunc = @_StringConstant) or - (@FExprFunc = @_StringVariableFixedLen) or (@FExprFunc = @_FloatVariable) or (@FExprFunc = @_IntegerVariable) or // (FExprFunc = @_SmallIntVariable) or @@ -524,6 +531,10 @@ begin Result := False; end; +procedure TExprWord.SetFixedLen(NewLen: integer); +begin +end; + { TConstant } constructor TConstant.Create(AName: string; AVarType: TExpressionType; AExprFunc: TExprFunc); @@ -659,17 +670,14 @@ end; { TStringVariable } -constructor TStringVariable.Create(AName: string; AValue: PPChar; AFixedLen: Integer); +constructor TStringVariable.Create(AName: string; AValue: PPChar); begin // variable or fixed length? - if (AFixedLen < 0) then - inherited Create(AName, etString, _StringVariable) - else - inherited Create(AName, etString, _StringVariableFixedLen); + inherited Create(AName, etString, _StringVariable); // store pointer to string FValue := AValue; - FFixedLen := AFixedLen; + FFixedLen := -1; end; function TStringVariable.AsPointer: PChar; @@ -687,6 +695,11 @@ begin Result := @FFixedLen; end; +procedure TStringVariable.SetFixedLen(NewLen: integer); +begin + FFixedLen := NewLen; +end; + { TDateTimeVariable } constructor TDateTimeVariable.Create(AName: string; AValue: PDateTimeRec); diff --git a/fcl/db/dbase/dbf_prssupp.pas b/fcl/db/dbase/dbf_prssupp.pas index f684295798..82fbb9681e 100644 --- a/fcl/db/dbase/dbf_prssupp.pas +++ b/fcl/db/dbase/dbf_prssupp.pas @@ -51,51 +51,15 @@ type function GetStrFromInt(Val: Integer; const Dst: PChar): Integer; procedure GetStrFromInt_Width(Val: Integer; const Width: Integer; const Dst: PChar; const PadChar: Char); +{$ifdef SUPPORT_INT64} +function GetStrFromInt64(Val: Int64; const Dst: PChar): Integer; +procedure GetStrFromInt64_Width(Val: Int64; const Width: Integer; const Dst: PChar; const PadChar: Char); +{$endif} implementation uses SysUtils; -// it seems there is no pascal function to convert an integer into a PChar??? -// NOTE: in dbf_dbffile.pas there is also a convert routine, but is slightly different - -function GetStrFromInt(Val: Integer; const Dst: PChar): Integer; -var - Temp: array[0..10] of Char; - I, J: Integer; -begin - Val := Abs(Val); - // we'll have to store characters backwards first - I := 0; - J := 0; - repeat - Temp[I] := Chr((Val mod 10) + Ord('0')); - Val := Val div 10; - Inc(I); - until Val = 0; - - // remember number of digits - Result := I; - // copy value, remember: stored backwards - repeat - Dst[J] := Temp[I-1]; - Inc(J); - Dec(I); - until I = 0; - // done! -end; - -// it seems there is no pascal function to convert an integer into a PChar??? - -procedure GetStrFromInt_Width(Val: Integer; const Width: Integer; const Dst: PChar; const PadChar: Char); -var - Temp: array[0..10] of Char; - I, J: Integer; - NegSign: boolean; -begin - {$I getstrfromint.inc} -end; - destructor TOCollection.Destroy; begin FreeAll; @@ -193,7 +157,7 @@ function TSortedCollection.Search(Key: Pointer; var Index: Integer): Boolean; var L, H, I, C: Integer; begin - Search := False; + Result := false; L := 0; H := Count - 1; while L <= H do @@ -202,11 +166,9 @@ begin C := Compare(KeyOf(Items[I]), Key); if C < 0 then L := I + 1 - else - begin + else begin H := I - 1; - if C = 0 then - Search := True; + Result := C = 0; end; end; Index := L; @@ -224,5 +186,84 @@ begin StrDispose(Item); end; +// it seems there is no pascal function to convert an integer into a PChar??? +// NOTE: in dbf_dbffile.pas there is also a convert routine, but is slightly different + +function GetStrFromInt(Val: Integer; const Dst: PChar): Integer; +var + Temp: array[0..10] of Char; + I, J: Integer; +begin + Val := Abs(Val); + // we'll have to store characters backwards first + I := 0; + J := 0; + repeat + Temp[I] := Chr((Val mod 10) + Ord('0')); + Val := Val div 10; + Inc(I); + until Val = 0; + + // remember number of digits + Result := I; + // copy value, remember: stored backwards + repeat + Dst[J] := Temp[I-1]; + Inc(J); + Dec(I); + until I = 0; + // done! +end; + +// it seems there is no pascal function to convert an integer into a PChar??? + +procedure GetStrFromInt_Width(Val: Integer; const Width: Integer; const Dst: PChar; const PadChar: Char); +var + Temp: array[0..10] of Char; + I, J: Integer; + NegSign: boolean; +begin + {$I getstrfromint.inc} +end; + +{$ifdef SUPPORT_INT64} + +procedure GetStrFromInt64_Width(Val: Int64; const Width: Integer; const Dst: PChar; const PadChar: Char); +var + Temp: array[0..19] of Char; + I, J: Integer; + NegSign: boolean; +begin + {$I getstrfromint.inc} +end; + +function GetStrFromInt64(Val: Int64; const Dst: PChar): Integer; +var + Temp: array[0..19] of Char; + I, J: Integer; +begin + Val := Abs(Val); + // we'll have to store characters backwards first + I := 0; + J := 0; + repeat + Temp[I] := Chr((Val mod 10) + Ord('0')); + Val := Val div 10; + Inc(I); + until Val = 0; + + // remember number of digits + Result := I; + // copy value, remember: stored backwards + repeat + Dst[J] := Temp[I-1]; + inc(J); + dec(I); + until I = 0; + // done! +end; + +{$endif} + end. diff --git a/fcl/db/dbase/dbf_wtil.pas b/fcl/db/dbase/dbf_wtil.pas index 7f9d611666..cfe8b3111f 100644 --- a/fcl/db/dbase/dbf_wtil.pas +++ b/fcl/db/dbase/dbf_wtil.pas @@ -4,7 +4,7 @@ unit dbf_wtil; interface -{$ifndef WIN32} +{$ifndef WINDOWS} uses {$ifdef FPC} BaseUnix, @@ -270,7 +270,7 @@ procedure SetLastError(Value: Integer); implementation -{$ifndef WIN32} +{$ifndef WINDOWS} {$ifdef FPC} uses unix; diff --git a/fcl/db/dbase/history.txt b/fcl/db/dbase/history.txt index 2d37c5a2bb..3961ff072d 100644 --- a/fcl/db/dbase/history.txt +++ b/fcl/db/dbase/history.txt @@ -33,11 +33,31 @@ BUGS & WARNINGS ------------------------ -V6.4.9 +V6.9.1 +- fix last memo field getting truncated (patch by dhdorrough) +- add dbf_collate unit to the packages +- fix index result too long bug + +------------------------ +V6.9.0 + +- BDE compatible index collation: MDX/NDXes have to be rebuilt! + (thx sstewart for generating collation tables) - fix use long char fields check icw foxpro (thx rpoverdijk) - fix TDbf.GetRecNo AV when no file open - remove UseFloatFields, delphi 3 will use float fields, others not +- fix size/precision truncation when opening foxpro B-type fields (thx nring) +- foxbase memo is 10 character index, sizes 4 and 10 are valid (thx majky) +- add int64 to string conversion in expression parser function STR +- fix nativeformat for tdbf.getfielddata(A,B) users +- allow later defined expression variables to have same name as + already defined function +- third parameter in substr function is optional now +- expression parser distinguishes between function() and variable, =no brackets +- updated bcb 4 packages files from troy dalton +- fix write blob B-type field for non-foxpro (thx leexgone) +- fix win64 compatibility ------------------------