TParadoxDataset: Add filtering support.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6908 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz 2019-05-11 17:43:47 +00:00
parent 6c5a594a90
commit 2a0ca14343
2 changed files with 164 additions and 66 deletions

View File

@ -4,7 +4,7 @@
<PathDelim Value="\"/>
<Name Value="lazparadoxpkg"/>
<Type Value="RunAndDesignTime"/>
<Author Value="Christian Ulrich"/>
<Author Value="Christian Ulrich, Werner Pamler"/>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
@ -22,8 +22,8 @@
</Debugging>
</Linking>
</CompilerOptions>
<Description Value="Dataset for Paradox database files
Read-only
<Description Value="Dataset for Paradox database files; support of blobs, bookmarks and filtering
Read-only, no indexes
Tested on Win and Linux gtk2/qt (32bit/64bit)"/>
<License Value="LGPL"/>
<Version Minor="2"/>

View File

@ -10,28 +10,28 @@ unit paradoxds;
interface
uses
Classes, SysUtils, db, lconvencoding;
Classes, SysUtils, db, lconvencoding, bufdataset_parser;
const
{ Paradox codes for field types }
pxfAlpha = $01;
pxfDate = $02;
pxfShort = $03;
pxfLong = $04;
pxfCurrency = $05;
pxfNumber = $06;
pxfLogical = $09;
pxfMemoBLOb = $0C;
pxfBLOb = $0D;
pxfFmtMemoBLOb = $0E;
pxfOLE = $0F;
pxfGraphic = $10;
pxfTime = $14;
pxfTimestamp = $15;
pxfAutoInc = $16;
pxfBCD = $17;
pxfBytes = $18;
{ Paradox codes for field types }
pxfAlpha = $01;
pxfDate = $02;
pxfShort = $03;
pxfLong = $04;
pxfCurrency = $05;
pxfNumber = $06;
pxfLogical = $09;
pxfMemoBLOb = $0C;
pxfBLOb = $0D;
pxfFmtMemoBLOb = $0E;
pxfOLE = $0F;
pxfGraphic = $10;
pxfTime = $14;
pxfTimestamp = $15;
pxfAutoInc = $16;
pxfBCD = $17;
pxfBytes = $18;
type
@ -166,11 +166,15 @@ type
FInputEncoding: String;
FTargetEncoding: String;
FPxFields: Array of TPxField;
FFilterBuffer : TRecordBuffer;
FParser: TBufDatasetParser;
function GetEncrypted: Boolean;
function GetInputEncoding: String; inline;
function GetTargetEncoding: String; inline;
function GetVersion: String;
function IsStoredTargetEncoding: Boolean;
function PxFilterRecord(Buffer: TRecordBuffer): Boolean;
function PxGetActiveBuffer(var Buffer: TRecordBuffer): Boolean;
procedure ReadBlock;
procedure ReadNextBlockHeader;
procedure ReadPrevBlockHeader;
@ -198,8 +202,11 @@ type
procedure InternalPost; override;
procedure InternalSetToRecord(Buffer: PChar); override;
function IsCursorOpen: Boolean; override;
procedure ParseFilter(const AFilter: string);
procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override;
procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override;
procedure SetFiltered(Value: Boolean); override;
procedure SetFilterText(const Value: String); override;
procedure SetRecNo(Value: Integer); override;
public
constructor Create(AOwner: TComponent); override;
@ -217,6 +224,7 @@ type
property Active;
property AutoCalcFields;
property FieldDefs;
property Filter;
property Filtered;
property BeforeOpen;
property AfterOpen;
@ -268,7 +276,7 @@ end;
function TParadoxDataset.BookmarkValid(ABookmark: TBookmark): Boolean;
begin
Result := Assigned(ABookmark) and (Length(ABookMark) <> 0);
Result := Assigned(ABookmark) and (Length(ABookmark) <> 0);
end;
function TParadoxDataset.CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Longint;
@ -399,13 +407,15 @@ var
int: LongInt absolute s;
d: Double absolute s;
str: String;
buf: TRecordBuffer = nil;
begin
Result := False;
if (RecordCount = 0) then
exit;
PXGetActiveBuffer(Buf);
p := buf + FPxFields[Field.FieldNo - 1].Offset;
F := FPxFields[Field.FieldNo - 1].Info;
p := ActiveBuffer + FPxFields[Field.FieldNo - 1].Offset;
size := F^.fSize;
// These numeric fields are stored as big endian --> swap bytes
@ -484,59 +494,63 @@ end;
function TParadoxDataset.GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult;
var
L: Longword;
accepted: Boolean;
begin
Result := grOK;
case GetMode of
gmNext:
begin
inc(FaRecord);
if (FaBlockIdx = FHeader^.lastBlock) and
(FaRecord > FaBlockStart + FaBlock^.addDataSize div FHeader^.recordSize + 1)
then
Result := grEOF
else
accepted := false;
repeat
case GetMode of
gmNext:
begin
inc(FaRecord);
if (FaBlockIdx = FHeader^.lastBlock) and
(FaRecord > FaBlockStart + FaBlock^.addDataSize div FHeader^.recordSize + 1)
then
Result := grEOF
else
if FaRecord > FaBlockStart+1+(FaBlock^.addDataSize div FHeader^.recordSize) then
ReadNextBlockHeader;
end;
end;
gmPrior:
begin
dec(FaRecord);
if (FaBlockIdx = FHeader^.firstBlock) and (FaRecord < 1) then
Result := grBOF
else
gmPrior:
begin
dec(FaRecord);
if (FaBlockIdx = FHeader^.firstBlock) and (FaRecord < 1) then
Result := grBOF
else
if FaRecord <= FaBlockStart then
begin
ReadPrevBlockHeader;
FaRecord := FaBlockStart+(FaBlock^.addDataSize div FHeader^.recordSize)+1;
end;
begin
ReadPrevBlockHeader;
FaRecord := FaBlockStart+(FaBlock^.addDataSize div FHeader^.recordSize)+1;
end;
end;
gmCurrent:
if (FaRecord > RecordCount) or (FaRecord < 1) then
result := grError;
end;
gmCurrent:
begin
if (FaRecord > RecordCount) or (FaRecord < 1) then
result := grError;
end;
end;
if Result = grOK then
begin
if not FBlockreaded then
if Result = grOK then begin
if not FBlockReaded then
ReadBlock;
L := ((faRecord-(FaBlockstart+1))*FHeader^.recordSize)+6;
if (faRecord-(FaBlockstart+1)) >= 0 then
begin
Move(PChar(FaBlock)[L],Buffer[0],FHeader^.recordSize);
end
L := ((faRecord - (FaBlockstart + 1))*FHeader^.recordSize) + 6;
if (faRecord - (FaBlockstart + 1)) >= 0 then
Move(PChar(FaBlock)[L],Buffer[0],FHeader^.recordSize)
else
result := grError;
with PRecInfo(Buffer + FHeader^.recordSize)^ do
begin
BookmarkFlag := bfCurrent;
RecordNumber := FaRecord;
end;
Result := grError;
with PRecInfo(Buffer + FHeader^.recordSize)^ do begin
BookmarkFlag := bfCurrent;
RecordNumber := FaRecord;
end;
// Filtering
if Filtered then
accepted := PXFilterRecord(Buffer)
else
accepted := True;
if (GetMode = gmCurrent) and not accepted then
Result := grError;
end;
until (Result <> grOK) or Accepted;
end;
function TParadoxDataset.GetRecordCount: Integer;
@ -584,6 +598,7 @@ begin
DestroyFields;
FreeMem(FHeader);
FreeMem(FaBlock);
FreeAndNil(FParser);
FreeAndNil(FBlobStream);
FreeAndNil(FStream);
FActive := False;
@ -730,6 +745,13 @@ begin
if DefaultFields then CreateFields;
BindFields(True);
FActive := True;
try
ParseFilter(Filter);
except
on E: Exception do
Filter := '';
end;
end;
procedure TParadoxDataset.InternalPost;
@ -737,9 +759,13 @@ begin
end;
procedure TParadoxDataset.InternalSetToRecord(Buffer: PChar);
var
bm: LongWord;
begin
if (State <> dsInsert) then
InternalGotoBookmark(@PRecInfo(Buffer + FHeader^.RecordSize)^.RecordNumber);
if (State <> dsInsert) then begin
bm := PRecInfo(Buffer + FHeader^.RecordSize)^.RecordNumber;
InternalGotoBookmark(@bm);
end;
end;
function TParadoxDataset.IsCursorOpen: Boolean;
@ -752,6 +778,59 @@ begin
Result := not SameText(FTargetEncoding, EncodingUTF8);
end;
procedure TParadoxDataset.ParseFilter(const AFilter: string);
begin
if Length(AFilter) > 0 then
begin
if (FParser = nil) and IsCursorOpen then
FParser := TBufDatasetParser.Create(Self);
if FParser <> nil then
begin
FParser.PartialMatch := not (foNoPartialCompare in FilterOptions);
FParser.CaseInsensitive := foCaseInsensitive in FilterOptions;
FParser.ParseExpression(AFilter);
end;
end;
end;
function TParadoxDataset.PxFilterRecord(Buffer: TRecordBuffer): Boolean;
var
SaveState: TDatasetState;
begin
Result := True;
if not Assigned(OnFilterRecord) and not Filtered then
Exit;
SaveState := SetTempState(dsFilter);
Try
FFilterBuffer := Buffer;
If Assigned(OnFilterRecord) then
OnFilterRecord(Self, Result);
If Result and Filtered and (Filter <> '') then
Result := Boolean((FParser.ExtractFromBuffer(FFilterBuffer))^);
Finally
RestoreState(SaveState);
end;
end;
function TParadoxDataset.PxGetActiveBuffer(var Buffer: TRecordBuffer): Boolean;
begin
case State of
dsBrowse:
if IsEmpty then
Buffer := nil
else
Buffer := ActiveBuffer;
dsEdit,
dsInsert:
Buffer := ActiveBuffer;
dsFilter:
Buffer := FFilterBuffer;
else
Buffer := nil;
end;
Result := (Buffer <> nil);
end;
procedure TParadoxDataset.ReadBlock;
var
L : longint;
@ -822,6 +901,25 @@ begin
FFilename := AValue;
end;
procedure TParadoxDataset.SetFiltered(Value: Boolean);
begin
if (Value <> Filtered) then begin
inherited;
if IsCursorOpen then
Refresh;
end;
end;
procedure TParadoxDataset.SetFilterText(const Value: String);
begin
if (Value <> Filter) then begin
ParseFilter(Value);
inherited;
if IsCursorOpen and Filtered then
Refresh;
end;
end;
procedure TParadoxDataset.SetRecNo(Value: Integer);
begin
if Value < FaRecord then