wwfilter.pas

胜天进销存源码,国产优秀的进销存

unit wwfilter;
{
//
// Parse filter expression and convert to BDE data structure
//
// Copyright (c) 1995-2001 by Woll2Woll Software
//
// 6/17/95 - Fixed bug in filtering DateTime fields
// 6/21/95 - Support international characters >vk_scroll, AnsiToNative
// 1/13/99 - Support Auto-increment fields
}

interface
{$R-}
uses
  SysUtils, Windows, Messages, Classes, Graphics, Controls, StdCtrls,
  Forms, {DsgnIntf, }dialogs, dbtables, db, wwstacks, wwstr,

{$IFDEF WIN32}
bde
{$ELSE}
dbiprocs, dbiTypes, dbierrs
{$ENDIF}
;


Function wwSetFilter(a_line: string; table: TTable;
    var fh: hDBIFilter; InOpen: boolean): boolean;
Function wwAddFilter(a_line: string; table: TTable; var fh: hDBIFilter): boolean;
Procedure wwRemoveFilter(table: TDBDataSet; var fh: hDBIFilter);
Function wwSetFilterFunction(func: Pointer; table: TDBDataSet; var fh: hDBIFilter): boolean;

implementation


const
{$ifdef win32}
   TFilterNodeClassSize = 14;
   TFilterHeaderClassSize = 10;
{$else}
   TFilterNodeClassSize = 10;
   TFilterHeaderClassSize = 10;
{$endif}

type

{$ifdef win32}
TFilterNodeClass = record
   filterNodeType: integer;
   operation: integer;
   data1: word;
   data2: word;
   data3: word;
end;
{$else}
TFilterNodeClass = record
   filterNodeType: word;
   operation: word;
   data1: word;
   data2: word;
   data3: word;
end;
{$endif}

TFilterHeaderClass = record
   iVersion: word;
   iTotalSize: word;
   iNodes: word;
   iNodeStart: word;
   iLiteralStart: word;
end;

PTFilterNodeClass = ^TFilterNodeClass;
PTfilterHeaderClass = ^TFilterHeaderClass;


type PByte = ^Byte;
     TParseState = (None, ExpectingLogical);
     SmallString = string[64];  { Use small string to minimize stack use }
     WordArray = Array [0..1000] of word;
var
   enginePtr, filterHeaderPtr, filterBufferPtr, literalsPtr: PByte;
   engineSize: integer;  { size allocated for engine data structor }

   traverseStr: string;
   curBinaryNodeCount: integer;
   literalOffset: integer;
   fieldCount: integer;
   dbTable: TDBDataSet;
   parseState: TParseState;

procedure MakeEnginePtr;
begin
    engineSize:= TFilterHeaderClassSize + (curBinaryNodeCount * TFilterNodeClassSize) + 1000;

    enginePtr:= AllocMem(engineSize);

    filterHeaderPtr:= enginePtr;

    filterBufferPtr:= enginePtr;
    inc(filterBufferPtr, TFilterHeaderClassSize + (curBinaryNodeCount * TFilterNodeClassSize));

    literalsPtr:= enginePtr;
    inc(literalsPtr, TFilterHeaderClassSize + curBinaryNodeCount * TFilterNodeClassSize);

end;

procedure FreeEnginePtr;
begin
    FreeMem(enginePtr, engineSize);
end;

Function isRelOp(token : string): boolean;
begin
   result:=
	((token='<') or
	(token='<>') or
	(token='<=') or
	(token='>=') or
	(token='=') or
	(token='>'));
end;

type
   TNodeType = (Relational, Logical, Arithmetic, Variable);
   TDataType = (dtUnknown, dtString, dtFloat, dtDateTime, dtDate, dtTime,
                dtBoolean, dtInteger, dtBCD, dtSmallInt);

TNode = Class;
{PTNode = ^TNode;}

TNode = Class
  private
    nodeType: TNodeType;
    dataType: TDataType;
    bcdSize: integer;
    nodeOperator: string;
    nodeOffset: integer;   { Set when traverse is called}
    child1: TNode;
    child2: TNode;

  public
    constructor create(a_NodeType: TNodeType;
         a_nodeOperator: string; a_child1: TNode; a_child2: TNode;
         a_dataType: TDataType);
    destructor Destroy; override;
    Function nodeCount: integer;
    Procedure traverse;
    procedure addBinaryNode(a_operation: CanOp);
    procedure addFieldNode(fieldName: string);
    procedure addConstantBCDNode(constantValue: string;
              ADataType: TDataType; bcdSize: integer);
    procedure addConstantFloatNode(constantValue: string);
    procedure addConstantStringNode(constantValue: string);
    procedure addConstantDateTimeNode(constantValue: string);
    procedure addConstantDateNode(constantValue: string);
    procedure addConstantTimeNode(constantValue: string);
    procedure addConstantSmallIntNode(constantValue: string);
    procedure addConstantIntegerNode(constantValue: string);
    procedure addConstantBooleanNode(constantValue: string);
end;

constructor TNode.create(a_NodeType: TNodeType;
         a_nodeOperator: string; a_child1: TNode; a_child2: TNode;
         a_dataType: TDataType);
begin
   nodeType:= a_nodeType;
   dataType:= dtUnknown;
   nodeOperator:= a_nodeOperator;
   child1:= a_child1;
   child2:= a_child2;
   bcdSize:= 0;
end;

destructor TNode.destroy;
begin
   child1.free;
   child2.free;
end;

Function TNode.NodeCount: integer;
var count: integer;
begin
   count:= 1;
   if (child1<>Nil) then count:= count + child1.nodeCount;
   if (child2<>Nil) then count:= count + child2.nodeCount;
   result:= count;
end;

Procedure TNode.addFieldNode(fieldName: string);
var
   fieldNameStr: PChar;
begin
   fieldNameStr:= StrAlloc(256);
   StrPCopy(fieldNameStr, fieldName);

   Dec(curBinaryNodeCount,1);
   Inc(fieldCount, 1);

   Dec(FilterBufferPtr, TFilterNodeClassSize);
   PTFilterNodeClass(FilterBufferPtr)^.data1 := fieldCount;
   PTFilterNodeClass(FilterBufferPtr)^.data2 := literalOffset;
{$ifdef win32}
   PTFilterNodeClass(FilterBufferPtr)^.filterNodeType := Integer(nodeField);
   PTFilterNodeClass(FilterBufferPtr)^.operation := Integer(canField2);
{$else}
   PTFilterNodeClass(FilterBufferPtr)^.filterNodeType := Word(nodeField);
   PTFilterNodeClass(FilterBufferPtr)^.operation := Word(canField2);
{$endif}
   nodeOffset := curBinaryNodeCount*TFilterNodeClassSize;

   AnsiToNative((DBTable as TTable).Database.Locale,
          FieldName, PChar(literalsPtr), 255 {MaxLen}); { Convert to locale }

   inc(literalsPtr, length(fieldName)+1);
   inc(literalOffset, length(fieldName)+1);

   strDispose(fieldNameStr);
end;

procedure TNode.addConstantStringNode(constantValue: string);
var
   constantValueStr: PChar;
begin
   constantValueStr:= StrAlloc(256);
   StrPCopy(constantValueStr, constantValue);

   Dec(curBinaryNodeCount);
   Dec(FilterBufferPtr, TFilterNodeClassSize);

{$ifdef win32}
   PTFilterNodeClass(FilterBufferPtr)^.filterNodeType := Integer(nodeConst);
   PTFilterNodeClass(FilterBufferPtr)^.operation := Integer(canConst2);
   PTFilterNodeClass(FilterBufferPtr)^.data1 := fldZString;
   PTFilterNodeClass(FilterBufferPtr)^.data2 := length(constantValue)+1;
   PTFilterNodeClass(FilterBufferPtr)^.data3 := literalOffset;
{$else}
   PTFilterNodeClass(FilterBufferPtr)^.filterNodeType := Word(nodeConst);
   PTFilterNodeClass(FilterBufferPtr)^.operation := Word(canConst2);
   PTFilterNodeClass(FilterBufferPtr)^.data1 := Word(fldZString);
   PTFilterNodeClass(FilterBufferPtr)^.data2 := length(constantValue)+1;
   PTFilterNodeClass(FilterBufferPtr)^.data3 := literalOffset;
{$endif}

   nodeOffset := curBinaryNodeCount*TFilterNodeClassSize;

   AnsiToNative((DBTable as TTable).Database.Locale,
          ConstantValue, PChar(literalsPtr), 255 {MaxLen}); { Convert to locale }
   inc(literalsPtr, length(constantValue)+1);
   inc(literalOffset, length(constantValue)+1);

   strDispose(ConstantValueStr);
end;

procedure TNode.addConstantFloatNode(constantValue: string);
var f: Double;
begin
   dec(curBinaryNodeCount);

   Dec(FilterBufferPtr, TFilterNodeClassSize);
   PTFilterNodeClass(FilterBufferPtr)^.filterNodeType := Word(nodeConst);
   PTFilterNodeClass(FilterBufferPtr)^.operation := Word(canConst2);
   PTFilterNodeClass(FilterBufferPtr)^.data1 := Word(fldFloat);
   PTFilterNodeClass(FilterBufferPtr)^.data2 := 8;
   PTFilterNodeClass(FilterBufferPtr)^.data3 := literalOffset;

   nodeOffset := curBinaryNodeCount*TFilterNodeClassSize;

   f := strToFloat(constantValue);
   move(f, literalsPtr^, 8);
   inc(literalsPtr, 8);
   inc(literalOffset, 8);

end;

procedure TNode.addConstantBCDNode(constantValue: string;
          ADataType: TDataType; bcdSize: integer);
var f: Double;
    bcd: FmtBCD;
    bcdPhySize: integer;
begin
   dec(curBinaryNodeCount);

   Dec(FilterBufferPtr, TFilterNodeClassSize);
   bcdPhySize:= sizeOf(bcd);
   PTFilterNodeClass(FilterBufferPtr)^.filterNodeType := Word(nodeConst);
   PTFilterNodeClass(FilterBufferPtr)^.operation := Word(canConst2);
   PTFilterNodeClass(FilterBufferPtr)^.data1 := Word(fldBCD);
   PTFilterNodeClass(FilterBufferPtr)^.data2 := bcdPhySize;
   PTFilterNodeClass(FilterBufferPtr)^.data3 := literalOffset;

   nodeOffset := curBinaryNodeCount*TFilterNodeClassSize;

   f := strToFloat(constantValue);
   dbiBCDFromFloat(f, 32, bcdSize, bcd);
   move(bcd, literalsPtr^, bcdPhySize);
   inc(literalsPtr, bcdPhySize);
   inc(literalOffset, bcdPhySize);

end;

procedure TNode.addConstantIntegerNode(constantValue: string);
var n: longint;
begin
   dec(curBinaryNodeCount);

   Dec(FilterBufferPtr, TFilterNodeClassSize);
   PTFilterNodeClass(FilterBufferPtr)^.filterNodeType := Word(nodeConst);
   PTFilterNodeClass(FilterBufferPtr)^.operation := Word(canConst2);
   PTFilterNodeClass(FilterBufferPtr)^.data1 := Word(fldInt32);
   PTFilterNodeClass(FilterBufferPtr)^.data2 := 4;
   PTFilterNodeClass(FilterBufferPtr)^.data3 := literalOffset;

   nodeOffset := curBinaryNodeCount*TFilterNodeClassSize;

   n := strToInt(constantValue);
   move(n, literalsPtr^, 4);
   inc(literalsPtr, 4);
   inc(literalOffset, 4);

end;

procedure TNode.addConstantSmallIntNode(constantValue: string);
var n: longint;
begin
   dec(curBinaryNodeCount);

   Dec(FilterBufferPtr, TFilterNodeClassSize);
   PTFilterNodeClass(FilterBufferPtr)^.filterNodeType := Word(nodeConst);
   PTFilterNodeClass(FilterBufferPtr)^.operation := Word(canConst2);
   PTFilterNodeClass(FilterBufferPtr)^.data1 := Word(fldInt16);
   PTFilterNodeClass(FilterBufferPtr)^.data2 := 2;
   PTFilterNodeClass(FilterBufferPtr)^.data3 := literalOffset;

   nodeOffset := curBinaryNodeCount*TFilterNodeClassSize;

   n := strToInt(constantValue);
   move(n, literalsPtr^, 2);
   inc(literalsPtr, 2);
   inc(literalOffset, 2);

end;

procedure TNode.addConstantDateTimeNode(constantValue: string);
var f: Double;
    DateTime: TDateTime;
begin
   dec(curBinaryNodeCount);

   Dec(FilterBufferPtr, TFilterNodeClassSize);
   PTFilterNodeClass(FilterBufferPtr)^.filterNodeType := Word(nodeConst);
   PTFilterNodeClass(FilterBufferPtr)^.operation := Word(canConst2);
   PTFilterNodeClass(FilterBufferPtr)^.data1 := Word(fldTimeStamp);
   PTFilterNodeClass(FilterBufferPtr)^.data2 := 8;
   PTFilterNodeClass(FilterBufferPtr)^.data3 := literalOffset;

   nodeOffset := curBinaryNodeCount*TFilterNodeClassSize;

   {$ifdef win32}
   if pos(' ', constantValue)>0 then begin
      DateTime:= StrToDateTime(constantValue);
      f := TimeStampToMSecs(DateTimeToTimeStamp(DateTime));
   end
   else begin
      DateTime:= StrToDate(constantValue);
      f := TimeStampToMSecs(DateTimeToTimeStamp(DateTime));
   end;
   {$else}
   if pos(' ', constantValue)>0 then f := strToDateTime(constantValue) * MSecsPerDay
   else f := strToDate(constantValue) * MSecsPerDay;
   {$endif}

   move(f, literalsPtr^, 8);
   inc(literalsPtr, 8);
   inc(literalOffset, 8);

end;

procedure TNode.addConstantDateNode(constantValue: string);
var
{$ifdef win32}
    TimeStamp: TTimeStamp;
    DateTime: TDateTime;
{$else}
    f: Longint;
{$endif}
begin
   dec(curBinaryNodeCount);

   Dec(FilterBufferPtr, TFilterNodeClassSize);
   PTFilterNodeClass(FilterBufferPtr)^.filterNodeType := Word(nodeConst);
   PTFilterNodeClass(FilterBufferPtr)^.operation := Word(canConst2);