* update tdbf to 6.9.2

git-svn-id: trunk@8883 -

packages/fcl-db/src/dbase/dbf.pas

@@ -257,7 +257,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); 
+    procedure SetFieldData(Field: TField; Buffer: Pointer);
       {$ifdef SUPPORT_OVERLOAD} overload; {$endif} override; {virtual abstract}
 
     { virtual methods (mostly optionnal) }
@@ -300,10 +300,10 @@ type
 {$endif}
 
 {$ifdef SUPPORT_OVERLOAD}
-    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  GetFieldData(Field: TField; Buffer: Pointer; NativeFormat: Boolean): Boolean;
+      {$ifdef SUPPORT_BACKWARD_FIELDDATA} overload; override; {$else} reintroduce; overload; {$endif}
+    procedure SetFieldData(Field: TField; Buffer: Pointer; NativeFormat: Boolean);
+      {$ifdef SUPPORT_BACKWARD_FIELDDATA} overload; override; {$else} reintroduce; overload; {$endif}
 {$endif}
 
     function CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Integer; override;
@@ -440,8 +440,10 @@ type
     property AfterCancel;
     property BeforeDelete;
     property AfterDelete;
+{$ifdef SUPPORT_REFRESHEVENTS}    
     property BeforeRefresh;
     property AfterRefresh;
+{$endif}    
     property BeforeScroll;
     property AfterScroll;
     property OnCalcFields;
@@ -2223,7 +2225,7 @@ begin
     begin
       FParser := TDbfParser.Create(FDbfFile);
       // we need truncated, translated (to ANSI) strings
-      FParser.RawStringFields := false;
+      FParser.StringFieldMode := smAnsiTrim;
     end;
     // have a parser now?
     if FParser <> nil then

packages/fcl-db/src/dbase/dbf_avl.pas

@@ -38,7 +38,7 @@ type
     FOnDelete: TAvlTreeEvent;
     FHeightChange: Boolean;
 
-    procedure InternalInsert(X: PNode; var P: PNode);
+    function  InternalInsert(X: PNode; var P: PNode): Boolean;
     procedure InternalDelete(X: TKeyType; var P: PNode);
 
     procedure DeleteNode(X: PNode);
@@ -49,7 +49,7 @@ type
 
     procedure Clear;
     function  Find(Key: TKeyType): TExtraData;
-    procedure Insert(Key: TKeyType; Extra: TExtraData);
+    function  Insert(Key: TKeyType; Extra: TExtraData): Boolean;
     procedure Delete(Key: TKeyType);
 
     function  Lowest: PData;
@@ -271,7 +271,7 @@ begin
     Result := nil;
 end;
 
-procedure TAvlTree.Insert(Key: TKeyType; Extra: TExtraData);
+function TAvlTree.Insert(Key: TKeyType; Extra: TExtraData): boolean;
 var
   H: PNode;
 begin
@@ -286,7 +286,9 @@ begin
     Bal := 0;
   end;
   // insert new node
-  InternalInsert(H, FRoot);
+  Result := InternalInsert(H, FRoot);
+  if not Result then
+    Dispose(H);
   // check tree
 //  assert(CheckTree(FRoot));
 end;
@@ -297,15 +299,19 @@ begin
 //  assert(CheckTree(FRoot));
 end;
 
-procedure TAvlTree.InternalInsert(X: PNode; var P: PNode);
+function TAvlTree.InternalInsert(X: PNode; var P: PNode): boolean;
 begin
-  if P = nil
-  then begin P := X; Inc(FCount); FHeightChange := true end
-  else
+  if P = nil then 
+  begin 
+    P := X; 
+    Inc(FCount); 
+    FHeightChange := true;
+    Result := true;
+  end else begin
     if X^.Data.ID < P^.Data.ID then
     begin
       { less }
-      InternalInsert(X, P^.Left);
+      Result := InternalInsert(X, P^.Left);
       if FHeightChange then {Left branch has grown higher}
         case P^.Bal of
           1: begin P^.Bal := 0; FHeightChange := false end;
@@ -338,7 +344,7 @@ begin
     if X^.Data.ID > P^.Data.ID then
     begin
       { greater }
-      InternalInsert(X, P^.Right);
+      Result := InternalInsert(X, P^.Right);
       if FHeightChange then {Right branch has grown higher}
         case P^.Bal of
           -1: begin P^.Bal := 0; FHeightChange := false end;
@@ -370,8 +376,9 @@ begin
     end {greater} else begin
       {X already present; do not insert again}
       FHeightChange := false;
+      Result := false;
     end;
-
+  end;
 //  assert(CheckTree(P));
 end;{InternalInsert}
 

packages/fcl-db/src/dbase/dbf_collate.pas

@@ -1,4 +1,4 @@
-unit Dbf_Collate;
+unit dbf_collate;
 
 {$i dbf_common.inc}
 
@@ -763,7 +763,7 @@ const
   db866ru0 :PCollationTable = @_db866ru0;
 
 
-
+{$ifdef USE_BORLAND_COLLATION_TABLES}
 
   // BLLT1DA0    64770
 
@@ -926,7 +926,7 @@ const
   );
   BLLT1NO0 :PCollationTable = @_BLLT1NO0;
 
-
+{$endif}
 
 
   // DB850US0      Checksum: 43413
@@ -954,7 +954,7 @@ const
 
 
 
-  {$IFDEF PARADOX_COLLATIONS}
+{$ifdef USE_PARADOX_COLLATIONS}
 
   // intl850    43039
 
@@ -978,12 +978,6 @@ const
   );
   intl850 :PCollationTable = @_intl850;
 
-  {$ENDIF}
-
-
-
-
-  {$IFDEF PARADOX_COLLATIONS}
 
   // SPANISH    20109
 
@@ -1007,12 +1001,10 @@ const
   );
   SPANISH :PCollationTable = @_SPANISH;
 
-  {$ENDIF}
 
 
 
 
-  {$IFDEF PARADOX_COLLATIONS}
 
   // iceland    23936
 
@@ -1036,12 +1028,10 @@ const
   );
   iceland :PCollationTable = @_iceland;
 
-  {$ENDIF}
 
 
 
 
-  {$IFDEF PARADOX_COLLATIONS}
 
   // ANSIINTL    58462
 
@@ -1065,12 +1055,10 @@ const
   );
   ANSIINTL :PCollationTable = @_ANSIINTL;
 
-  {$ENDIF}
 
 
 
 
-  {$IFDEF PARADOX_COLLATIONS}
 
   // ANSII850    29000
 
@@ -1094,12 +1082,10 @@ const
   );
   ANSII850 :PCollationTable = @_ANSII850;
 
-  {$ENDIF}
 
 
 
 
-  {$IFDEF PARADOX_COLLATIONS}
 
   // ANSISPAN    33308
 
@@ -1123,12 +1109,10 @@ const
   );
   ANSISPAN :PCollationTable = @_ANSISPAN;
 
-  {$ENDIF}
 
 
 
 
-  {$IFDEF PARADOX_COLLATIONS}
 
   // ANSISWFN    44782
 
@@ -1152,12 +1136,10 @@ const
   );
   ANSISWFN :PCollationTable = @_ANSISWFN;
 
-  {$ENDIF}
 
 
 
 
-  {$IFDEF PARADOX_COLLATIONS}
 
   // ANSINOR4    55290
 
@@ -1181,7 +1163,7 @@ const
   );
   ANSINOR4 :PCollationTable = @_ANSINOR4;
 
-  {$ENDIF}
+{$endif}
 
 
 
@@ -1206,11 +1188,6 @@ const
     096, 097, 098, 099, 100, 101, 102, 103, 104, 105, 106, 107, 108, 109, 110, 111,
     112, 113, 114, 115, 116, 117, 118, 119, 120, 121, 122, 123, 124, 125, 126, 127
   );
-  china :PCollationTable = @_china;
-
-  korea :PCollationTable = @_china;
-
-  taiwan :PCollationTable = @_china;
 
   DB936CN0 :PCollationTable = @_china;
 
@@ -1241,7 +1218,16 @@ const
     247, 248, 249, 250, 251, 195, 196, 176, 177, 178, 179, 180, 181, 182, 197, 198, 
     199, 200, 201, 202, 203, 204, 205, 206, 207, 208, 209, 210, 252, 253, 254, 255
   );
+
+{$ifdef USE_PARADOX_COLLATIONS}
+  china :PCollationTable = @_china;
+
+  korea :PCollationTable = @_china;
+
+  taiwan :PCollationTable = @_china;
+
   thai :PCollationTable = @_thai;
+{$endif}
 
   db874th0 :PCollationTable = @_thai;
 
@@ -1298,7 +1284,7 @@ const
   DBWINES0 :PCollationTable = @_DBWINWE0;
 
 
-
+{$ifdef USE_ACCESS_COLLATIONS}
 
   // ACCGEN    19621
 
@@ -1372,7 +1358,7 @@ const
   );
   ACCSWFIN :PCollationTable = @_ACCSWFIN;
 
-
+{$endif}
 
 
   // FOXDE437      Checksum: 21075
@@ -1500,7 +1486,7 @@ const
 
 
 
-  {$IFDEF PARADOX_COLLATIONS}
+{$ifdef USE_PARADOX_COLLATIONS}
 
   // czech    30844
 
@@ -1531,7 +1517,6 @@ const
 
   czechw :PCollationTable = @_czech;
 
-  {$ENDIF}
 
 
 
@@ -1561,7 +1546,6 @@ const
 
 
 
-  {$IFDEF PARADOX_COLLATIONS}
 
   // polish    59020
 
@@ -1585,12 +1569,10 @@ const
   );
   polish :PCollationTable = @_polish;
 
-  {$ENDIF}
 
 
 
 
-  {$IFDEF PARADOX_COLLATIONS}
 
   // cyrr    20081
 
@@ -1614,12 +1596,10 @@ const
   );
   cyrr :PCollationTable = @_cyrr;
 
-  {$ENDIF}
 
 
 
 
-  {$IFDEF PARADOX_COLLATIONS}
 
   // hun852dc    62898
 
@@ -1643,7 +1623,7 @@ const
   );
   hun852dc :PCollationTable = @_hun852dc;
 
-  {$ENDIF}
+{$endif}
 
 
 
@@ -1668,7 +1648,6 @@ const
     180, 149, 154, 157, 160, 161, 168, 176, 175, 181, 118, 123, 126, 129, 136, 142, 
     147, 241, 242, 243, 244, 245, 246, 247, 248, 249, 250, 251, 252, 253, 254, 255
   );
-  grcp437 :PCollationTable = @_grcp437;
 
   db437gr0 :PCollationTable = @_grcp437;
 
@@ -1697,7 +1676,6 @@ const
   );
   dbhebrew :PCollationTable = @_dbhebrew;
 
-  Hebrew :PCollationTable = @_dbhebrew;
 
 
 
@@ -1722,10 +1700,15 @@ const
     142, 158, 143, 133, 130, 131, 163, 162, 153, 177, 150, 178, 187, 189, 166, 242, 
     243, 244, 245, 246, 247, 248, 249, 250, 251, 252, 253, 173, 154, 151, 254, 255
   );
-  slovene :PCollationTable = @_slovene;
-
   db852sl0 :PCollationTable = @_slovene;
 
+{$ifdef USE_PARADOX_COLLATIONS}
+  grcp437 :PCollationTable = @_grcp437;
+
+  hebrew :PCollationTable = @_dbhebrew;
+
+  slovene :PCollationTable = @_slovene;
+{$endif}
 
 
 
@@ -1790,6 +1773,7 @@ const
 
 
 
+  {$IFDEF PARADOX_COLLATIONS}
 
   // cskamenw    40577
 
@@ -1815,6 +1799,8 @@ const
 
   cskamen :PCollationTable = @_cskamenw;
 
+  {$ENDIF}
+
 
 
 
@@ -1904,6 +1890,7 @@ const
 
 
 
+  {$IFDEF PARADOX_COLLATIONS}
 
   // angreek1    39126
 
@@ -1929,8 +1916,9 @@ const
 
   ACCGREEK :PCollationTable = @_angreek1;
 
+  {$ENDIF}
 
-
+  {$IFDEF PARADOX_COLLATIONS}
 
   // ansislov    61480
 
@@ -1954,8 +1942,11 @@ const
   );
   ansislov :PCollationTable = @_ansislov;
 
+  {$ENDIF}
+
 
 
+  {$IFDEF USE_PARADOX_COLLATIONS}
 
   // ANTURK    24004
 
@@ -1979,6 +1970,7 @@ const
   );
   ANTURK :PCollationTable = @_ANTURK;
 
+  {$ENDIF}
 
 
 
@@ -2056,6 +2048,7 @@ const
 
 
 
+  {$IFDEF USE_ACCESS_COLLATIONS}
 
   // BLROM800    28847
 
@@ -2079,8 +2072,10 @@ const
   );
   BLROM800 :PCollationTable = @_BLROM800;
 
+  {$ENDIF}
 
 
+  {$IFDEF USE_ORACLE_COLLATIONS}
 
   // ORAWE850    31378
 
@@ -2104,8 +2099,11 @@ const
   );
   ORAWE850 :PCollationTable = @_ORAWE850 ;
 
+  {$ENDIF}
+
 
 
+  {$IFDEF USE_SYBASE_COLLATIONS}
 
   // SYDC850    46023
 
@@ -2154,8 +2152,10 @@ const
   );
   SYDC437 :PCollationTable = @_SYDC437;
 
+  {$ENDIF}
 
 
+  {$IFDEF USE_DB2_COLLATIONS}
 
   // db2andeu    8683
 
@@ -2179,6 +2179,8 @@ const
   );
   db2andeu :PCollationTable = @_db2andeu;
 
+  {$ENDIF}
+
 initialization
 
   InitialiseCollationTables;

packages/fcl-db/src/dbase/dbf_common.inc

@@ -144,16 +144,9 @@
   {$define DELPHI_3}
 {$endif}
 
-{$ifdef VER190} // Delphi 2007
+{$ifdef VER185} // Delphi 2007
   {$define DELPHI_2007}
-  {$define DELPHI_2006}
-  {$define DELPHI_2005}
-  {$define DELPHI_8}
-  {$define DELPHI_7}
-  {$define DELPHI_6}
-  {$define DELPHI_5}
-  {$define DELPHI_4}
-  {$define DELPHI_3}
+  { Delphi 2007 also defines VER180, so other DELPHI defines already done }
 {$endif}
 
 //-------------------------------------------------------
@@ -186,6 +179,7 @@
 
   {$define SUPPORT_BACKWARD_FIELDDATA}
   {$define SUPPORT_INITDEFSFROMFIELDS}
+  {$define SUPPORT_REFRESHEVENTS}
   {$define SUPPORT_DEF_DELETE}
   {$define SUPPORT_FREEANDNIL}
 
@@ -227,6 +221,7 @@
   {$define SUPPORT_MATH_UNIT}
   {$define SUPPORT_VARIANTS}
   {$define SUPPORT_SEPARATE_VARIANTS_UNIT}
+  {$define SUPPORT_REFRESHEVENTS}
 
   // FPC 2.0.x improvements
   {$ifdef VER2}

packages/fcl-db/src/dbase/dbf_common.pas

@@ -18,7 +18,7 @@ uses
 const
   TDBF_MAJOR_VERSION      = 6;
   TDBF_MINOR_VERSION      = 9;
-  TDBF_SUB_MINOR_VERSION  = 1;
+  TDBF_SUB_MINOR_VERSION  = 2;
 
   TDBF_TABLELEVEL_FOXPRO = 25;
 

packages/fcl-db/src/dbase/dbf_cursor.pas

@@ -18,11 +18,11 @@ type
     FFile: TPagedFile;
 
   protected
-    function GetPhysicalRecno: Integer; virtual; abstract;
-    function GetSequentialRecno: Integer; virtual; abstract;
+    function GetPhysicalRecNo: Integer; virtual; abstract;
+    function GetSequentialRecNo: Integer; virtual; abstract;
     function GetSequentialRecordCount: Integer; virtual; abstract;
-    procedure SetPhysicalRecno(Recno: Integer); virtual; abstract;
-    procedure SetSequentialRecno(Recno: Integer); virtual; abstract;
+    procedure SetPhysicalRecNo(RecNo: Integer); virtual; abstract;
+    procedure SetSequentialRecNo(RecNo: Integer); virtual; abstract;
 
   public
     constructor Create(pFile: TPagedFile);

packages/fcl-db/src/dbase/dbf_idxcur.pas

@@ -10,6 +10,9 @@ uses
   dbf_cursor,
   dbf_idxfile,
   dbf_prsdef,
+{$ifndef WINDOWS}
+  dbf_wtil,
+{$endif}
   dbf_common;
 
 type
@@ -27,6 +30,7 @@ type
     procedure SetPhysicalRecNo(RecNo: Integer); override;
     procedure SetSequentialRecNo(RecNo: Integer); override;
 
+    procedure VariantStrToBuffer(Key: Variant; ABuffer: PChar);
   public
     constructor Create(DbfIndexFile: TIndexFile);
     destructor Destroy; override;
@@ -55,6 +59,11 @@ type
 //====================================================================
 implementation
 
+{$ifdef WINDOWS}
+uses
+  Windows;
+{$endif}
+
 //==========================================================
 //============ TIndexCursor
 //==========================================================
@@ -128,10 +137,19 @@ end;
 
 {$ifdef SUPPORT_VARIANTS}
 
-function TIndexCursor.VariantToBuffer(Key: Variant; ABuffer: PChar): TExpressionType;
-// assumes ABuffer is large enough ie. at least max key size
+procedure TIndexCursor.VariantStrToBuffer(Key: Variant; ABuffer: PChar);
 var
   currLen: Integer;
+  StrKey: string;
+begin
+  StrKey := Key;
+  currLen := TranslateString(GetACP, FIndexFile.CodePage, PChar(StrKey), ABuffer, -1);
+  // we have null-terminated string, pad with spaces if string too short
+  FillChar(ABuffer[currLen], TIndexFile(PagedFile).KeyLen-currLen, ' ');
+end;
+
+function TIndexCursor.VariantToBuffer(Key: Variant; ABuffer: PChar): TExpressionType;
+// assumes ABuffer is large enough ie. at least max key size
 begin
   if (TIndexFile(PagedFile).KeyType='N') then
   begin
@@ -143,10 +161,7 @@ begin
     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, ' ');
+    VariantStrToBuffer(Key, ABuffer);
     Result := etString;
   end;
 end;

packages/fcl-db/src/dbase/dbf_idxfile.pas

@@ -409,6 +409,7 @@ uses
   dbf_fields,
   dbf_str,
   dbf_prssupp,
+  dbf_prscore,
   dbf_lang;
 
 const
@@ -1717,9 +1718,32 @@ end;
 { TDbfIndexParser }
 
 procedure TDbfIndexParser.ValidateExpression(AExpression: string);
+const
+  AnsiStrFuncs: array[0..13] of TExprFunc = (FuncUppercase, FuncLowercase, FuncStrI_EQ,
+    FuncStrIP_EQ, FuncStrI_NEQ, FuncStrI_LT, FuncStrI_GT, FuncStrI_LTE, FuncStrI_GTE,
+    FuncStrP_EQ, FuncStr_LT, FuncStr_GT, FuncStr_LTE, FuncStr_GTE);
+  AnsiFuncsToMode: array[boolean] of TStringFieldMode = (smRaw, smAnsi);
 var
+  TempRec: PExpressionRec;
   TempBuffer: pchar;
+  I: integer;
+  hasAnsiFuncs: boolean;
 begin
+  TempRec := CurrentRec;
+  hasAnsiFuncs := false;
+  while not hasAnsiFuncs and (TempRec <> nil) do
+  begin
+    for I := Low(AnsiStrFuncs) to High(AnsiStrFuncs) do
+      if @TempRec^.Oper = @AnsiStrFuncs[I] then
+      begin
+        hasAnsiFuncs := true;
+        break;
+      end;
+    TempRec := TempRec^.Next;
+  end;
+
+  StringFieldMode := AnsiFuncsToMode[hasAnsiFuncs];
+
   FResultLen := inherited ResultLen;
 
   if FResultLen = -1 then
@@ -2980,7 +3004,7 @@ function TIndexFile.ExtractKeyFromBuffer(Buffer: PChar): PChar;
 begin
   // execute expression to get key
   Result := PrepareKey(FCurrentParser.ExtractFromBuffer(Buffer), FCurrentParser.ResultType);
-  if not FCurrentParser.RawStringFields then
+  if FCurrentParser.StringFieldMode <> smRaw then
     TranslateString(GetACP, FCodePage, Result, Result, KeyLen);
 end;
 

packages/fcl-db/src/dbase/dbf_parser.pas

@@ -22,6 +22,8 @@ uses
 
 type
 
+  TStringFieldMode = (smRaw, smAnsi, smAnsiTrim);
+
   TDbfParser = class(TCustomExpressionParser)
   private
     FDbfFile: Pointer;
@@ -29,7 +31,7 @@ type
     FIsExpression: Boolean;       // expression or simple field?
     FFieldType: TExpressionType;
     FCaseInsensitive: Boolean;
-    FRawStringFields: Boolean;
+    FStringFieldMode: TStringFieldMode;
     FPartialMatch: boolean;
 
   protected
@@ -44,7 +46,7 @@ type
     function  GetResultLen: Integer;
 
     procedure SetCaseInsensitive(NewInsensitive: Boolean);
-    procedure SetRawStringFields(NewRawFields: Boolean);
+    procedure SetStringFieldMode(NewMode: TStringFieldMode);
     procedure SetPartialMatch(NewPartialMatch: boolean);
   public
     constructor Create(ADbfFile: Pointer);
@@ -60,7 +62,7 @@ type
     property ResultLen: Integer read GetResultLen;
 
     property CaseInsensitive: Boolean read FCaseInsensitive write SetCaseInsensitive;
-    property RawStringFields: Boolean read FRawStringFields write SetRawStringFields;
+    property StringFieldMode: TStringFieldMode read FStringFieldMode write SetStringFieldMode;
     property PartialMatch: boolean read FPartialMatch write SetPartialMatch;
   end;
 
@@ -106,20 +108,19 @@ type
   TStringFieldVar = class(TFieldVar)
   protected
     FFieldVal: PChar;
-    FRawStringField: boolean;
+    FMode: TStringFieldMode;
 
     function GetFieldVal: Pointer; override;
     function GetFieldType: TExpressionType; override;
     procedure SetExprWord(NewExprWord: TExprWord); override;
-    procedure SetRawStringField(NewRaw: boolean);
+    procedure SetMode(NewMode: TStringFieldMode);
     procedure UpdateExprWord;
   public
-    constructor Create(UseFieldDef: TDbfFieldDef; ADbfFile: TDbfFile);
     destructor Destroy; override;
 
     procedure Refresh(Buffer: PChar); override;
 
-    property RawStringField: boolean read FRawStringField write SetRawStringField;
+    property Mode: TStringFieldMode read FMode write SetMode;
   end;
 
   TFloatFieldVar = class(TFieldVar)
@@ -193,15 +194,9 @@ end;
 
 { TStringFieldVar }
 
-constructor TStringFieldVar.Create(UseFieldDef: TDbfFieldDef; ADbfFile: TDbfFile);
-begin
-  inherited;
-  FRawStringField := true;
-end;
-
 destructor TStringFieldVar.Destroy;
 begin
-  if not FRawStringField then
+  if FMode <> smRaw then
     FreeMem(FFieldVal);
 
   inherited;
@@ -223,11 +218,12 @@ var
   Src: PChar;
 begin
   Src := Buffer+FieldDef.Offset;
-  if not FRawStringField then
+  if FMode <> smRaw then
   begin
     // copy field data
     Len := FieldDef.Size;
-    while (Len >= 1) and (Src[Len-1] = ' ') do Dec(Len);
+    if FMode = smAnsiTrim then
+      while (Len >= 1) and (Src[Len-1] = ' ') do Dec(Len);
     // translate to ANSI
     Len := TranslateString(DbfFile.UseCodePage, GetACP, Src, FFieldVal, Len);
     FFieldVal[Len] := #0;
@@ -243,19 +239,21 @@ end;
 
 procedure TStringFieldVar.UpdateExprWord;
 begin
-  if FRawStringField then
+  if FMode <> smAnsiTrim then
     FExprWord.FixedLen := FieldDef.Size
   else
     FExprWord.FixedLen := -1;
 end;
 
-procedure TStringFieldVar.SetRawStringField(NewRaw: boolean);
+procedure TStringFieldVar.SetMode(NewMode: TStringFieldMode);
 begin
-  if NewRaw = FRawStringField then exit;
-  FRawStringField := NewRaw;
-  if NewRaw then
-    FreeMem(FFieldVal)
-  else
+  if NewMode = FMode then exit;
+  FMode := NewMode;
+  if NewMode = smRaw then
+  begin
+    FreeMem(FFieldVal);
+    FFieldVal := nil;
+  end else
     GetMem(FFieldVal, FieldDef.Size*3+1);
   UpdateExprWord;
 end;
@@ -361,7 +359,6 @@ begin
   FDbfFile := ADbfFile;
   FFieldVarList := TStringList.Create;
   FCaseInsensitive := true;
-  FRawStringFields := true;
   inherited Create;
 end;
 
@@ -391,7 +388,7 @@ begin
     etDateTime: Result := 8;
     etString:
     begin
-      if not FIsExpression and (TStringFieldVar(FFieldVarList.Objects[0]).RawStringField) then
+      if not FIsExpression and (TStringFieldVar(FFieldVarList.Objects[0]).Mode <> smAnsiTrim) then
         Result := TStringFieldVar(FFieldVarList.Objects[0]).FieldDef.Size
       else
         Result := -1;
@@ -421,17 +418,17 @@ begin
   end;
 end;
 
-procedure TDbfParser.SetRawStringFields(NewRawFields: Boolean);
+procedure TDbfParser.SetStringFieldMode(NewMode: TStringFieldMode);
 var
   I: integer;
 begin
-  if FRawStringFields <> NewRawFields then
+  if FStringFieldMode <> NewMode then
   begin
     // clear and regenerate functions, custom fields will be deleted too
-    FRawStringFields := NewRawFields;
+    FStringFieldMode := NewMode;
     for I := 0 to FFieldVarList.Count - 1 do
       if FFieldVarList.Objects[I] is TStringFieldVar then
-        TStringFieldVar(FFieldVarList.Objects[I]).RawStringField := NewRawFields;
+        TStringFieldVar(FFieldVarList.Objects[I]).Mode := NewMode;
   end;
 end;
 
@@ -486,7 +483,7 @@ begin
       begin
         TempFieldVar := TStringFieldVar.Create(FieldInfo, TDbfFile(FDbfFile));
         TempFieldVar.ExprWord := DefineStringVariable(VarName, TempFieldVar.FieldVal);
-        TStringFieldVar(TempFieldVar).RawStringField := FRawStringFields;
+        TStringFieldVar(TempFieldVar).Mode := FStringFieldMode;
       end;
     ftBoolean:
       begin

packages/fcl-db/src/dbase/dbf_prscore.pas

@@ -174,6 +174,8 @@ procedure FuncStrI_LT(Param: PExpressionRec);
 procedure FuncStrI_GT(Param: PExpressionRec);
 procedure FuncStrI_LTE(Param: PExpressionRec);
 procedure FuncStrI_GTE(Param: PExpressionRec);
+procedure FuncStrIP_EQ(Param: PExpressionRec);
+procedure FuncStrP_EQ(Param: PExpressionRec);
 procedure FuncStr_EQ(Param: PExpressionRec);
 procedure FuncStr_NEQ(Param: PExpressionRec);
 procedure FuncStr_LT(Param: PExpressionRec);

packages/fcl-db/src/dbase/dbf_prsdef.pas

@@ -26,6 +26,7 @@ type
   PExpressionRec = ^TExpressionRec;
   PDynamicType = ^TDynamicType;
   PDateTimeRec = ^TDateTimeRec;
+  PDouble = ^Double;
 {$ifdef SUPPORT_INT64}
   PLargeInt = ^Int64;
 {$endif}

packages/fcl-db/src/dbase/history.txt

@@ -32,6 +32,14 @@ BUGS & WARNINGS
 
 
 
+------------------------
+V6.9.2
+
+- compile fixes for delphi 4, 5 (pdouble)
+- fix indexes to work properly with ansi upper/lower casing
+- fix memory leak when inserting duplicate item in AVL tree 
+- add german localization strings (thx heiko)
+
 ------------------------
 V6.9.1