?? dbfilter.pas
字號:
Options: TDBFilterOptions);
destructor Destroy; override;
property FilterData: PCANExpr read FFilterData;
property DataSize: Integer read FDataSize;
end;
constructor TExprParser.Create(DataSet: TDataSet; const Text: PChar;
Options: TDBFilterOptions);
var
Root: PExprNode;
begin
FFilter := TFilterExpr.Create(DataSet, Options);
FText := Text;
FSourcePtr := Text;
NextToken;
Root := ParseExpr;
if FToken <> etEnd then FilterError(SExprTermination);
FFilterData := FFilter.GetFilterData(Root);
FDataSize := FFilter.FExprBufSize;
end;
destructor TExprParser.Destroy;
begin
FFilter.Free;
end;
procedure TExprParser.NextToken;
var
P, TokenStart: PChar;
L: Integer;
StrBuf: array[0..255] of Char;
begin
FTokenString := '';
P := FSourcePtr;
while (P^ <> #0) and (P^ <= ' ') do Inc(P);
FTokenPtr := P;
case P^ of
'A'..'Z', 'a'..'z', '_', #$81..#$fe:
begin
TokenStart := P;
Inc(P);
while P^ in ['A'..'Z', 'a'..'z', '0'..'9', '_'] do Inc(P);
SetString(FTokenString, TokenStart, P - TokenStart);
FToken := etSymbol;
end;
cFldQuotaLeft:
begin
Inc(P);
TokenStart := P;
while (P^ <> cFldQuotaRight) and (P^ <> #0) do Inc(P);
if P^ = #0 then FilterError(SExprNameError);
SetString(FTokenString, TokenStart, P - TokenStart);
FToken := etName;
Inc(P);
end;
cQuota: { '''' }
begin
Inc(P);
L := 0;
while True do
begin
if P^ = #0 then FilterError(SExprStringError);
if P^ = cQuota then begin
Inc(P);
if P^ <> cQuota then Break;
end;
if L < SizeOf(StrBuf) then begin
StrBuf[L] := P^;
Inc(L);
end;
Inc(P);
end;
SetString(FTokenString, StrBuf, L);
FToken := etLiteral;
end;
'-', '0'..'9':
begin
TokenStart := P;
Inc(P);
while P^ in ['0'..'9', '.', 'e', 'E', '+', '-'] do Inc(P);
SetString(FTokenString, TokenStart, P - TokenStart);
FToken := etLiteral;
end;
'(':
begin
Inc(P);
FToken := etLParen;
end;
')':
begin
Inc(P);
FToken := etRParen;
end;
'<':
begin
Inc(P);
case P^ of
'=':
begin
Inc(P);
FToken := etLE;
end;
'>':
begin
Inc(P);
FToken := etNE;
end;
else FToken := etLT;
end;
end;
'=':
begin
Inc(P);
FToken := etEQ;
end;
'>':
begin
Inc(P);
if P^ = '=' then begin
Inc(P);
FToken := etGE;
end
else FToken := etGT;
end;
#0: FToken := etEnd;
else FilterErrorFmt(SExprInvalidChar, [P^]);
end;
FSourcePtr := P;
end;
function TExprParser.ParseExpr: PExprNode;
begin
Result := ParseExpr2;
while TokenSymbolIs('OR') do begin
NextToken;
Result := FFilter.NewNode(enOperator, canOR, EmptyStr,
Result, ParseExpr2);
end;
end;
function TExprParser.ParseExpr2: PExprNode;
begin
Result := ParseExpr3;
while TokenSymbolIs('AND') do begin
NextToken;
Result := FFilter.NewNode(enOperator, canAND, EmptyStr,
Result, ParseExpr3);
end;
end;
function TExprParser.ParseExpr3: PExprNode;
begin
if TokenSymbolIs('NOT') then begin
NextToken;
Result := FFilter.NewNode(enOperator, canNOT, EmptyStr,
ParseExpr4, nil);
end
else Result := ParseExpr4;
end;
function TExprParser.ParseExpr4: PExprNode;
const
Operators: array[etEQ..etLT] of CanOp = (
canEQ, canNE, canGE, canLE, canGT, canLT);
var
Operator: CanOp;
begin
Result := ParseExpr5;
if FToken in [etEQ..etLT] then begin
Operator := Operators[FToken];
NextToken;
Result := FFilter.NewNode(enOperator, Operator, EmptyStr,
Result, ParseExpr5);
end;
end;
function TExprParser.ParseExpr5: PExprNode;
begin
Result := nil;
case FToken of
etSymbol:
if TokenSymbolIs('NULL') then
Result := FFilter.NewNode(enConst, canNOTDEFINED, EmptyStr, nil, nil)
else
Result := FFilter.NewNode(enField, canNOTDEFINED, FTokenString, nil, nil);
etName:
Result := FFilter.NewNode(enField, canNOTDEFINED, FTokenString, nil, nil);
etLiteral:
Result := FFilter.NewNode(enConst, canNOTDEFINED, FTokenString, nil, nil);
etLParen:
begin
NextToken;
Result := ParseExpr;
if FToken <> etRParen then FilterErrorFmt(SExprNoRParen, [TokenName]);
end;
else FilterErrorFmt(SExprExpected, [TokenName]);
end;
NextToken;
end;
function TExprParser.TokenName: string;
begin
if (FSourcePtr = FTokenPtr) then Result := SExprNothing
else begin
SetString(Result, FTokenPtr, FSourcePtr - FTokenPtr);
Result := '''' + Result + '''';
end;
end;
function TExprParser.TokenSymbolIs(const S: string): Boolean;
begin
Result := (FToken = etSymbol) and (CompareText(FTokenString, S) = 0);
end;
{$ENDIF RX_D3} {DbCommon.pas}
{$IFDEF WIN32}
{$HINTS OFF}
{$ENDIF}
type
THackDataSet = class(TDataSet);
{ TNastyDataSet }
{*******************************************************}
{ !! ATTENTION Nasty implementation }
{*******************************************************}
{ }
{ These class definitions were copied from TDataSet }
{ (DB.PAS) and TBDEDataSet (DBTABLES.PAS). }
{ It is needed to access FState, FBOF, FEOF, FBuffers, }
{ FRecordCount, FActiveRecord, FCanModify private }
{ fields of TDataSet. }
{ }
{ Any changes in the underlying classes may cause }
{ errors in this implementation! }
{ }
{*******************************************************}
{$IFDEF RX_D3}
{$IFDEF RX_D4}
PBufferList = TBufferList;
TNastyDataSet = class(TComponent)
private
FFields: TFields;
FAggFields: TFields;
FFieldDefs: TFieldDefs;
FFieldDefList: TFieldDefList;
FFieldList: TFieldList;
FDataSources: TList;
FFirstDataLink: TDataLink;
FBufferCount: Integer;
FRecordCount: Integer;
FActiveRecord: Integer;
FCurrentRecord: Integer;
FBuffers: TBufferList;
FCalcBuffer: PChar;
FBookmarkSize: Integer;
FCalcFieldsSize: Integer;
FDesigner: TDataSetDesigner;
FDisableCount: Integer;
FBlobFieldCount: Integer;
FFilterText: string;
FBlockReadSize: Integer;
FConstraints: TCheckConstraints;
FDataSetField: TDataSetField;
FNestedDataSets: TList;
FNestedDatasetClass: TClass;
FReserved: Pointer;
FFieldNoOfs: Integer;
{ Byte sized data members (for alignment) }
FFilterOptions: TFilterOptions;
FState: TDataSetState;
FEnableEvent: TDataEvent;
FDisableState: TDataSetState;
FBOF: Boolean;
FEOF: Boolean;
end;
TBDENastyDataSet = class(TDataSet)
private
FHandle: HDBICur;
FStmtHandle: HDBIStmt;
FRecProps: RecProps;
FLocale: TLocale;
FExprFilter: HDBIFilter;
FFuncFilter: HDBIFilter;
FFilterBuffer: PChar;
FIndexFieldMap: DBIKey;
FExpIndex: Boolean;
FCaseInsIndex: Boolean;
FCachedUpdates: Boolean;
FInUpdateCallback: Boolean;
FCanModify: Boolean;
end;
{$ELSE RX_D4}
TNastyDataSet = class(TComponent)
private
FFields: TList;
FFieldDefs: TFieldDefs;
FDataSources: TList;
FFirstDataLink: TDataLink;
FBufferCount: Integer;
FRecordCount: Integer;
FActiveRecord: Integer;
FCurrentRecord: Integer;
FBuffers: PBufferList;
FCalcBuffer: PChar;
FBufListSize: Integer;
FBookmarkSize: Integer;
FCalcFieldsSize: Integer;
FBOF: Boolean;
FEOF: Boolean;
FModified: Boolean;
FStreamedActive: Boolean;
FInternalCalcFields: Boolean;
FState: TDataSetState;
end;
TBDENastyDataSet = class(TDataSet)
private
FHandle: HDBICur;
FRecProps: RecProps;
FLocale: TLocale;
FExprFilter: HDBIFilter;
FFuncFilter: HDBIFilter;
FFilterBuffer: PChar;
FIndexFieldMap: DBIKey;
FExpIndex: Boolean;
FCaseInsIndex: Boolean;
FCachedUpdates: Boolean;
FInUpdateCallback: Boolean;
FCanModify: Boolean;
end;
{$ENDIF RX_D4}
{$ELSE RX_D3}
TNastyDataSet = class(TComponent)
private
FFields: TList;
FDataSources: TList;
FFieldDefs: TFieldDefs;
FBuffers: PBufferList;
FBufListSize: Integer;
FBufferCount: Integer;
FRecordCount: Integer;
FActiveRecord: Integer;
FCurrentRecord: Integer;
FHandle: HDBICur;
FBOF: Boolean;
FEOF: Boolean;
FState: TDataSetState;
FAutoCalcFields: Boolean;
FDefaultFields: Boolean;
FCanModify: Boolean;
end;
TBDENastyDataSet = TNastyDataSet;
{$ENDIF RX_D3}
{$IFDEF WIN32}
{$HINTS ON}
{$ENDIF}
procedure dsSetState(DataSet: TDataSet; Value: TDataSetState);
begin
TNastyDataSet(DataSet).FState := Value;
end;
procedure dsSetBOF(DataSet: TDataSet; Value: Boolean);
begin
TNastyDataSet(DataSet).FBOF := Value;
end;
procedure dsSetEOF(DataSet: TDataSet; Value: Boolean);
begin
TNastyDataSet(DataSet).FEOF := Value;
end;
{$IFDEF RX_D4}
procedure AssignBuffers(const Source: TBufferList; var Dest: TBufferList);
var
Len: Integer;
begin
Len := High(Source) + 1;
SetLength(Dest, Len);
Move(Pointer(Source)^, Pointer(Dest)^, Len * SizeOf(PChar));
end;
procedure dsGetBuffers(DataSet: TDataSet; var ABuf: TBufferList);
begin
with TNastyDataSet(DataSet) do
AssignBuffers(FBuffers, ABuf);
end;
procedure dsSetBuffers(DataSet: TDataSet; const Value: TBufferList);
begin
AssignBuffers(Value, TNastyDataSet(DataSet).FBuffers);
end;
{$ELSE RX_D4}
procedure dsGetBuffers(DataSet: TDataSet; var ABuf: PBufferList);
begin
ABuf := TNastyDataSet(DataSet).FBuffers;
end;
procedure dsSetBuffers(DataSet: TDataSet; const Value: PBufferList);
begin
TNastyDataSet(DataSet).FBuffers := Value;
end;
{$ENDIF RX_D4}
function dsGetRecordCount(DataSet: TDataSet): Integer;
begin
Result := TNastyDataSet(DataSet).FRecordCount;
end;
procedure dsSetRecordCount(DataSet: TDataSet; Value: Integer);
begin
TNastyDataSet(DataSet).FRecordCount := Value;
end;
function dsGetActiveRecord(DataSet: TDataSet): Integer;
begin
Result := TNastyDataSet(DataSet).FActiveRecord;
end;
procedure dsSetActiveRecord(DataSet: TDataSet; Value: Integer);
begin
TNastyDataSet(DataSet).FActiveRecord := Value;
end;
function dsGetCanModify(DataSet: TBDEDataSet): Boolean;
begin
Result := TBDENastyDataSet(DataSet).FCanModify;
end;
procedure dsSetCanModify(DataSet: TBDEDataSet; Value: Boolean);
begin
TBDENastyDataSet(DataSet).FCanModify := Value;
end;
{ TFilterDataLink }
type
TFilterDataLink = class(TDataLink)
private
FFilter: TRxDBFilter;
protected
procedure ActiveChanged; override;
public
constructor Create(Filter: TRxDBFilter);
destructor Destroy; override;
end;
constructor TFilterDataLink.Create(Filter: TRxDBFilter);
begin
inherited Create;
FFilter := Filter;
end;
destructor TFilterDataLink.Destroy;
begin
FFilter := nil;
inherited Destroy;
end;
procedure TFilterDataLink.ActiveChanged;
begin
if FFilter <> nil then FFilter.ActiveChanged;
end;
{$IFNDEF WIN32}
type
TFilterOption = TDBFilterOption;
TFilterOptions = TDBFilterOptions;
function FilterCallback(pDBFilter: Longint; RecBuf: Pointer;
RecNo: Longint): Smallint; export;
begin
Result := TRxDBFilter(pDBFilter).RecordFilter(RecBuf, RecNo);
end;
{$ENDIF WIN32}
{ TRxDBFilter }
constructor TRxDBFilter.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FDataLink := TFilterDataLink.Create(Self);
FFilter := TStringList.Create;
TStringList(FFilter).OnChange := FilterChanged;
FLogicCond := flAnd;
FIgnoreDataEvents := False;
end;
destructor TRxDBFilter.Destroy;
begin
TStringList(FFilter).OnChange := nil;
Deactivate;
DropFilters;
FFilter.Free;
FDataLink.Free;
inherited Destroy;
end;
procedure TRxDBFilter.Loaded;
begin
inherited Loaded;
try
if FStreamedActive then Active := True;
except
if csDesigning in ComponentState then
Application.HandleException(Self)
else raise;
end;
end;
function TRxDBFilter.GetDataSource: TDataSource;
begin
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -