mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-21 22:29:24 +02:00
* update tdbf to 6.9.2
git-svn-id: trunk@8883 -
This commit is contained in:
micha
parent
17b81890cd
commit
89c07a2aef
@ -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
|
||||
|
||||
@ -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}
|
||||
|
||||
|
||||
@ -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,9 +1942,12 @@ const
|
||||
);
|
||||
ansislov :PCollationTable = @_ansislov;
|
||||
|
||||
{$ENDIF}
|
||||
|
||||
|
||||
|
||||
{$IFDEF USE_PARADOX_COLLATIONS}
|
||||
|
||||
// ANTURK 24004
|
||||
|
||||
_ANTURK :TCollationTable = (
|
||||
@ -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,9 +2099,12 @@ const
|
||||
);
|
||||
ORAWE850 :PCollationTable = @_ORAWE850 ;
|
||||
|
||||
{$ENDIF}
|
||||
|
||||
|
||||
|
||||
{$IFDEF USE_SYBASE_COLLATIONS}
|
||||
|
||||
// SYDC850 46023
|
||||
|
||||
_SYDC850 :TCollationTable = (
|
||||
@ -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;
|
||||
|
||||
@ -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}
|
||||
|
||||
@ -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;
|
||||
|
||||
|
||||
@ -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);
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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;
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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);
|
||||
|
||||
@ -26,6 +26,7 @@ type
|
||||
PExpressionRec = ^TExpressionRec;
|
||||
PDynamicType = ^TDynamicType;
|
||||
PDateTimeRec = ^TDateTimeRec;
|
||||
PDouble = ^Double;
|
||||
{$ifdef SUPPORT_INT64}
|
||||
PLargeInt = ^Int64;
|
||||
{$endif}
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user