* update tdbf to tdbf svn

git-svn-id: trunk@5622 -

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;

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}

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);

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), 

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;

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;
 

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;

fcl/db/dbase/dbf_lang.pas

@@ -5,7 +5,7 @@ unit dbf_lang;
 interface
 
 uses
-{$ifdef WIN32}
+{$ifdef WINDOWS}
   Windows;
 {$else}
 {$ifdef KYLIX}

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)

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,50 +180,61 @@ begin
   FFieldName := UseFieldDef.FieldName;
 end;
 
-//--TStringFieldVar-------------------------------------------------------------
-function TStringFieldVar.GetFieldVal: Pointer;
+//--TStringFieldVar---------------------------------------------------------
+constructor TStringFieldVar.Create(UseFieldDef: TDbfFieldDef; ADbfFile: TDbfFile);
 begin
-  Result := @FFieldVal;
+  inherited;
 end;
 
-function TStringFieldVar.GetFieldType: TExpressionType;
+destructor TStringFieldVar.Destroy;
 begin
-  Result := etString;
-end;
+  if not FRawStringField then
+    FreeMem(FFieldVal);
 
-//--TRawStringFieldVar----------------------------------------------------------
-procedure TRawStringFieldVar.Refresh(Buffer: PChar);
-begin
-  FFieldVal := Buffer + FieldDef.Offset;
+  inherited;
 end;
 
-//--TAnsiStringFieldVar---------------------------------------------------------
-constructor TAnsiStringFieldVar.Create(UseFieldDef: TDbfFieldDef; ADbfFile: TDbfFile);
+function TStringFieldVar.GetFieldVal: Pointer;
 begin
-  inherited;
-
-  GetMem(FFieldVal, UseFieldDef.Size+1);
+  Result := @FFieldVal;
 end;
 
-destructor TAnsiStringFieldVar.Destroy;
+function TStringFieldVar.GetFieldType: TExpressionType;
 begin
-  FreeMem(FFieldVal);
-
-  inherited;
+  Result := etString;
 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.
 

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}

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,32 +412,37 @@ begin
       // test if too many parameters passed
       if (error = 0) and (I > ExprWord.MaxFunctionArg) then
         error := 3;
+    end;
+  end;
 
-      // 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;
+begin
+  funcIndex := -1;
+  repeat
+    InternalCheckArguments;
 
-    // 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;
+    // 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;
 
@@ -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;
 

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);

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.
 

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;

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
 
 
 ------------------------