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