wwfilter.pas

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

   PTFilterNodeClass(FilterBufferPtr)^.data1 := Word(fldDate);
   PTFilterNodeClass(FilterBufferPtr)^.data2 := 4;
   PTFilterNodeClass(FilterBufferPtr)^.data3 := literalOffset;

   nodeOffset := curBinaryNodeCount*TFilterNodeClassSize;

   {$ifdef win32}
   DateTime := Trunc(strToDate(constantValue));
   TimeStamp:= DateTimeToTimeStamp(DateTime);
   move(TimeStamp.Date, literalsPtr^,4);
   {$else}
   f := Trunc(strToDate(constantValue));
   move(f, literalsPtr^,4);
   {$endif}

   inc(literalsPtr, 4);
   inc(literalOffset, 4);

end;

procedure TNode.addConstantTimeNode(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);
   PTFilterNodeClass(FilterBufferPtr)^.data1 := Word(fldTime);
   PTFilterNodeClass(FilterBufferPtr)^.data2 := 4;
   PTFilterNodeClass(FilterBufferPtr)^.data3 := literalOffset;

   nodeOffset := curBinaryNodeCount*TFilterNodeClassSize;

   {$ifdef win32}
   DateTime := strToTime(constantValue);
   TimeStamp:= DateTimeToTimeStamp(DateTime);
   move(TimeStamp.Time, literalsPtr^,4);
   {$else}
   f := Round(Frac(strToTime(constantValue)) * MSecsPerDay);
   move(f, literalsPtr^,4);
   {$endif}

   inc(literalsPtr, 4);
   inc(literalOffset, 4);

end;

procedure TNode.addConstantBooleanNode(constantValue: string);
var f: WordBool;
begin
   dec(curBinaryNodeCount);

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

   nodeOffset := curBinaryNodeCount*TFilterNodeClassSize;

   f := constantValue[1] in ['t', 'T'];

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

end;

procedure TNode.addBinaryNode(a_operation: CanOp);
begin
   dec(curBinaryNodeCount);

   Dec(FilterBufferPtr, TFilterNodeClassSize);
   if (child1<>Nil) then PTFilterNodeClass(filterBufferPtr)^.data1 := child1.nodeOffset;
   if (child2<>Nil) then PTFilterNodeClass(FilterBufferPtr)^.data2 := child2.nodeOffset;

{$ifdef win32}
   PTFilterNodeClass(FilterBufferPtr)^.filterNodeType := Integer(nodeBinary);
   PTFilterNodeClass(FilterBufferPtr)^.operation := Integer(a_operation);
{$else}
   PTFilterNodeClass(FilterBufferPtr)^.filterNodeType := Word(nodeBinary);
   PTFilterNodeClass(FilterBufferPtr)^.operation := Word(a_operation);
{$endif}

   nodeOffset := curBinaryNodeCount*TFilterNodeClassSize;
end;

var
   line: string;

procedure TNode.traverse;

   { remove trailing blanks }
   procedure stripTrailing(var name: string);
   begin
      while (length(Name)>0) and (Name[length(name)]=' ') do
         delete(Name, length(Name), 1);
   end;

begin
   if (child1<>Nil) then child1.traverse;
   if (child2<>Nil) then child2.traverse;
   traverseStr := traverseStr + ' ' + nodeOperator;

   if (nodeType=Logical) then begin
      if (uppercase(nodeOperator)='AND') then addBinaryNode(canAND)
      else if (uppercase(nodeOperator)='OR') then addBinaryNode(canOR)
   end
   else if (nodeType=Relational) then begin
      if (nodeOperator='<') then addBinaryNode(canLT)
      else if (nodeOperator='>') then addBinaryNode(canGT)
      else if (nodeOperator='<=') then addBinaryNode(canLE)
      else if (nodeOperator='>=') then addBinaryNode(canGE)
      else if (nodeOperator='=') then addBinaryNode(canEQ)
      else if (nodeOperator='<>') then addBinaryNode(canNE)
   end
   else if (nodeType=Arithmetic) then begin
      if (nodeOperator='+') then addBinaryNode(canADD)
      else if (nodeOperator='-') then addBinaryNode(canMINUS)
      else if (nodeOperator='*') then addBinaryNode(canMUL)
      else if (nodeOperator='/') then addBinaryNode(canDIV)
   end
   else if (nodeType=Variable) then begin
      case dataType of
         dtSmallInt:  addConstantSmallIntNode(nodeOperator);

         dtInteger:  addConstantIntegerNode(nodeOperator);

         dtFloat : addConstantFloatNode(nodeOperator);

         dtBCD:    addConstantBCDNode(nodeOperator, dtBCD, bcdSize);

         dtString:
            if (nodeOperator[1]='"') then
               addConstantStringNode( copy(nodeOperator, 2, length(nodeOperator)-2))
            else begin
               stripTrailing(nodeOperator);
               addConstantStringNode(nodeOperator);
            end;

         dtDateTime:
            if (nodeOperator[1]='"') then
               addConstantDateTimeNode( copy(nodeOperator, 2, length(nodeOperator)-2))
            else begin
               stripTrailing(nodeOperator);
               addConstantDateTimeNode(nodeOperator);
            end;

         dtDate:
            if (nodeOperator[1]='"') then
               addConstantDateNode( copy(nodeOperator, 2, length(nodeOperator)-2))
            else begin
               stripTrailing(nodeOperator);
               addConstantDateNode(nodeOperator);
            end;

         dtTime:
            if (nodeOperator[1]='"') then
               addConstantTimeNode( copy(nodeOperator, 2, length(nodeOperator)-2))
            else begin
               stripTrailing(nodeOperator);
               addConstantTimeNode(nodeOperator);
            end;

         dtBoolean:
            if (nodeOperator[1]='"') then
               addConstantBooleanNode( copy(nodeOperator, 2, length(nodeOperator)-2))
            else begin
               stripTrailing(nodeOperator);
               addConstantBooleanNode(nodeOperator);
            end;

         else addFieldNode(nodeOperator);
      end
   end
end;

var
   stack: TStackStr;
   stackNodes: TStackPtr;


{ build from two nodes in treeStack }
Function GetEngineDatatype(field : TField): TDataType;
begin
   case field.DataType of
      ftString:                             Result:= dtString;
      ftSmallInt, ftWord:                   Result:= dtSmallInt;
      ftAutoInc, ftInteger:                 Result:= dtInteger; { Support auto-increment field }
      ftFloat, ftCurrency:                  Result:= dtFloat;
      ftBCD:                                Result:= dtBCD;
      ftBoolean:                            Result:= dtBoolean;
      ftDateTime :                          Result:= dtDateTime;
      ftDate :                              Result:= dtDate;
      ftTime :                              Result:= dtTime;
      else result:= dtUnknown;
   end
end;

Function DataSetIsValidField(dataset : TDBDataSet; fieldName : string): boolean;
var i: integer;
begin
   with dataset do begin
      result:= False;
      for i:= 0 to fieldCount-1 do begin
         if (uppercase(fieldName) = uppercase(fields[i].fieldName)) then begin
            result:= true;
            break;
         end;
      end
   end
end;

Function BuildNode(nodeType: TNodeType;  nodeOperator: string): boolean;
var child1, child2: TNode;
    node: TNode;
    dbField: TField;
    dataType: TDataType;
begin
  result:= False;

  child1 := Nil;
  child2 := Nil;
  dataType:= dtUnknown;

  if (nodeType<>Variable) then
  begin
     if (stackNodes.count<2) then exit;
     child2 := stackNodes.Pop;
     child1 := stackNodes.Pop;
     if (child1.nodeType=Variable) then begin
        if DataSetIsValidField(dbTable, child1.nodeOperator) then begin
           dbField:= dbTable.fieldByName(child1.nodeOperator);
           child2.dataType:= GetEngineDataType(dbField);
           if dbField is TBCDField then begin
              child2.bcdSize:= TBCDField(dbField).size;
           end
        end
        else begin
           MessageDlg(child1.nodeOperator + #13 + 'Field not found in Table. ',
                 mtWarning, [mbok], 0);
           exit;
        end
     end
  end;

  node := TNode.create(nodeType, nodeOperator, child1, child2, dataType);
  stackNodes.Push(node);
  result:= True;
end;

Function ParseR: boolean; Forward;
Function ParseL: boolean; Forward;
Function ParseE: boolean; Forward;
Function ParseP: boolean; Forward;
Function ParseT: boolean; Forward;

Function Reduce(count: integer; token: string): Boolean;
var i: integer;
begin
   result:= False;
   for i:= 0 to count-1 do begin
      if (stack.count=0) then exit;
      stack.Pop;
   end;
   stack.Push(token);
   result:= True;
end;

Function Shift(token: string): boolean;
begin
   if (pos(token, line)=1) then begin
      Delete(line, 1, length(token));
      stack.Push(token);
      result:= True;
   end
   else result:= False;
end;

Function RelOp(var relOp: string): boolean;
begin
   result:= False;
   relOp:= '';
   if (length(line)>0) and (line[1] in ['<','>','=']) then begin
      result:= True;
      if (length(line)>1) and (line[2] in ['<','>','=']) then begin
         relOp:= copy(line, 1, 2);
      end
      else begin
         relOp:= copy(line, 1, 1);
      end
   end
end;

Function ArithOp(var arithOp: string): boolean;
begin
   result:= False;
   arithOp:= '';
   exit;  { Arithmetic operators do not work in current BDE }
   if (length(line)>0) and (line[1] in ['+','-','*','/']) then begin
      arithOp:= copy(line, 1, 1);
      result:= True;
   end
end;

Function OtherOp(var otherOp: string): boolean;
begin
   result:= False;
   otherOp:= '';
   if (length(line)>0) and (line[1] in ['(',')']) then begin
      OtherOp:= copy(line, 1, 1);
      result:= True;
   end
end;

Function isVarName(var varName: string): boolean;
var i: integer;
begin
   result:= False;
   varName:= '';
   i:= 1;  { Add support for '-' in name : 5/22/97}
   if (length(line)>0) and (line[i] in ['-','`','$','_','/','+','*','!','@','#','A'..'Z','a'..'z',
                       char(vk_scroll+1)..#255]) then
   begin
      i:= i + 1;
      while (i<=length(line)) and
            (line[i] in ['0'..'9','-','_',' ','`','$','/','+','*','`','!','@','#','A'..'Z','a'..'z',
                        char(vk_scroll+1)..#255]) do i:= i + 1;
      VarName:= copy(line, 1, i-1);

      result:= True;
   end
end;

Function isConstantIntegerName(var varName: string): boolean;
var i: integer;
begin
   result:= False;
   varName:= '';
   if length(line)=0 then exit;

   i:= 1;
   if (line[i] ='-') then i:= i + 1;

   if (i<=length(line)) and (line[i] in ['0'..'9']) then begin
      while (i<=length(line)) and (line[i] in ['0'..'9']) do i:= i + 1;
      VarName:= copy(line, 1, i-1);
      result:= True;
   end
end;

Function isConstantFloatName(var varName: string): boolean;
var i: integer;
begin
   result:= False;
   varName:= '';
   if length(line)=0 then exit;

   i:= 1;
   if (line[i] ='-') then i:= i + 1;

   if (line[i] in ['0'..'9']) then begin
      while (i<=length(line)) and (line[i] in ['0'..'9']) do i:= i + 1;
      if  (i<=length(line)) and (line[i]=DecimalSeparator) then i:= i + 1;
      while (i<=length(line)) and (line[i] in ['0'..'9']) do i:= i + 1;
      VarName:= copy(line, 1, i-1);
      result:= True;
   end
end;

Function isLiteralName(var varName: string): boolean;
var i: integer;
begin
   result:= False;
   varName:= '';
   if length(line)=0 then exit;

   i:= 1;
   if line[i]='"' then begin
      i:= i + 1;
      while ((i<=length(line)) and (line[i]<>'"')) do i:= i + 1;
      if (i<=length(line)) and (line[i]='"') then begin
         VarName:= copy(line, 1, i);
         result:= True;